Merge branch 'master' into short-links

* smp client: api to send/receive data blobs directly and via proxy, tests

* fix test

.github/workflows/build.yml

@@ -11,123 +11,61 @@ on:
 
 jobs:
   build:
-    name: "Ubuntu: ${{ matrix.os }}, GHC: ${{ matrix.ghc }}"
-    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
+    name: build-${{ matrix.os }}-${{ matrix.ghc }}
+    runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
       matrix:
         include:
-          - os: 22.04
+          - os: ubuntu-20.04
+            platform_name: 20_04-x86-64
             ghc: "8.10.7"
-            platform_name: 22_04-8.10.7
-          - os: 22.04
+          - os: ubuntu-20.04
+            platform_name: 20_04-x86-64
             ghc: "9.6.3"
+          - os: ubuntu-22.04
             platform_name: 22_04-x86-64
-          - os: 24.04
             ghc: "9.6.3"
-            platform_name: 24_04-x86-64
     steps:
       - name: Clone project
         uses: actions/checkout@v3
 
-      - name: Set up Docker Buildx
-        uses: docker/setup-buildx-action@v3
-
-      - name: Build and cache Docker image
-        uses: docker/build-push-action@v6
+      - name: Setup Haskell
+        uses: haskell-actions/setup@v2
         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 }}
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: "3.10.1.0"
 
       - name: Cache dependencies
-        uses: actions/cache@v4
+        uses: actions/cache@v2
         with:
           path: |
             ~/.cabal/store
             dist-newstyle
           key: ${{ matrix.os }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
 
-      - name: Start container
+      - name: Build
         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
+        run: cabal build --enable-tests
 
-      - name: Build smp-server (postgresql) and tests
-        shell: docker exec -t builder sh {0}
-        run: |
-          cabal update
-          cabal build --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
+      - name: Test
+        timeout-minutes: 40
         shell: bash
-        run: |
-          docker cp builder:/out/simplexmq-test .
+        run: cabal test --test-show-details=direct
 
-      - name: Copy smp-server (postgresql) from container and prepare it
+      - name: Prepare binaries
         if: startsWith(github.ref, 'refs/tags/v')
         shell: bash
         run: |
-          docker cp builder:/out/smp-server ./smp-server-postgres-ubuntu-${{ matrix.platform_name }}
-
-      - name: Build everything else (standard)
-        shell: docker exec -t builder sh {0}
-        run: |
-          cabal build
-          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
-        if: startsWith(github.ref, 'refs/tags/v')
-        shell: bash
-        run: |
-          docker cp builder:/out .
-          for i in ${{ env.apps }}; do mv ./out/$i ./$i-ubuntu-${{ matrix.platform_name }}; done
+          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')
+        if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'ubuntu-22.04'
         id: build_changelog
-        uses: mikepenz/release-changelog-builder-action@v5
+        uses: mikepenz/release-changelog-builder-action@v1
         with:
           configuration: .github/changelog_conf.json
           failOnError: true
@@ -138,7 +76,7 @@ jobs:
 
       - name: Create release
         if: startsWith(github.ref, 'refs/tags/v') && matrix.ghc != '8.10.7'
-        uses: softprops/action-gh-release@v2
+        uses: softprops/action-gh-release@v1
         with:
           body: |
             See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md).
@@ -148,18 +86,10 @@ jobs:
           prerelease: true
           files: |
             LICENSE
-            smp-server-ubuntu-${{ matrix.platform_name }}
-            smp-server-postgres-ubuntu-${{ matrix.platform_name }}
-            ntf-server-ubuntu-${{ matrix.platform_name }}
-            xftp-server-ubuntu-${{ matrix.platform_name }}
-            xftp-ubuntu-${{ matrix.platform_name }}
+            smp-server-ubuntu-${{ matrix.platform_name}}
+            ntf-server-ubuntu-${{ matrix.platform_name}}
+            xftp-server-ubuntu-${{ matrix.platform_name}}
+            xftp-ubuntu-${{ matrix.platform_name}}
           fail_on_unmatched_files: true
         env:
           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-
-      - name: Test
-        shell: bash
-        env:
-          PGHOST: localhost
-        run: |
-          ./simplexmq-test

.github/workflows/docker-image.yml

@@ -14,22 +14,22 @@ jobs:
       matrix:
         include:
           - app: smp-server
-            app_port: "443 5223"
+            app_port: 5223
           - app: xftp-server
-            app_port: 443
+            app_port: 443 
     steps:
       - name: Clone project
-        uses: actions/checkout@v4
+        uses: actions/checkout@v3
 
       - name: Log in to Docker Hub
-        uses: docker/login-action@v3
+        uses: docker/login-action@v2
         with:
           username: ${{ secrets.DOCKERHUB_USERNAME }}
           password: ${{ secrets.DOCKERHUB_PASSWORD }}
 
       - name: Extract metadata for Docker image
         id: meta
-        uses: docker/metadata-action@v5
+        uses: docker/metadata-action@v4
         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: docker/build-push-action@v4
         with:
           push: true
           build-args: |

CHANGELOG.md

@@ -1,106 +1,3 @@
-# 6.2.2
-
-SMP server:
-- add optional Prometheus metrics (#1411).
-
-Build:
-- remove three modules from client library.
-
-# 6.2.0
-
-Version 6.2.0.7
-
-Build:
-- client_library flag to build only used modules in the clients, remove package yaml
-
-SMP server:
-- journal storage for messages (BETA).
-- prevent race condition when deleting queue and to avoid "orphan" messages (#1395).
-
-SMP agent:
-- support SMP and XFTP server roles (storage/proxy) and operators (#1343).
-- treat blocked STM and other critical errors that offer restart as temporary for message delivery (#1405).
-- fix inconsistent state after app restart while accepting contact request (#1412).
-
-# 6.1.3
-
-SMP server: fix restoring notification credentials.
-
-# 6.1.2
-
-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):
-- Ntf server: send multiple SMP notifications in one iOS notification.
-- Agent: get multiple messages for one iOS notification.
-
-# 6.1.1
-
-SMP:
-- stop server faster (#1371)
-- add STORE error (#1372)
-
-# 6.1.0
-
-Version 6.1.0.7
-
-SMP server and client:
-- transport block encryption (#1317).
-
-Agent:
-- batch and optimize iOS notifications processing (#1308, #1311, #1313, #1316, #1330, #1331, #1333, #1337, #1346).
-- allow receiving multiple messages from single iOS notification (#1355, #1362).
-- prepare connection to accept to avoid race condition with events (#1365).
-- transport isolation mode "Session" (default) to use new SOCKS credentials when client restarts or SOCKS proxy configuration changes (#1321).
-
-Ntf server:
-- control port (#1354).
-- enable pings on ntf subscriptions, to resubscribe on reconnection (#1353).
-
-SMP server:
-- support multiple server ports (#1319).
-- support serving HTTPS and SMP transport on the same port (#1326, #1327).
-- persist iOS notifications to avoid losing them when Ntf server is offline (#1336, #1339, #1350).
-- fix lost notification subscriptions (#1347).
-- reject SKEY with different key earlier, at verification step (#1366).
-- pass server information via CLI during server initialization (#1356).
-- show version on server page (#1341).
-- explicit graceful shutdown on SIGINT (#1360).
-
-XRCP (remote access protocol):
-- use SHA3-256 in hybrid key agreement (#1302).
-- session encryption with forward secrecy (#1328).
-
-# 6.0.5
-
-SMP agent:
-- support generic SOCKS proxy (without isolate-by-auth).
-- reduce max message sizes
-
-# 6.0.4
-
-SMP server:
-- better performance/memory: fewer map updates on re-subscriptions (#1297), split and reduce STM transactions (#1294)
-- send DELD when subscribed queue is deleted (#1312)
-- add created/updated/used date to queues to manage expiration (#1306)
-
-XFTP server: truncate file creation time to 1 hour (#1310)
-
-Servers:
-- bind control port only to 127.0.0.1 for better security in case of firewall misconfiguration (#1280)
-- reduce memory used for period stats (#1298)
-
-Agent: process last notification from list (#1307)
-- report receive file error with redirected file ID, when redirect is present (#1304)
-- special error when deleted user record is not in database (#1303)
-- fix race when sending a message to the deleted connection (#1296)
-- support for multiple messages in a single notification
-
-Ntf server:
-- only use SOCKS proxy for servers without public address (#1314)
-
 # 6.0.3
 
 Agent:

Dockerfile

@@ -1,20 +1,15 @@
-# syntax=docker/dockerfile:1.7.0-labs
-ARG TAG=24.04
+ARG TAG=22.04
 
 FROM ubuntu:${TAG} AS build
 
 ### Build stage
 
 # Install curl and git and simplexmq dependencies
-RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-18 llvm-18-dev libnuma-dev libssl-dev
+RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev libssl-dev
 
 # Specify bootstrap Haskell versions
 ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
-ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.12.1.0
-
-# Do not install Stack
-ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK=true
-ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK=true
+ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0
 
 # Install ghcup
 RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
@@ -26,42 +21,26 @@ ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
 RUN ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" && \
     ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
 
-# Copy only the source code
-COPY apps /project/apps/
-COPY cbits /project/cbits/
-COPY src /project/src/
-
-COPY cabal.project Setup.hs simplexmq.cabal LICENSE /project
-
+COPY . /project
 WORKDIR /project
 
-# Debug
-#ARG CACHEBUST=1
-
-#ADD --chmod=755 https://github.com/MShekow/directory-checksum/releases/download/v1.4.6/directory-checksum_1.4.6_linux_amd64 /usr/local/bin/directory-checksum
-#RUN directory-checksum --max-depth 2 .
-
-# Set build arguments and check if they exist
 ARG APP
-RUN if [ -z "$APP" ]; then printf "Please spcify \$APP build-arg.\n"; exit 1; fi
+ARG APP_PORT
+RUN if [ -z "$APP" ] || [ -z "$APP_PORT" ]; then printf "Please spcify \$APP and \$APP_PORT build-arg.\n"; exit 1; fi
 
 # Compile app
 RUN cabal update
 RUN cabal build exe:$APP
 
-# Copy scripts
-COPY scripts /project/scripts/
-
 # Create new path containing all files needed
 RUN mkdir /final
 WORKDIR /final
 
 # Strip the binary from debug symbols to reduce size
-RUN bin="$(find /project/dist-newstyle -name "$APP" -type f -executable)" && \
+RUN bin=$(find /project/dist-newstyle -name "$APP" -type f -executable) && \
     mv "$bin" ./ && \
     strip ./"$APP" &&\
-    mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint &&\
-    mv /project/scripts/main/simplex-servers-stopscript ./simplex-servers-stopscript
+    mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint
 
 ### Final stage
 FROM ubuntu:${TAG}
@@ -74,8 +53,6 @@ COPY --from=build /final /usr/local/bin/
 
 # Open app listening port
 ARG APP_PORT
-RUN if [ -z "$APP_PORT" ]; then printf "Please spcify \$APP_PORT build-arg.\n"; exit 1; fi
-
 EXPOSE $APP_PORT
 
 # simplexmq requires using SIGINT to correctly preserve undelivered messages and restore them on restart

Dockerfile.build

@@ -1,31 +0,0 @@
-# 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

README.md

@@ -149,15 +149,8 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
 You can install and setup servers automatically using our script:
 
 ```sh
-curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh &&\
-if echo '53fcdb4ceab324316e2c4cda7e84dbbb344f32550a65975a7895425e5a1be757 simplex-server-install.sh' | sha256sum -c; then
-  chmod +x ./simplex-server-install.sh
-  ./simplex-server-install.sh
-  rm ./simplex-server-install.sh
-else
-  echo "SHA-256 checksum is incorrect!"
-  rm ./simplex-server-install.sh
-fi
+curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
+&& if echo 'c90886104cd640b2ed64921dba80e90691db36788e8d6dcc13d8f33f92f0ea54 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
 ```
 
 ### Build from source

apps/smp-server/Main.hs

@@ -19,4 +19,4 @@ 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
+  withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles cfgPath logPath

apps/smp-server/static/index.html

@@ -221,10 +221,6 @@
               Public information
             </h2>
             <table id="public-info">
-              <tr class="text-grey-black dark:text-white text-base">
-                <td>Server version:</td>
-                <td>${version}</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>
@@ -295,12 +291,6 @@
                   <td>${hostingEntity} (${hostingCountry})</td>
                 </tr>
               </x-hosting>
-              <x-hostingType>
-                <tr class="text-grey-black dark:text-white text-base">
-                  <td>Hosting type:</td>
-                  <td>${hostingType}</td>
-                </tr>
-              </x-hostingType>
               <x-serverCountry>
                 <tr class="text-grey-black dark:text-white text-base">
                   <td>Server country:</td>

apps/smp-server/web/Static.hs

@@ -7,30 +7,22 @@ module Static where
 import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Char (toUpper)
-import Data.IORef (readIORef)
+import qualified Data.ByteString as B
 import Data.Maybe (fromMaybe)
 import Data.String (fromString)
 import Data.Text.Encoding (encodeUtf8)
-import Network.Socket (getPeerName)
-import Network.Wai (Application)
-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 Network.Wai.Application.Static as S
+import Network.Wai.Handler.Warp as W
+import qualified Network.Wai.Handler.WarpTLS as W
 import Simplex.Messaging.Encoding.String (strEncode)
-import Simplex.Messaging.Server (AttachHTTP)
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
-import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (tshow)
 import Static.Embedded as E
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath
 import UnliftIO.Concurrent (forkFinally)
-import UnliftIO.Exception (bracket, finally)
 
 serveStaticFiles :: EmbeddedWebParams -> IO ()
 serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams} = do
@@ -39,44 +31,9 @@ serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams}
     W.runSettings (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
   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
+    W.runTLS (W.tlsSettings cert key) (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
   where
-    app = staticFiles webStaticPath
-    mkSettings port = W.setPort port warpSettings
-
--- | Prepare context and prepare HTTP handler for TLS connections that already passed TLS.handshake and ALPN check.
-attachStaticFiles :: FilePath -> (AttachHTTP -> IO ()) -> IO ()
-attachStaticFiles path action =
-  -- Initialize global internal state for http server.
-  WI.withII warpSettings $ \ii -> do
-    action $ \socket cxt -> do
-      -- Initialize internal per-connection resources.
-      addr <- getPeerName socket
-      withConnection addr cxt $ \(conn, transport) ->
-        withTimeout ii conn $ \th ->
-          -- Run Warp connection handler to process HTTP requests for static files.
-          WI.serveConnection conn ii th addr transport warpSettings app
-  where
-    app = staticFiles path
-    -- from warp-tls
-    withConnection socket cxt = bracket (WT.attachConn socket cxt) (terminate . fst)
-    -- from warp
-    withTimeout ii conn =
-      bracket
-        (WI.registerKillThread (WI.timeoutManager ii) (WI.connClose conn))
-        WI.cancel
-    -- shared clean up
-    terminate conn = WI.connClose conn `finally` (readIORef (WI.connWriteBuffer conn) >>= WI.bufFree)
-
-warpSettings :: W.Settings
-warpSettings = W.setGracefulShutdownTimeout (Just 1) W.defaultSettings
-
-staticFiles :: FilePath -> Application
-staticFiles root = S.staticApp settings
-  where
-    settings = (S.defaultFileServerSettings root)
-      { S.ssListing = Nothing
-      }
+    mkSettings port = setPort port defaultSettings
 
 generateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
 generateSite si onionHost sitePath = do
@@ -121,7 +78,6 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
       where
         basic =
           [ ("sourceCode", Just . encodeUtf8 $ sourceCode spi),
-            ("version", Just $ B.pack simplexMQVersion),
             ("website", encodeUtf8 <$> website spi)
           ]
         conds ServerConditions {conditions, amendments} =
@@ -153,8 +109,7 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
             ("hostingCountry", encodeUtf8 <$> country)
           ]
         server =
-          [ ("serverCountry", encodeUtf8 <$> serverCountry spi),
-            ("hostingType",  (\s -> maybe s (\(c, rest) -> toUpper c `B.cons` rest) $ B.uncons s) . strEncode <$> hostingType spi)
+          [ ("serverCountry", fmap encodeUtf8 $ serverCountry =<< information)
           ]
 
 -- Copy-pasted from simplex-chat Simplex.Chat.Types.Preferences

cabal.project

@@ -4,15 +4,6 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport
 
--- uncomment two sections below to run tests with coverage
--- package *
-   -- coverage: True
-   -- library-coverage: True
-
--- package attoparsec
-   -- coverage: False
-   -- library-coverage: False
-
 index-state: 2023-12-12T00:00:00Z
 
 package cryptostore
@@ -37,17 +28,3 @@ source-repository-package
     type: git
     location: https://github.com/simplex-chat/sqlcipher-simple.git
     tag: a46bd361a19376c5211f1058908fc0ae6bf42446
-
--- waiting for published warp-tls-3.4.7
-source-repository-package
-    type: git
-    location: https://github.com/yesodweb/wai.git
-    tag: ec5e017d896a78e787a5acea62b37a4e677dec2e
-    subdir: warp-tls
-
--- backported fork due http-5.0
-source-repository-package
-    type: git
-    location: https://github.com/simplex-chat/wai.git
-    tag: 2f6e5aa5f05ba9140ac99e195ee647b4f7d926b0
-    subdir: warp

install.sh

@@ -2,6 +2,9 @@
 set -eu
 
 # Links to scripts/configs
+bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
+remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+
 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"
@@ -54,7 +57,7 @@ ${GRN}1.${NC} Install latest binaries from GitHub releases:
 ${GRN}2.${NC} Create server directories:
     - smp: ${YLW}${path_conf_smp}${NC}
     - xftp: ${YLW}${path_conf_xftp}${NC}
-${GRN}3.${NC} Setup user for server:
+${GRN}3.${NC} Setup user for each server:
     - xmp: ${YLW}${user_smp}${NC}
     - xftp: ${YLW}${user_xftp}${NC}
 ${GRN}4.${NC} Create systemd services:
@@ -64,8 +67,9 @@ ${GRN}5.${NC} Install stopscript (systemd), update and uninstallation script:
     - all: ${YLW}${path_bin_update}${NC}, ${YLW}${path_bin_uninstall}${NC}, ${YLW}${path_bin_stopscript}${NC}
 
 Press:
-  - ${GRN}1${NC} to install smp server
-  - ${GRN}2${NC} to install xftp server
+  - ${GRN}ENTER${NC} to continue installing both xftp and smp servers
+  - ${GRN}1${NC} to install only smp server
+  - ${GRN}2${NC} to install only xftp server
   - ${RED}Ctrl+C${NC} to cancel installation
   
 Selection: "
@@ -79,21 +83,6 @@ Please checkout our server guides:
 To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
 "
 
-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
-}
-
 os_test() {
  . /etc/os-release
 
@@ -166,7 +155,6 @@ checks() {
   exit 1
  fi
  
- set_version
  os_test
 
  mkdir -p $path_conf_info  
@@ -178,11 +166,13 @@ main() {
  printf "%b\n%b" "${BLU}$logo${NC}" "$welcome"
  read ans
 
- case "$ans" in
-  1) setup='smp' ;;
-  2) setup='xftp' ;;
-  *) printf 'Installation aborted.\n' && exit 0 ;;
- esac
+ if [ "$ans" = '1' ]; then
+  setup='smp'
+ elif [ "$ans" = '2' ]; then
+  setup='xftp'
+ else
+  setup='smp xftp'
+ fi
 
  printf "Installing binaries..."
  

package.yaml

@@ -0,0 +1,212 @@
+name: simplexmq
+version: 6.0.3.0
+synopsis: SimpleXMQ message broker
+description: |
+  This package includes <./docs/Simplex-Messaging-Server.html server>,
+  <./docs/Simplex-Messaging-Client.html client> and
+  <./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
+  .
+  * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md SMP protocol>
+  * <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md SMP agent protocol>
+  .
+  See <https://github.com/simplex-chat/simplex-chat terminal chat prototype> built with SimpleXMQ broker.
+
+homepage: https://github.com/simplex-chat/simplexmq#readme
+license: AGPL-3
+author: simplex.chat
+maintainer: chat@simplex.chat
+copyright: 2020-2022 simplex.chat
+category: Chat, Network, Web, System, Cryptography
+extra-source-files:
+  - README.md
+  - CHANGELOG.md
+  - cbits/sha512.h
+  - cbits/sntrup761.h
+  - apps/smp-server/static/*.html
+  - apps/smp-server/static/media/*
+
+dependencies:
+  - aeson == 2.2.*
+  - ansi-terminal >= 0.10 && < 0.12
+  - asn1-encoding == 0.9.*
+  - asn1-types == 0.3.*
+  - async == 2.2.*
+  - attoparsec == 0.14.*
+  - base >= 4.14 && < 5
+  - base64-bytestring >= 1.0 && < 1.3
+  - case-insensitive == 1.2.*
+  - composition == 1.0.*
+  - constraints >= 0.12 && < 0.14
+  - containers == 0.6.*
+  - crypton == 0.34.*
+  - crypton-x509 == 1.7.*
+  - crypton-x509-store == 1.6.*
+  - crypton-x509-validation == 1.6.*
+  - cryptostore == 0.3.*
+  - data-default == 0.7.*
+  - direct-sqlcipher == 2.3.*
+  - directory == 1.3.*
+  - filepath == 1.4.*
+  - hashable == 1.4.*
+  - hourglass == 0.2.*
+  - http-types == 0.12.*
+  - http2 >= 4.2.2 && < 4.3
+  - ini == 0.4.1
+  - iproute == 1.7.*
+  - iso8601-time == 0.1.*
+  - memory == 0.18.*
+  - mtl >= 2.3.1 && < 3.0
+  - network >= 3.1.2.7 && < 3.2
+  - network-info >= 0.2 && < 0.3
+  - network-transport == 0.5.6
+  - network-udp >= 0.0 && < 0.1
+  - optparse-applicative >= 0.15 && < 0.17
+  - process == 1.6.*
+  - random >= 1.1 && < 1.3
+  - simple-logger == 0.1.*
+  - socks == 0.6.*
+  - sqlcipher-simple == 0.4.*
+  - stm == 2.5.*
+  - temporary == 1.3.*
+  - time == 1.12.*
+  - time-manager == 0.0.*
+  - tls >= 1.9.0 && < 1.10
+  - transformers == 0.6.*
+  - unliftio == 0.2.*
+  - unliftio-core == 0.2.*
+  - websockets == 0.12.*
+  - yaml == 0.11.*
+  - zstd == 0.1.3.*
+
+flags:
+  swift:
+    description: Enable swift JSON format
+    manual: True
+    default: False
+  use_crypton:
+    description: Use crypton etc. in cryptostore
+    manual: True
+    default: True
+
+# cpp-options:
+#   - -Dslow_servers
+
+when:
+  - condition: flag(swift)
+    cpp-options:
+      - -DswiftJSON
+  - condition: impl(ghc >= 9.6.2)
+    dependencies:
+      - bytestring == 0.11.*
+      - template-haskell == 2.20.*
+      - text >= 2.0.1 && < 2.2
+  - condition: impl(ghc < 9.6.2)
+    dependencies:
+      - bytestring == 0.10.*
+      - template-haskell == 2.16.*
+      - text >= 1.2.3.0 && < 1.3
+
+library:
+  source-dirs: src
+  c-sources:
+    - cbits/sha512.c
+    - cbits/sntrup761.c
+  include-dirs: cbits
+  extra-libraries: crypto
+
+executables:
+  smp-server:
+    source-dirs:
+    - apps/smp-server
+    - apps/smp-server/web
+    main: Main.hs
+    dependencies:
+      - file-embed
+      - simplexmq
+      - wai-app-static
+      - warp
+      - warp-tls
+    ghc-options:
+      - -threaded
+      - -rtsopts
+
+  ntf-server:
+    source-dirs: apps/ntf-server
+    main: Main.hs
+    dependencies:
+      - simplexmq
+    ghc-options:
+      - -threaded
+      - -rtsopts
+
+  xftp-server:
+    source-dirs: apps/xftp-server
+    main: Main.hs
+    dependencies:
+      - simplexmq
+    ghc-options:
+      - -threaded
+      - -rtsopts
+
+  xftp:
+    source-dirs: apps/xftp
+    main: Main.hs
+    dependencies:
+      - simplexmq
+    ghc-options:
+      - -threaded
+      - -rtsopts
+
+tests:
+  simplexmq-test:
+    source-dirs: tests
+    main: Test.hs
+    dependencies:
+      - simplexmq
+      - deepseq == 1.4.*
+      - generic-random == 1.5.*
+      - hspec == 2.11.*
+      - hspec-core == 2.11.*
+      - HUnit == 1.6.*
+      - QuickCheck == 2.14.*
+      - silently == 1.2.*
+      - main-tester == 0.2.*
+      - timeit == 2.0.*
+    ghc-options:
+      - -threaded
+      - -rtsopts
+      - -with-rtsopts=-A64M
+      - -with-rtsopts=-N1
+
+ghc-options:
+  # - -haddock
+  - -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-unused-packages
+  - -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
+
+default-extensions:
+  - StrictData

protocol/xftp.md

@@ -559,13 +559,11 @@ In current implementation of XFTP protocol in SimpleX Chat clients don't use FAC
 
  - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
 
- - observe how much traffic is being sent, and make guesses as to its purpose.
+ - observe how much traffic is being sent, and make guesses as to its purpose
 
- - in case of a compromised transport protocol, correlate file senders and receivers.
+*cannot, even in case of a compromised transport protocol:*
 
-*cannot, in case of a non-compromised transport protocol:*
-
- - perform traffic correlation attacks.
+ - perform traffic correlation attacks with any increase in efficiency over a non-compromised transport protocol
 
 #### XFTP server
 

protocol/xrcp.md

@@ -67,7 +67,7 @@ The session invitation contains this data:
 - CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
 - Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
 - Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
-- Session X25519 DH key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption.
+- Session X25519 DH key and SNTRUP761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption.
 
 Host application decrypts (except the first session) and validates the invitation:
 - Session signature is valid.
@@ -184,7 +184,7 @@ The controller decrypts (including the first session) and validates the received
 The controller should reply with with `ctrlHello` or `ctrlError` response:
 
 ```abnf
-ctrlHello = %s"HELLO " kemCiphertext encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
+ctrlHello = %s"HELLO " kemCiphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
 ; ctrlHelloJSON is encrypted with the hybrid secret,
 ; including both previously agreed DH secret and KEM secret from kemCiphertext
 unpaddedSize = largeLength
@@ -206,8 +206,6 @@ JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`:
 }
 ```
 
-Controller `hello` block and all subsequent protocol messages are encrypted with the chain keys derived from the hybrid key (see key exchange below) - that is why conntroller hello block does not include nonce. That provides forward secrecy within the XRCP session. Receiving this `hello` block allows host to compute the same hybrid keys and to derive the same chain keys.
-
 Once the controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections.
 
 ### Controller/host session operation
@@ -225,12 +223,10 @@ tlsunique channel binding from TLS session MUST be included in commands (include
 The syntax for encrypted command and response body encoding:
 
 ```abnf
-commandBody = counter encBody sessSignature idSignature [attachment]
-responseBody = counter encBody [attachment] ; counter must match command
-; counter is placed outside of encrypted body to allow correlating encryption keys
-; with the chain keys (each command and response are encrypted by different keys)
-encBody = encLength32 encrypted(tlsunique body)
-attachment = %x01 encLength32 encrypted(attachment)
+commandBody = encBody sessSignature idSignature [attachment]
+responseBody = encBody [attachment] ; counter must match command
+encBody = nonce encLength32 encrypted(tlsunique counter body)
+attachment = %x01 nonce encLength32 encrypted(attachment)
 noAttachment = %x00
 tlsunique = length 1*OCTET
 counter = 8*8 OCTET ; int64
@@ -243,7 +239,7 @@ If the command or response includes attachment, its hash must be included in com
 
 Initial announcement is shared out-of-band (URI with xrcp scheme), and it is not encrypted.
 
-This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA3-256 over concatenated DH shared secret and KEM encapsulated secret) to derive keys for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses.
+This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA256 over concatenated DH shared secret and KEM encapsulated secret) both for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses.
 
 During the next session the announcement is sent via encrypted multicast block. The shared key for this announcement and for host HELLO block is determined using the KEM shared secret from the previous session and DH shared secret computed using the host DH key from the previous session and the new controller DH key from the announcement.
 
@@ -277,22 +273,6 @@ If controller fails to store the new host DH key after receiving HELLO block, th
 
 To decrypt a multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
 
-Once kemSecret is agreed for the session, it is used to derive two chain keys, to receive and to send messages:
-
-```
-host: sndKey, rcvKey = HKDF(kemSecret, "SimpleXSbChainInit", 64)
-controller: rcvKey, sndKey  = HKDF(kemSecret, "SimpleXSbChainInit", 64)
-```
-
-where HKDF is based on SHA512, with empty salt.
-
-Actual keys and nonces to encrypt and decrypt messages are derived from these chain keys:
-
-```
-to send: (sndKey', sk, nonce) = HKDF(sndKey, "SimpleXSbChain", 88)
-to receive: (rcvKey', sk, nonce) = HKDF(rcvKey, "SimpleXSbChain", 88)
-```
-
 ## Threat model
 
 #### A passive network adversary able to monitor the site-local traffic:

rfcs/2024-09-01-smp-message-storage.md

@@ -1,179 +0,0 @@
-# SMP server message storage
-
-## Problem
-
-Currently SMP servers store all queues in server memory. As the traffic grows, so does the number of undelivered messages. What is worse, Haskell is not avoiding heap fragmentation when messages are allocated and then de-allocated - undelivered messages use ByteString and GC cannot move them around, as they use pinned memory.
-
-## Possible solutions
-
-### Solution 1: solve only GC fragmentation problem
-
-Move from ByteString to some other primitive to store messages in memory long term, e.g. ShortByteString, or manage allocation/de-allocation of stored messages manually in some other way.
-
-Pros: the simplest solution that avoids substantial re-engineering of the server.
-
-Cons:
-- not a long term solution, as memory growth still has limits.
-- may be ineffective, as it introduces additional copying of bytes.
-
-### Solution 2: move message storage to hard drive
-
-Use files or RocksDB to store messages.
-
-Pros:
-- much lower memory usage.
-- no message loss in case of abnormal server termination (important until clients have delivery redundancy).
-- this is a long term solution, and at some point it might need to be done anyway.
-
-Cons:
-- substantial re-engineering costs and risks.
-- metadata privacy. Currently we only save undelivered messages when server is restarted, with this approach all messages will be stored for some time. this argument is limited, as hosting providers of VMs can make memory snapshots too, on the other hand they are harder to analyze than files. On another hand, with this approach messages will be stored for a shorter time.
-
-#### RocksDB and other key-value stores
-
-The downside of any key-value stores is that they don't seem to have efficient primitives for sequential delivery. While sequential delivery can be modelled with linked lists, they would require 1 key insert (on send), 3 key updates (1 update to update queue data on send, 1 update of the last message to point to the next, 1 update on delivery or message expiration) and 1 key deletion (on delivery or message expiration) for each delivered message.
-
-This might result in substantial write amplification and compacting costs.
-
-In general, tree structures that are efficient for quick lookups and updates, given approximately fixed value size, are inefficient for modelling queues.
-
-#### Files
-
-The upside of files is that they are well suited for sequential delivery and don't result in the same churn, with careful design, as trees do.
-
-The downside of filesystem is that it does not scale well with the large number of files in a folder, so queues will have to be spread across multiple folders, following tree-like structure.
-
-I could not find an available library that efficiently models sequential delivery in highly concurrent environment.
-
-A possible design could be the following.
-
-##### Queue folder and files
-
-Each message queue is stored in its own folder (see below on folder locations). Folder would contain these files:
-
-- `messages.abcd.log` - the file that is used to read messages from, sequentially
-- `messages.efgh.log` - the optional file that is used to write messages, in case it is different from read file.
-- `queue.log` - append-only file where the last line represents the current queue state
-- `queue.timestamp.log` - previous states of queue.log file
-
-Each line in "queue.log" file has this syntax
-
-```abnf
-queueLogLine =
-    %s"read_file=" base64
-    %s"read_msg=" digits
-    %s"read_byte=" digits
-    %s"write_file=" base64
-    %s"write_msg=" digits
-```
-
-When queue is first requested by the server:
-
-```c
-if queue folder exists:
-    read queue state from last line of queue.log
-    if queue.log contained more than one line: // compaction
-        copy queue.log to queue.timestamp.log
-        write one line queue state to queue.log
-else:
-    create queue folder
-    create messages.abcd.log (abcd is some random string)
-    read_msg = 0
-    read_byte = 0
-    create queue.log with one line: "read_file=abcd read_msg=0 read_byte=0 write_files=abcd write_msg=0"
-open read_file in ReadMode and seek to read_byte position
-nextReadByte = read_byte
-nextReadMsg = read_msg
-open write_file in AppendMode
-```
-
-When message is added to the queue (assumes that queue state is loaded to server memory, if not the previous section will be done first):
-
-```c
-if write_msg > max_queue_messages:
-    return quota error
-else if write_msg = max_queue_messages:
-    add quota_exceeded message to write_file
-    update queue state: write_msg += 1
-    append updated queue state to queue.log
-else
-    // It is required that `max_queue_messages < max_file_messages`,
-    // so that we never need more than one additional write file.
-    if write_msg >= max_file_messages: // queue file rotation
-        create messages.efgh.log // efgh is some random string
-        update queue state: write_file=efgh write_msg=0 // read file remains the same as it was
-        append updated queue state to queue.log
-        copy queue.log to queue.timestamp.log
-        // `old` needs to be defined to limit the number and storage duration,
-        // preserving not more than N files, and not more than M days files, "and then some"
-        // (that is if the queue has high churn, we have file from M days before in any case, for any debugging).
-        delete `old` `queue.timestamp.log` files
-        write one line queue state to queue.log // compaction
-
-    add message to write_file
-    update queue state: write_msg += 1
-    append updated queue state to queue.log
-```
-
-The above algorithm assumes `max_queue_messages < than max_file_messages`, so that we never need more than one write file.
-
-When message is delivered, it is simply read from the read queue, queue state does not change yet:
-
-```c
-if nextReadMsg > read_msg:
-    deliver cached message, no need to read it again
-else
-    read message from read_file handle
-    nextReadMsg = read_msg + 1
-    nextReadByte = current position in file
-```
-
-When message delivery is acknowledged, the read queue needs to be advanced, and possibly switched to read from the current write_queue:
-
-```c
-if nextReadByte == read_byte:
-    return error // nothing was delivered
-else if nextReadByte = EOF:
-    // end of file is reached, possibly some other condition,
-    // but it should allow changing max_file_messages on server restart
-    currReadFile = read_file
-    read_file = write_file
-    read_msg = 0
-    read_byte = 0
-    append updated queue state to queue.log
-    delete currReadFile
-else
-    read_msg += 1
-    read_byte = nextReadByte
-    // `seek` should not be necessary, as the handle is already at nextReadByte position here
-    // seek to read_byte
-    append updated queue state to queue.log
-```
-
-The above algorithm delegates the problem of compaction and fragmentation management to file system, that is very optimized for such scenarios.
-
-Also, read and write files will grow to almost a constant size, so the space they used may be re-used.
-
-An important consideration is that writes to queue.log and message.log files and queue state modifications have to be sequential, without concurrency - it can be managed with the usual locks.
-
-##### Queue folders structure
-
-Most Linux systems use EXT4 filesystem where the file lookup time scales linearly to the number of files. While alternatives with logarithmic lookup time exist (XFS), they may be very complex to configure on the existing systems.
-
-So storing all queue folders in one folder won't scale.
-
-To solve this problem we could use recipient queue ID in base64url format not as a folder name, but as a folder path, splitting it to path fragments of some length. The number of fragments can be configurable and migration to a different fragment size can be supported as the number of queues on a given server grows.
-
-Currently, queue ID is 24 bytes random number, thus allowing 2^192 possible queue IDs. If we assume that a server must hold 1b queues, it means that we have ~2^162 possible addresses for each existing queue. 24 bytes in base64 is 32 characters that can be split into say 8 fragments with 4 characters each, so that queue folder path for queue with ID `abcdefghijklmnopqrstuvwxyz012345` would be:
-
-`/var/opt/simplex/messages/abcd/efgh/ijkl/mnop/qrst/uvwx/yz01/2345`
-
-The maximum theoretic number of the folders on the 1st level is 64^4, or 2^24 ~ 16m - this is probably still a large number of subfolders for EXT4. Given that addresses are random, all the possible combinations in the first folder can be used with a large number of queues.
-
-So we could use an unequal split of path, two letters each and the last being long:
-
-`/var/opt/simplex/messages/ab/cd/ef/ghijklmnopqrstuvwxyz012345`
-
-The first three levels in this case can have 4096 subfolders each, and it gives 68b possible subfolders (64^2^3), so the last level will be sparse in case of 1b queues on the server. So we could make it 4 levels with 2 letters to never think about it, accounting for a large variance of the random numbers distribution:
-
-`/var/opt/simplex/messages/ab/cd/ef/gh/ijklmnopqrstuvwxyz012345`

rfcs/2024-09-09-smp-blobs.md

@@ -1,80 +0,0 @@
-# Blob extensions for SMP queues
-
-Evolution of the design for short links, see [here](./2024-06-21-short-links.md) and [here](./2024-09-05-queue-storage.md).
-
-## Problems
-
-Allow storing extended information with SMP queues to improve UX and security of making connections:
-- short invitation links and contact addresses.
-- PQ encryption from the first message.
-- present user profile with chat preferences and welcome message when the public address link is scanned.
-
-## Design
-
-1. Queue creation/update date is already added to server persistence, allowing to expire queues and blobs, depending on their usage.
-2. Add "queue type" metadata to NEW command to indicate whether messaging queue is used as public address or as messaging queue (see previous docs on why it doesn't change threat model). While at the moment it would match sndSecure flag there may be future scenarios when they diverge. Initially only "invitation" and "contact" types will be supported.
-3. Prohibit sndSecure flag for "contact" queues, prohibit securing contact queues.
-4. Add "queue blobs" to NEW command:
-  - blob0: ratchetKeys up to N0 bytes - priority 0, can't be removed by the server, only in "invitation"
-  - blob1: PQ key up to N1 bytes - priority 1, can be removed by the server, only used in "invitation"
-  - blob2: Application data up to N2 bytes - priority 2, can be removed by the server.
-5. Add linkId to NEW command
-6. linkId and blobs will be removed when queue is secured.
-7. Add recipient command to remove/upsert blob2 for contact queues.
-8. Add sender command to retrieve blobs.
-
-## Protocol
-
-### Creating a queue:
-
-The queue owner:
-- generates Ed25529 key pair `(sk, spk)` and X25519 key pair `(dhk, dhpk)` to use with the server, same as now. `sk` and `dhk` will be sent in NEW command.
-- generates X25519 key pair `(k, pk)` to use with the accepting party to encrypt queue messages.
-- derives from `k` using HKDF:
-- symmetric key `bk` for authenticated encryption of blobs.
-- `linkId`, will be sent in NEW command.
-- `k` will be used as short link.
-- sends NEW command.
-
-NEW command syntax:
-
-```abnf
-create = %s"NEW " linkId queueType recipientAuthPublicKey recipientDhPublicKey
-                  basicAuth subscribe sndSecure [ "0" blob0 ] [ "1" blob1 ] [ "2" blob2 ] 
-queueType = %s"I" / %s "C" ; new parameter
-linkId = length *OCTET ; new parameter,
-                        ; can be empty in which case blobs won't be allowed
-blob0 = word16 *OCTET ; new parameter, encrypted ratchet keys,
-                      ; including nonce and auth tag
-blob1 = word16 *OCTET ; new parameter, encrypted PQ key
-blob2 = word16 *OCTET ; new parameter, encrypted application data
-```
-
-SET - command to update queue blobs (recipientId is used as entity ID):
-
-```abnf
-set = %s"SET " linkId [ "2" blob2 ] ; passing empty blob removes it
-linkId ; updated (or the same) linkId, can be empty to remove blobs
-        ; allows to change the address without removing the queue / changing blobs
-        ; (e.g., to avoid losing the messages).
-```
-
-### Sending messages to the queue
-
-GET - command to get queue blobs (linkId is used as entity ID):
-
-```abnf
-get = %s"GET"
-```
-
-Response to GET:
-
-```abnf
-blobs = %s"BLOB" senderId [ "0" blob0 ] [ "1" blob1 ] [ "2" blob2 ]
-```
-
-As blobs are retrieved using a separate linkId, once blobs are removed it will be impossible to find senderId from short link - it is a threat model improvement. Once server storage is compacted, it will be impossible to find queue related to the link even with the access to server data (unless server preserves the data).
-
-### Possible privacy improvement
-
-We could only allow unauthorized GET and authorized SET commands for long-term "contact" queues, and return BLOB in response to SKEY (or require that GET is authorized) - so that only the person who secures the queue will get access to data blobs. This way it ensures that the parties transmitting the invitation links cannot retrieve their content without the sender noticing it.

rfcs/2024-09-10-private-rendezvous.md

@@ -1,26 +0,0 @@
-# Private rendezvous protocol
-
-## Problem
-
-Our current handshake protocol is open to this attack: whoever observes the link exchange, knows on which server connection is being made, and if the traffic on this server is observed, then it can confirm communication between parties. Further, even with the [last proposal](./2024-09-09-smp-blobs.md#possible-privacy-improvement), having real-time access to the server data allows to establish the exact messaging queue that is used to send messages.
-
-## Solution
-
-We could make the initial link exchange more private by making it harder for any observer to discover which server will be used for messaging by hiding this information from the server that hosts the initial link.
-
-Preliminary, the protocol could be the following:
-
-1. Connection initiator stores 224-256 bytes of encrypted connection link on a rendezvous server (link contains server host and linkId on another messaging server, not a rendezvous one).
-
-2. Rendezvous server adds these links to buckets, up to 64 links per bucket. Bucket ID is the timestamp when the bucket was created + a sequential bucket number, in case more than one bucket is created per second.
-
-3. The server responds to the link creator with a bucket ID where this link was added. That bucket ID is its timestamp + a number prevents server "fingerprinting" clients and using say one bucket for each client. If timestamp is different or a bucket number within this timestamp is too large, the client can refuse to use it, depending on the client settings.
-
-4. The initiating party will pass to the accepting party the rendezvous server host, the hash of this bucket ID (bucket link) and the passphrase to derive the key from. The initiating party has an option to pass a link and passphrase via two channels - in which case the link will only contain the bucket ID.
-
-5. The accepting party would then request the bucket via its ID hash (the server would store hashes to be able to look up - hash is used to prevent showing time in the link) and attempt to decrypt all contained links using the provided key.
-The accepting party then will continue the connection via the decrypted link.
-
-This obviously does not protect accepting party from the initiating party, if it can choose rendezvous server it controls. It also does not protect from the malicious rendezvous server that would collaborate with link observers. I think reunion doesn’t protect from it too.
-
-But it does protect connection from whoever observes the link, particularly if this link only contains the bucket and the key is passed separately, via some other channel.

rfcs/2024-09-15-shared-port.md

@@ -1,163 +0,0 @@
-# Sharing protocol ports with HTTPS
-
-Some networks block all ports other than web ports, including port 5223 used for SMP protocol by default. Running SMP servers on a common web port 443 would allow them to work on more networks. The servers would need to provide an HTTPS page for browsers (and probes).
-
-## Problem
-
-Browsers and tools rely on system CA bundles instead of certificate pinning.
-The crypto parameters used by HTTPS are different from what the protocols use.
-Public certificate providers like LetsEncrypt can only sign specific types of keys and Ed25519 isn't one of them.
-
-This means a server should distinguish browser and protocol clients and adjust its behavior to match.
-
-## Solution
-
-`tls` package has a server hook that allows producing a different set of `TLS.Credentials` according to a client-provided "Server Name Indication" extension.
-
-Since LE certificates are only handed out to domain names, TLS client will be sending the SNI.
-However client transports are constructed over connected sockets and the SNI wouldn't be present unless explicitly requested.
-When a client sends SNI, then it's a browser and a web credentials should be used.
-Otherwise it's a protocol client to be offered the self-signed ca, cert and key.
-
-When a transport colocated with a HTTPS, its ALPN list should be extended with `h2 http/1.1`.
-The browsers will send it, and it should be checked before running transport client.
-If HTTP ALPN is detected, then the client connection is served with HTTP `Application` instead (the same "server information" page).
-
-If some client connects to server IP, doesn't send SNI and doesn't send ALPN, it will look like a pre-handshake client.
-In that case a server will send its handshake first.
-This can be mitigated by delaying its handshake and letting the probe to issue its HTTP request.
-
-## Implementation plan
-
-An unmodified client should be able to use protocols on port 443 right away.
-
-The switchover happens inside `runTransportServerState` before `runClient`:
-
-```haskell
-runServer (tcpPort, ATransport t) = do
-  -- ...
-  runTransportServerState_ ss started tcpPort serverParams tCfg $ \socket h -> do -- expose raw socket for warp-tls internals to attach
-    negotiated <- getSessionALPN
-    if allowHTTP t && isHTTP negotiated -- only attempt the switch for the TLS transport
-      then runHTTP socket (tlsContext h)-- ... collect data and produce values needed to run WAI Application
-      else runClient serverSignKey t h `runReaderT` env -- performs serverHandshake etc as usual
-```
-
-The web app and server live outside, so `runHttp` has to be provided by the `runSMPServer` caller.
-Additonally, Warp is using its `InternalInfo` object that's scoped to `withII` bracket.
-
-```haskell
-  runServer ini = do
-    -- ...
-
-    runWebServer ini ServerInformation {config, information} $ if sharedHttps then Nothing else webHttpsParams -- suppress serving https
-    if sharedHttps
-      then withRunHTTP staticFilesPath \attachStatic -> runSMPServer cfg (Just attachStatic) -- provide wrapped application runner
-      else runSMPServer cfg Nothing
-```
-
-### Upstream
-
-The implementation relies on a few modification to upstream code:
-- `warp-tls`: The library provides `httpOverTls`, but it wants to do handshake itself.
-  Since we have to do the handshake to switch on ALPN, the setup function has to be split.
-  This is a resonable change that may be upstreamed and nothing blocks us from using the recent version.
-- `warp`: Only the re-export of `serveConnection` is needed.
-  Unfortunately the most recent `warp` version can't be used right away due to dependency cascade around `http-5` and `auto-update-2`.
-  So a fork containing the backported re-export has to be used until the dependencies are refreshed.
-
-
-### TLS.ServerParams
-
-When a server has port sharing enabled, a new set of TLS params is loaded and combined with transport params:
-
-```haskell
-newEnv config = do
-  -- ...
-  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  sharedServerParams <- forM ((,) <$> sharedHttpsCredentials config <*> alpn transportConfig) $ \((chain, key), alpn) ->
-    let ca = Nothing -- It is possible to provide CA certificate, but it is typical for web server to use combined certificate chains
-    loadHTTPSServerParams tlsServerParams ca chain key alpn
-```
-
-`loadHTTPSServerParams` extends params with:
-1. `onALPNClientSuggest` hook gets `["h2", "http/1.1"]` added to the ALPN list which is now required.
-2. `onServerNameIndication` hook added, which upon detecting client SNI prepends the web credentials.
-3. `sharedCredentials = T.Credentials []` should be done to prevent transport credentials confusing browsers.
-    But that aborts key exchange somewhere in tls internals, so disabled for now.
-    As a workaround, another set of dummy credentials can be provided in the hope that any sane browser would reject them.
-    Like, RC4 ciphers, "impossible" digest combination, etc.
-
-### supportedParameters
-
-TLS certificate chains provided by LetsEncrypt use ECDSA/P256 and that requires extending `supportedParameters` with things disabled in transports:
-
-```haskell
-    browserCiphers =
-      [ TE.cipher_TLS13_AES128CCM8_SHA256
-      , TE.cipher_ECDHE_ECDSA_AES128CCM8_SHA256
-      , TE.cipher_ECDHE_ECDSA_AES256CCM8_SHA256
-      ]
-    browserGroups =
-      [ T.P256
-      ]
-    browserSigs =
-      [ (T.HashSHA256, T.SignatureECDSA),
-        (T.HashSHA384, T.SignatureECDSA)
-      ]
-```
-
-This may not be enough for other certificate providers.
-
-## Configuration
-
-> XXX: This is for the current implementation and should be updated.
-
-Web certificate chain is picked up from the WEB section:
-
-```ini
-[TRANSPORT]
-port: 443
-
-[WEB]
-https: 443
-cert: /etc/opt/simplex/web.cert
-key: /etc/opt/simplex/web.key
-
-# Alternatively, with a proper access configuration, the paths can point to the LE creds directly:
-# cert: /etc/letsencrypt/live/smp.hostname.tld/fullchain.pem
-# key: /etc/letsencrypt/live/smp.hostname.tld/privkey.pem
-```
-
-When `TRANSPORT.port` matches `WEB.https` the transport server becomes shared.
-
-Perhaps a more desirable option would be explicit configuration resulting in additional transported to run:
-
-```ini
-[TRANSPORT]
-port: 5223 ; pure protocol transport
-# control_port: 5224
-shared_port: 443 ; variant 1: register in TRANSPORT
-
-[WEB]
-https: 443
-cert: /etc/opt/simplex/web.cert
-key: /etc/opt/simplex/web.key
-# transport: on ; variant 2:
-```
-
-## Caveats
-
-Serving static files and the protocols togother may pose a problem for those who currently use dedicated web servers as they should switch to embedded http handlers.
-
-As before, using embedded HTTP server is increasing attack surface.
-
-Users who want to run everything on a single host will have to add and extra IP address and bind servers to specific IPs instead of 0.0.0.0.
-An amalgamated server binary can be provided that would contain both SMP and XFTP servers, where transport will dispatch connections by handshake ALPN.
-
-## Alternative: Use transports routable with reverse-proxies
-
-An "industrial" reverse proxy may do the ALPN routing, serving HTTP by itself and delegating `smp` and `xftp` to protocol servers.
-Same with the `websockets`.
-
-Since this in effect does TLS termination, the protocol servers will have to rely on credentials from protocol handshakes.

rfcs/2024-09-25-ios-notifications-2.md

@@ -1,49 +0,0 @@
-# iOS notifications delivery
-
-## Problem
-
-For iOS notifications to be delivered the client has to create credentials for notification subscription on SMP server using NKEY command and after that create a subscription on notification server using SNEW command. These two commands are sent in sequence, after the connections are created, and for it to happen the client needs to be online and in foreground.
-
-iOS users tend to close the app when it is not used, and iOS has very limited permissions for background activities, so these notification subscriptions are created with a substantial delay, and notifications do not work.
-
-This problem is distinct from and probably more common than other problems affecting notifications delivery described [here](./2024-07-06-ios-notifications.md).
-
-## Solution
-
-1. When the new connection is created, the client already knows if it needs to create notification subscription or not, based on the conversation setting (e.g., if the group is muted, the client will not create notification subscription as well.). We should extend NEW command to avoid the need to send additional NKEY command with an option to create notification subscription at the point where connection is created. NDEL would still be used to disable this notification, and NKEY will be used to re-enable it.
-
-2. In the same way we stopped using SDEL command (NDEL sends notification DELD to subscribed notification server) to delete notificaiton subscriptions from notification server, we should delegate creating notification subscription on notification server to SMP servers. Clients could use keys agreed with ntf server for e2e encryption and for command authorization to encrypt and sign instruction to create notification subscription that will be forwarded to notification server using protocol similar to SMP proxies. This will avoid the need for clients to separately contact notification servers that won't happen until they are online.
-
-3. Instead of making Ntf server trust DELD notifications, we could send deletion instructions signed by the client, which will only fail to send in case notification server is down (and they won't be sent later after server restart).
-
-Cons:
-- If SMP servers were to retain in the storage the information about which notification server is used for which queue, it would reduce metadata privacy. While currently it is not an issue, as all notification servers are known and operated by us, once there are other client apps, this can be used for app users fingerprinting, which would act as a deterrence from using new apps – but only if app users use servers of operators who are different from the app provider. To mitigate it, we could only store it in server memory and include notification instruction in subscription commands (SUB) and include notification subscription status in SUB responses. We don't need to mitigate the problem of server being able to store this information, as messaging servers can observe which notification servers connect to them anyway.
-- If SMP server is restarted before the subscription request is forwared to the notification server, then it will have to be forwarded again, once the client subscribes. The problem here is that if the client is offline, it will neither subscribe to the queue to send notification subscription request, nor receive notifications from this queue. Storing notification server and subscription request would mitigate that, as in this case we could send all pending requests on server start, without depending on client subscriptions.
-- "Small" agent will need to support connections to ntf servers and manage workers that retry sending pending subscription requests.
-- Until the client learns the public keys of notification server, it will not be able to decrypt notifications. It potentially can be mitigated by using the public key of the server returned when token is created, in this way different client keys (per-queue) will be combined with the same ntf server key (per-token).
-
-## Implementation details
-
-1. NEW and NKEY commands will need to be extended to include notification subscription request. As the notifier ID needs to be sent to notification server, this notifier ID will have to be client-generated and supplied as part of NEW command.
-
-now:
-
-```haskell
-NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
-NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
-```
-
-extended:
-
-```haskell
-NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Maybe NtfRequest -> Command Recipient
-
-data NtfRequest = NtfRequest NotifierId NtfPublicAuthKey RcvNtfPublicDhKey NtfServerRequest
-
-data NtfServerRequest = NtfServerRequest NtfServer EncSingedNtfCmd
-
-NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Maybe NtfServerRequest -> Command Recipient
--- NotifierID is passed in entity ID field of the transmission
-```
-
-2. Notification server will need to support an additional command to receive "proxied" subscription commands, `SFWD`, that would include `NtfServerRequest`. This command can include both `SNEW` and `SDEL` commands.

rfcs/2024-11-25-journal-expiration.md

@@ -1,15 +0,0 @@
-# Expiring messages in journal storage
-
-## Problem
-
-The journal storage servers recently migrated to do not delete delivered or expired messages, they only update pointers to journal file lines. The messages are actually deleted when the whole journal file is deleted (when fully deleted or fully expired).
-
-The problem is that in case the queue stops receiving the new messages then writing of messages won't switch to the new journal file, and the current journal file containing delivered or expired messages would never be deleted.
-
-## Solution
-
-Remove current journal file and update queue_state.log during message expiration of "idle" queue (that is, without any new messages received or delivered within 3 hours) in case when:
-- the queue is "empty" after the expiration
-- the queue contains only quota marker(s), in which case move them to a new journal file and update the queue_state accordingly. Quota markers can be kept indefinitely to prevent writing the new messages to the dormant queues that reached capacity, so it's important to handle this case.
-
-Also remove current journal file when the queue is opened in case it is empty (as it would not be ever expired in case it remains empty), and also update queue_state.log

rfcs/2024-11-25-queue-blobs-2.md

@@ -1,58 +0,0 @@
-# Blob extensions for SMP queues 2 and queue storage
-
-This document evolves the design proposed [here](./2024-09-09-smp-blobs.md).
-
-## Problems
-
-In addition to problems in the first doc, we have these issues with in-memory queue record storage:
-- many queues are idle or rarely used, but they are loaded to memory, and currently just loading all queues uses 20gb RAM on each server, and takes 10 min to process, increasing downtimes during restarts.
-- adding blobs to memory would make this problem much worse.
-
-## Proposed solution
-
-Move queues to the same journalling approach as [used for messages](./2024-09-01-smp-message-storage.md) now, with independent file names in the same folders.
-
-Each queue change would be logged to its own file, and every time the queue is opened the whole file will be read and compacted to a single line - replacing one store log for all queues, with individual log files for each queue.
-
-Queue deletion would not be making a record in the file, instead it would be deleting the entire folder - it would reduce retention period for any metadata of deleted queues.
-
-We could additionally record deletions to the central log, for debugging, and reset it on every start. But in this case we should not remove folders at the point of deletion, but rather mark them as deleted and delete on restart. TBC
-
-It would also allow simplifying blob storage by having only one blob per queue - for example, limied to 16kb (a bit smaller to fit in block) for contact address queues and 4-8kb for invitations (to fit PQ keys and conversation preferences).
-
-We would also need to be able to lookup recipient ID via sender/notifier/link IDs.
-
-One possible solution is to use and load to memory a central index file. But it is likely to also consume a lot of memory and result in slow starts.
-
-Another solution that is probably better is to use the same folder structure and put notifier/sender/link files with the ID of the recipient queue inside the files. So to locate recipient queue the sender would have to locate folder containing the reference file pointing to the recipient queue and then to locate the actual queue data.
-
-## Implementation details
-
-Each queue folder would these files:
-
-- queue_state.log (and timestamped backups) - to store pointers to message journals (already implemented)
-- messages.randomBase64.log - message journals (already implemented)
-- queue_rec.log (and timestamped backups) - to log complete queue record every time it is changed (so only the last line needs to be read following the same logic as with queue_state.log, to prevent file corruption).
-- blob.data, blob.data.bak, blob.timestamp.data - files for data blobs (to make sure some copy of this file is readable/correct in case of write corruption) - the same two step overwrite process will be used as currently with store log compacting:
-  - on write: 1. if file exists, move it to .bak, 2. store new blob to .data, 3. move .bak to .timestamp.data
-  - on read: 1. if .bak exists, move it to .data 2. use .data
-
-Additional suggestion to reduce probability of queue_state.log and queue_rec.log file corruption is to do one of the following:
-- log end of lines in the beginning of the output, not in the end, to prevent the last line from being corrupted in case the previous line was not fully stored. The downside is that the file will not be EOL terminated, and there will be no confirmation that the output was fully made.
-- log EOL both in the beginning and at the end of output, and ignore empty lines in between - this would both confirm that the last line is fully logged and prevent corruption of the next line in case it was not.
-- check the last byte of the file and log EOL if it is not EOL. Probably cleanest approach, but with a small performance cost.
-
-If queue folder is a reference to the queue, it may have one of these files:
-- notifier.id
-- sender.id
-- link.id
-
-These files would contain a one line with the recipient ID of the queue. These files would never change, they can only be deleted when queue is deleted or when notifier/link is deleted.
-
-There is logic in code preventing using the same ID in different contexts, and the ID size is large enough to make any collisions unlikely (192 bits), so with correctly working code the queue folder would either have one of reference files, and nothing else, or the queue and message files from the beginning of this section. But even if the same ID is re-used in different context, it should not cause any problems as file names don't overlap.
-
-While we could store different types of references in different types of folders, it would have additional costs of maintaining 4 folder hierarchies. Instead we could use the fact that it is one hierarchy to prevent using the same ID in different contexts.
-
-## Protocol
-
-The only change in protocol is that there will be only one blob per queue, without markers (see the previous doc). Otherwise the protocol and proposed privacy improvement seem reasonable.

rfcs/2025-03-16-smp-queues.md

@@ -1,255 +0,0 @@
-# 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,
-- improving notifications.
-
-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 communicate over and queues to send invitations. 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 superpeer addresses for the group.
-
-This proposal also combines NEW and NKEY command to streamline notifications in preparation to reworking of the notifications protocol.
-
-## Design objectives
-
-We want to achieve these objectives:
-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 existense 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 must have immutable part and mutable part.
-
-Immutable part would include:
-- full conection 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 inlcude:
-- any links to chat relays that should be contacted instead of this queue (not in this RFC), but would allow delegating group connections and contact request connections to prevent spam, hiding online presense, etc.
-- and user-defined data - user profile or group profile.
-
-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
-
-NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> 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 NewQueueRequest = NewQueueRequest
-  { rcvAuthKey :: RcvPublicAuthKey,
-    rcvDhKey :: RcvPublicDhKey,
-    basicAuth :: Maybe BasicAuth,
-    subMode :: SubscriptionMode,
-    ntfRequest :: Maybe NtfRequest,
-    queueLink :: Maybe QueueLink -- it is Maybe to allow testing and staged roll-out
-  }
-
--- To allow updating the existing contact addresses without changing them.
--- This command would fail on queues that support sndSecure and also on new queues created with QLMessaging.
--- RecipientId is entity ID.
--- The response to this command is `OK`.
-LNEW :: LinkId -> QueueLinkData -> Command Recipient
-
--- Replaces NKEY command
--- This avoids additional command required from the client to enable notifications.
--- Further changes would move NotifierId generation to the client, and including a signed and encrypted command to be forwarded by SMP server to notification server.
-data NtfRequest = NtfRequest NtfPublicAuthKey RcvNtfPublicDhKey
-
--- QLMessaging implies that sender can secure the queue.
--- LinkId is not used with QLMessaging, 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 QLContact, 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 QueueLink = QLMessaging QueueLinkData | QLContact LinkId QueueLinkData
-
-data QueueLinkData = QueueLinkData EncImmutableDataBytes EncUserDataBytes
-
-newtype EncImmutableDataBytes = EncImmutableDataBytes ByteString
-
-newtype EncUserDataBytes = EncUserDataBytes ByteString
-
--- We need to use binary encoding for AConnectionRequestUri to reduce its size
--- connReq including the full link allows connection redundancy.
--- The clients would reject changed immutable data (based on auth tag in the link) and
--- AConnectionRequestUri where SenderId of the queue does not match.
-data ImmutableLinkData = ImmutableLinkData
-  { signature :: SignatureEd25519, -- signature of the remaining part of immutable data
-    connReq :: AConnectionRequestUri,
-    sigKey :: PublicKeyEd25519
-  }
-
--- This part of link data can also include any relays, but possibly we need a separate blob for it
-data UserLinkData = UserLinkData
-  { signature :: SignatureEd25519, -- signs the remaining part of the data
-    userData :: ByteString -- the max size needs to be estimated, but it is likely to be ~ 14kb
-  }
-
--- | 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
-    serverNtfCreds :: Maybe ServerNtfCreds -- currently returned in NID response
-  }
-
-data ServerNtfCreds = ServerNtfCreds NotifierId RcvNtfPublicDhKey -- NotifierId is server-generated.
-```
-
-In addition to that we add the command allowing to update and also to retrieve and, optionally, secure the queue and get link data in one request, to have only one request:
-
-```haskell
--- With RecipientId as entity ID, the command to update mutable part of link data
--- The response is OK here.
-LSET :: EncUserDataBytes -> 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 QLContact (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 here
-LKEY :: SndPublicAuthKey -> Command Sender
-
--- If queue mode is QLMessaging the command will fail.
--- Entity ID is LinkId here
-LGET :: Command Sender
-
--- Response to LKEY and LGET
--- Entity ID is LinkId here
-LINK :: SenderId -> QueueLinkData -> BrokerMsg
-```
-
-## 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 existense checks.
-
-**Prepare queue link data**
-
-- the queue owner generates a random 256 bit `link_key` that will be used in the link URI.
-- for 1-time links: crypto_box key and 2 nonces to encrypt link data are derived from link_uri using HKDF: `cb_key <> nonce1 <> nonce2 = HKDF(link_key, 80 bytes)` (nonce1 is used for immutable and nonce2 for user-defined parts).
-- for contact address links: key and 2 nonces and linkId will be derived: `link_id <> cb_key <> nonce1 <> nonce2 = HKDF(link_key, 104 bytes)`
-- both parts of link data are encrypted with crypto_box, and included into `NEW` or `LNEW` commands.
-
-**Retrieving queue link data**
-
-- the sender uses `LinkId` from URI (or derived from URI) as entity ID to retrieve link data.
-- for one time links the sender must authorize the request to retrieve the data, the key is provided with the first request, preventing undetected access by link observers.
-- having received the link data, the client can now decrypt it using secret_box.
-
-## Threat model
-
-**Compromised SMP server**
-
-can:
-- delete link data.
-- hide link selectively from some requests.
-
-cannot:
-- undetectably replace link data, even if they have 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).
-- undetectbly check the existense of messaging queue or 1-time link (objective 8).
-- replace or delete the link data.
-
-**Queue owner who did not comprmise 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 presense of `SenderId` in `LINK` response from the server.
-2. Encryption of link data with crypto_box.
-3. Auth tag in the link prevents server modification of immutable part of link data. Signature verification key in immutable part, and signing of mutable part prevents server modification of mutable part of link data.
-4. No server command to change immutable part of link data once it's set.
-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 only includes auth tag for immutable part, mutable part includes signature.
-8. Temporarily public IDs (SenderId and LinkId for 1-time invitations) are generated server-side, and cannot be provided by the clients when creating the queues to check if these IDs are free.
-
-## Syntax for short links
-
-The proposed syntax:
-
-```abnf
-shortConnectionLink = %s"https://" smpServerHost "/" linkUri [ "?" param *( "&" param ) ]
-smpServerHost = <hostname> ; RFC1123, RFC5891
-linkUri = %s"i#" serverInfo oneTimeLinkBytes / %s"c#" serverInfo contactLinkBytes
-oneTimeLinkBytes = <base64url(linkId | linkKey | linkAuthTag)> ; 60 bytes / 80 base64 encoded characters
-contactLinkBytes = <base64url(linkKey | linkAuthTag)> ; 48 bytes / 64 base64 encoded characters
-; linkId - 96 bits/24 bytes
-; linkKey - 256 bits/32 bytes
-; linkAuthTag - 128 bits/16 bytes auth tag from encryption of immutable link data>
-
-serverInfo = [fingerprint "@" [hostnames "/"]] ; not needed for preset servers, required otherwise - the clients must refuse to connect if they don't have fingerprint in the code.
-
-fingerprint = <base64url(server offline certificate fingerprint)>
-hostnames = "h=" <hostname> *( "," <hostname> ) ; additional hostnames, e.g. onion
-```
-
-To have shorter links fingerpring and additional server hostnames do not need to be specified for preconfigured 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 (108 characters):
-
-```
-https://smp12.simplex.im/i#abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789
-```
-
-Example contact link for preset server (92 characters):
-
-```
-https://smp12.simplex.im/c#abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcd
-```
-
-Example contact link for user-defined server (with fingerprint, but without onion hostname - 136 characters):
-
-```
-https://smp1.example.com/c#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcd
-```
-
-Example contact link for user-defined server (with fingerprint ant onion hostname - 199 characters):
-
-```
-https://smp1.example.com/c#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion/abcdefghij0123456789abcdefghij0123456789abcdefghij0123456789abcd
-```
-
-For the links to work in the browser the servers must provide server pages.

rfcs/done/2023-10-25-remote-control.md

@@ -53,7 +53,7 @@ The session invitation contains this data:
 - CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
 - Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
 - Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
-- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. This DH public key is always sent unencrypted. NaCL Cryptobox is used for encryption.
+- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. These DH public key and KEM encapsulation key are always sent unencrypted. NaCL Cryptobox is used for encryption.
 
 Host device decrypts (except the first session) and validates the invitation:
 - Session signature is valid.

scripts/docker/docker-compose-smp-complete.yml

@@ -1,67 +0,0 @@
-name: SimpleX Chat - smp-server
-
-services:
-  oneshot:
-    image: ubuntu:latest
-    environment:
-      CADDYCONF: |
-        ${CADDY_OPTS:-}
-
-        http://{$$ADDR} {
-            redir https://{$$ADDR}{uri} permanent
-        }
-
-        {$$ADDR}:8443 {
-            tls {
-                key_type rsa4096
-            }
-        }
-    command: sh -c 'if [ ! -f /etc/caddy/Caddyfile ]; then printf "$${CADDYCONF}" > /etc/caddy/Caddyfile; fi'
-    volumes:
-      - ./caddy_conf:/etc/caddy
-
-  caddy:
-    image: caddy:latest
-    depends_on:
-      oneshot:
-        condition: service_completed_successfully
-    cap_add:
-      - NET_ADMIN
-    environment:
-      ADDR: ${ADDR?"Please specify the domain."}
-    volumes:
-      - ./caddy_conf:/etc/caddy
-      - caddy_data:/data
-      - caddy_config:/config
-    ports:
-      - 80:80
-    restart: unless-stopped
-    healthcheck:
-      test: "test -d /data/caddy/certificates/${CERT_PATH:-acme-v02.api.letsencrypt.org-directory}/${ADDR} || exit 1"
-      interval: 1s
-      retries: 60
-
-  smp-server:
-    image: ${SIMPLEX_IMAGE:-simplexchat/smp-server:latest}
-    depends_on:
-      caddy:
-        condition: service_healthy
-    environment:
-      ADDR: ${ADDR?"Please specify the domain."}
-      PASS: ${PASS:-}
-    volumes:
-      - ./smp_configs:/etc/opt/simplex
-      - ./smp_state:/var/opt/simplex
-      - type: volume
-        source: caddy_data
-        target: /certificates
-        volume:
-          subpath: "caddy/certificates/${CERT_PATH:-acme-v02.api.letsencrypt.org-directory}/${ADDR}"
-    ports:
-      - 443:443
-      - 5223:5223
-    restart: unless-stopped
-
-volumes:
-  caddy_data:
-  caddy_config:

scripts/docker/docker-compose-smp-manual.yml

@@ -1,15 +0,0 @@
-name: SimpleX Chat - smp-server
-
-services:
-  smp-server:
-    image: ${SIMPLEX_IMAGE:-simplexchat/smp-server:latest}
-    environment:
-      WEB_MANUAL: ${WEB_MANUAL:-1}
-      ADDR: ${ADDR?"Please specify the domain."}
-      PASS: ${PASS:-}
-    volumes:
-      - ./smp_configs:/etc/opt/simplex
-      - ./smp_state:/var/opt/simplex
-    ports:
-      - 5223:5223
-    restart: unless-stopped

scripts/docker/docker-compose-smp.env

@@ -1,11 +0,0 @@
-# Mandatory
-ADDR=your_ip_or_addr
-
-# Optional
-#PASS='123123'
-#WEB_MANUAL=1
-
-# Debug
-#SIMPLEX_SMP_IMAGE=smp-server-dev
-#CERT_PATH=acme-staging-v02.api.letsencrypt.org-directory
-#CADDY_OPTS='{\n    acme_ca https://acme-staging-v02.api.letsencrypt.org/directory\n}'

scripts/docker/docker-compose-xftp.env

@@ -1,9 +0,0 @@
-# Mandatory
-ADDR=your_ip_or_addr
-QUOTA=120gb
-
-# Optional
-#PASS='123123'
-
-# Debug
-#SIMPLEX_XFTP_IMAGE=xftp-server-dev

scripts/docker/docker-compose-xftp.yml

@@ -1,16 +0,0 @@
-name: SimpleX Chat - xftp-server
-
-services:
-  xftp-server:
-    image: ${SIMPLEX_XFTP_IMAGE:-simplexchat/xftp-server:latest}
-    environment:
-      ADDR: ${ADDR?"Please specify the domain."}
-      QUOTA: ${QUOTA?"Please specify disk quota."}
-      PASS: ${PASS:-}
-    volumes:
-      - ./xftp_configs:/etc/opt/simplex-xftp
-      - ./xftp_state:/var/opt/simplex-xftp
-      - ./xftp_files:/srv/xftp
-    ports:
-      - 443:443
-    restart: unless-stopped

scripts/docker/entrypoint-smp-server

@@ -1,87 +1,48 @@
 #!/usr/bin/env sh
-set -e
-
 confd='/etc/opt/simplex'
-cert_path='/certificates'
+logd='/var/opt/simplex/'
 
 # Check if server has been initialized
 if [ ! -f "${confd}/smp-server.ini" ]; then
   # If not, determine ip or domain
   case "${ADDR}" in
-    '')
-      printf 'Please specify $ADDR environment variable.\n'
-      exit 1
-      ;;
-
-    # Determine domain or IPv6
+    '') printf 'Please specify $ADDR environment variable.\n'; exit 1 ;;
     *[a-zA-Z]*)
       case "${ADDR}" in
-        # IPv6
-        *:*)
-          set -- --ip "${ADDR}"
-          ;;
-
-        # Domain
-        *)
-          case "${ADDR}" in
-            # It's in domain format
-            *.*)
-              # Determine the base domain
-              ADDR_BASE="$(printf '%s' "$ADDR" | awk -F. '{print $(NF-1)"."$NF}')"
-              set -- --fqdn "${ADDR}" --own-domains="${ADDR_BASE}"
-              ;;
-
-            # Incorrect domain
-            *)
-              printf 'Incorrect $ADDR environment variable. Please specify the correct one in format: smp1.example.org / example.org \n'
-              exit 1
-              ;;
-          esac
+        *:*) set -- --ip "${ADDR}" ;;
+        *) set -- -n "${ADDR}" ;;
       esac
       ;;
-
-    # Assume everything else is IPv4
-    *)
-      set -- --ip "${ADDR}" ;;
+    *) set -- --ip "${ADDR}" ;;
   esac
 
   # Optionally, set password
   case "${PASS}" in
-    # Empty value = no password
-    '')
-      set -- "$@" --no-password
-      ;;
-
-    # Assume that everything else is a password
-    *)
-      set -- "$@" --password "${PASS}"
-      ;;
+    '') set -- "$@" --no-password ;;
+    *) set -- "$@" --password "${PASS}" ;;
   esac
 
   # And init certificates and configs
-  smp-server init --yes \
-                  --store-log \
-                  --daily-stats \
-                  --source-code \
-                  "$@" > /dev/null 2>&1
-
-  # Fix path to certificates
-  if [ -n "${WEB_MANUAL}" ]; then
-    sed -i -e 's|^[^#]*https: |#&|' \
-           -e 's|^[^#]*cert: |#&|' \
-           -e 's|^[^#]*key: |#&|' \
-           -e 's|^port:.*|port: 5223|' \
-           "${confd}/smp-server.ini"
-  else
-    sed -i -e "s|cert: /etc/opt/simplex/web.crt|cert: $cert_path/$ADDR.crt|" \
-           -e "s|key: /etc/opt/simplex/web.key|key: $cert_path/$ADDR.key|" \
-           "${confd}/smp-server.ini"
-  fi
+  smp-server init -y -l "$@"
 fi
 
 # Backup store log just in case
-DOCKER=true /usr/local/bin/simplex-servers-stopscript smp-server
+#
+# Uses the UTC (universal) time zone and this
+# format: YYYY-mm-dd'T'HH:MM:SS
+# year, month, day, letter T, hour, minute, second
+#
+# This is the ISO 8601 format without the time zone at the end.
+#
+_file="${logd}/smp-server-store.log"
+if [ -f "${_file}" ]; then
+  _backup_extension="$(date -u '+%Y-%m-%dT%H:%M:%S')"
+  cp -v -p "${_file}" "${_file}.${_backup_extension:-date-failed}"
+  unset -v _backup_extension
+fi
+unset -v _file
 
 # Finally, run smp-sever. Notice that "exec" here is important:
 # smp-server replaces our helper script, so that it can catch INT signal
 exec smp-server start +RTS -N -RTS
+

scripts/docker/entrypoint-xftp-server

@@ -1,90 +1,50 @@
 #!/usr/bin/env sh
-set -eu
-
 confd='/etc/opt/simplex-xftp'
+logd='/var/opt/simplex-xftp'
 
 # Check if server has been initialized
 if [ ! -f "${confd}/file-server.ini" ]; then
   # If not, determine ip or domain
   case "${ADDR}" in
-    '')
-      printf 'Please specify $ADDR environment variable.\n'
-      exit 1
-      ;;
-
-    # Determine domain or IPv6
+    '') printf 'Please specify $ADDR environment variable.\n'; exit 1 ;;
     *[a-zA-Z]*)
       case "${ADDR}" in
-        # IPv6
-        *:*)
-          set -- --ip "${ADDR}"
-          ;;
-
-        # Domain
-        *)
-          case "${ADDR}" in
-            # Check if format is correct
-            *.*)
-              set -- --fqdn "${ADDR}"
-              ;;
-
-            # Incorrect domain
-            *)
-              printf 'Incorrect $ADDR environment variable. Please specify the correct one in format: smp1.example.org / example.org \n'
-              exit 1
-              ;;
-          esac
-          ;;
+        *:*) set -- --ip "${ADDR}" ;;
+        *) set -- -n "${ADDR}" ;;
       esac
       ;;
-
-    # Assume everything else is IPv4
-    *)
-      set -- --ip "${ADDR}"
-      ;;
+    *) set -- --ip "${ADDR}" ;;
   esac
 
-  # Set global disk quota
+  # Set quota
   case "${QUOTA}" in
-    '')
-      printf 'Please specify $QUOTA environment variable.\n'
-      exit 1
-      ;;
-
-    # Incorrect format in uppercase, but automagically workaround this, replacing characters to lowercase
-    *GB)
-      QUOTA="$(printf '%s' "${QUOTA}" | tr '[:upper:]' '[:lower:]')"
-      set -- "$@" --quota "${QUOTA}"
-      ;;
-
-    # Correct format  
-    *gb)
-      set -- "$@" --quota "${QUOTA}"
-      ;;
-
-    # Incorrect format
-    *)
-      printf 'Wrong format. Format should be: 1gb, 10gb, 100gb.\n'
-      exit 1
-      ;;
+    '') printf 'Please specify $QUOTA environment variable.\n'; exit 1 ;;
+    *GB) QUOTA="$(printf ${QUOTA} | tr '[:upper:]' '[:lower:]')"; set -- "$@" --quota "${QUOTA}" ;;
+    *gb) set -- "$@" --quota "${QUOTA}" ;;
+    *) printf 'Wrong format. Format should be: 1gb, 10gb, 100gb.\n'; exit 1 ;;
   esac
 
   # Init the certificates and configs
-  xftp-server init --store-log \
-                   --path /srv/xftp \
-                   "$@" > /dev/null 2>&1
-
-  # Optionally, set password
-  if [ -n "${PASS}" ]; then
-    sed -i -e "/^# create_password:/a create_password: $PASS" \
-           "${confd}/file-server.ini"
-  fi
+  xftp-server init -l -p /srv/xftp "$@"
 fi
 
 # Backup store log just in case
-
-DOCKER=true /usr/local/bin/simplex-servers-stopscript xftp-server
+#
+# Uses the UTC (universal) time zone and this
+# format: YYYY-mm-dd'T'HH:MM:SS
+# year, month, day, letter T, hour, minute, second
+#
+# This is the ISO 8601 format without the time zone at the end.
+#
+_file="${logd}/file-server-store.log"
+if [ -f "${_file}" ]; then
+  _backup_extension="$(date -u '+%Y-%m-%dT%H:%M:%S')"
+  cp -v -p "${_file}" "${_file}.${_backup_extension:-date-failed}"
+  unset -v _backup_extension
+fi
+unset -v _file
 
 # Finally, run xftp-sever. Notice that "exec" here is important:
 # smp-server replaces our helper script, so that it can catch INT signal
 exec xftp-server start +RTS -N -RTS
+

scripts/main/simplex-servers-stopscript

@@ -1,176 +1,30 @@
 #!/usr/bin/env sh
 set -eu
 
-# Common
-# ------
+path_conf_var="/var/opt"
+path_conf_smp="$path_conf_var/simplex"
+path_conf_xftp="$path_conf_var/simplex-xftp"
+path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
+path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
 date="$(date -u '+%Y-%m-%dT%H:%M:%S')"
 
-GRN='\033[0;32m'
-YLW='\033[1;33m'
-BLU='\033[1;34m'
-RED='\033[0;31m'
-NC='\033[0m'
-
-path_conf_var="/var/opt"
-
-smp_variables() {
-	path_conf_smp="$path_conf_var/simplex"
-	path_conf_smp_archive="$path_conf_smp/backups"
-	path_conf_smp_archive_storelog="$path_conf_smp_archive/queues"
-	path_conf_smp_archive_stats="$path_conf_smp_archive/stats"
-	path_conf_smp_archive_messages="$path_conf_smp_archive/messages"
-	path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
-	path_conf_storelog_smp_out="$path_conf_smp_archive_storelog/smp-server-store.log.${date:-date-failed}"
-
-	path_conf_stats_smp="$path_conf_smp/smp-server-stats.log"
-	path_conf_stats_smp_out="$path_conf_smp_archive_stats/smp-server-stats.log.${date:-date-failed}"
-
-	path_conf_messages_smp="$path_conf_smp/smp-server-messages.log"
-	path_conf_messages_smp_out="$path_conf_smp_archive_messages/smp-server-messages.log.${date:-date-failed}"
+backup_smp() {
+ if [ -e "$path_conf_storelog_smp" ]; then
+  cp "$path_conf_storelog_smp" "${path_conf_storelog_smp}.${date:-date-failed}"
+ fi
 }
 
-xftp_variables() {
-	path_conf_xftp="$path_conf_var/simplex-xftp"
-	path_conf_xftp_archive="$path_conf_xftp/backups"
-
-	path_conf_xftp_archive_storelog="$path_conf_xftp_archive/queues"
-	path_conf_xftp_archive_stats="$path_conf_xftp_archive/stats"
-
-	path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
-	path_conf_storelog_xftp_out="$path_conf_xftp_archive_storelog/file-server-store.log.${date:-date-failed}"
-
-	path_conf_stats_xftp="$path_conf_xftp/file-server-stats.log"
-	path_conf_stats_xftp_out="$path_conf_xftp_archive_stats/file-server-stats.log.${date:-date-failed}"
+backup_xftp() {
+ if [ -e "$path_conf_storelog_xftp" ]; then
+  cp "$path_conf_storelog_xftp" "${path_conf_storelog_xftp}.${date:-date-failed}"
+ fi
 }
 
-checks() {
-	result=${SERVICE_RESULT:-exit-code}
-	status=${EXIT_STATUS:-TERM}
-
-	case "$result" in
-		success)
-			case "$status" in
-				TERM)
-					printf "${RED}Refusing to backup files with failed service state${NC}\n"
-					exit 1
-					;;
-				*)
-					:
-					;;
-			esac
-			;;
-		*)
-			printf "${RED}Refusing to backup files with failed service state${NC}\n"
-			exit 1
-			;;
-	esac
-}
-
-smp_check() {
-	if [ ! -d "$path_conf_smp_archive_storelog" ]; then
-		mkdir -p "$path_conf_smp_archive_storelog"
-	fi
-	if [ ! -d "$path_conf_smp_archive_messages" ]; then
-		mkdir -p "$path_conf_smp_archive_messages"
-	fi
-	if [ ! -d "$path_conf_smp_archive_stats" ]; then
-		mkdir -p "$path_conf_smp_archive_stats"
-	fi
-}
-
-xftp_check() {
-	if [ ! -d "$path_conf_xftp_archive_storelog" ]; then
-		mkdir -p "$path_conf_xftp_archive_storelog"
-	fi
-	if [ ! -d "$path_conf_xftp_archive_stats" ]; then
-		mkdir -p "$path_conf_xftp_archive_stats"
-	fi
-}
-
-backup() {
-	file="$1"
-	out="$2"
-	file_type="$3"
-
-	if [ -e "$file" ]; then
-		if cp "$file" "$out"; then
-			printf "${YLW}${file_type}${NC} ${GRN}backup successful:${NC} ${BLU}%s${NC}\n" "${out}"
-		else
-			printf "${YLW}${file_type}${NC} ${RED}backup failed!${NC}\n"
-		fi
-	fi
-
-	unset file out file_type
-}
-
-cleanup() {
-	directory="$1"
-	
-	file_type="$2"
-	
-	files_date=$(find "$directory" -type f -exec stat --format="%y" {} + | awk '{print $1}' | sort -nr | uniq | awk 'NR==2')
-	
-	if [ -n "$files_date" ]; then
-		files=$(find "$directory" -type f -not -newermt "$files_date" -printf "%T@ %Tc %p\n" | sort -n | awk '{print $NF}')
-
-		if [ -n "$files" ]; then
-			printf '%s' "$files" | xargs rm -f
-			printf "${YLW}Old ${file_type} files${NC}${GRN} has been deleted:${NC}\n"
-			files_colored=$(printf '%s' "$files" | awk '{print "\033[1;34m"$0"\033[0m"}')
-			printf "${files_colored}\n"
-		fi
-	fi
-
-	unset directory file_type files_date files
-}
-
-smp_backup() {
-	backup "$path_conf_storelog_smp" "$path_conf_storelog_smp_out" 'Storelog'
-	backup "$path_conf_messages_smp" "$path_conf_messages_smp_out" 'Messages'
-	backup "$path_conf_stats_smp" "$path_conf_stats_smp_out" 'Stats'
-}
-
-smp_cleanup() {
-	cleanup "$path_conf_smp_archive_storelog" 'storelog'
-	cleanup "$path_conf_smp_archive_stats" 'stats'
-	cleanup "$path_conf_smp_archive_messages" 'messages'
-}
-
-xftp_backup() {
-	backup "$path_conf_storelog_xftp" "$path_conf_storelog_xftp_out" 'Storelog'
-	backup "$path_conf_stats_xftp" "$path_conf_stats_xftp_out" 'Stats'
-}
-
-xftp_cleanup() {
-	cleanup "$path_conf_xftp_archive_storelog" 'storelog'
-	cleanup "$path_conf_xftp_archive_stats" 'stats'
-}
-
-main() {
-	type="${1:-}"
-
-  if [ -z "${DOCKER+x}" ]; then
-  	checks
-  fi
-
-	case "$type" in
-		smp-server)
-			smp_variables
-			smp_check
-			smp_backup
-			smp_cleanup
-			;;
-		xftp-server)
-			xftp_variables
-			xftp_check
-			xftp_backup
-			xftp_cleanup
-			;;
-		*)
-			printf "${YLW}Unknown server type.${NC}\n"
-			exit 1
-			;;
-	esac 
-}
-
-main "$@"
+if [ "$1" = 'smp-server' ]; then
+ backup_smp
+elif [ "$1" = 'xftp-server' ]; then
+ backup_xftp
+else
+ backup_smp
+ backup_xftp
+fi

scripts/main/simplex-servers-update

@@ -1,8 +1,15 @@
 #!/usr/bin/env sh
 set -eu
 
-# Make sure that PATH variable contains /usr/local/bin
-PATH="/usr/local/bin:$PATH"
+# Links to scripts/configs
+bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
+
+scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
+scripts_systemd_smp="$scripts/smp-server.service"
+scripts_systemd_xftp="$scripts/xftp-server.service"
+scripts_update="$scripts/simplex-servers-update"
+scripts_uninstall="$scripts/simplex-servers-uninstall"
+scripts_stopscript="$scripts/simplex-servers-stopscript"
 
 # Default installation paths
 path_bin="/usr/local/bin"
@@ -17,9 +24,7 @@ path_systemd_smp="$path_systemd/smp-server.service"
 path_systemd_xftp="$path_systemd/xftp-server.service"
 
 # Temporary paths
-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="$(mktemp -d)"
 path_tmp_bin_update="$path_tmp_bin/simplex-servers-update"
 path_tmp_bin_uninstall="$path_tmp_bin/simplex-servers-uninstall"
 path_tmp_bin_stopscript="$path_tmp_bin/simplex-servers-stopscript"
@@ -34,549 +39,189 @@ 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
 
-######################
-### Misc functions ###
-######################
+os_test() {
+ . /etc/os-release
 
-# Checks "sanity" of downloaded thing, e.g. if it's really a script or binary
-check_sanity() {
-  path="$1"
-  criteria="$2"
+ 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
 
-  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}')"
+ version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+ arch="$(uname -p)"
 
-      if file "$path" | grep -q "$pattern"; then
-        sane=0
-      else
-        sane=1
-      fi
-      ;;
-    *) printf 'Unknown criteria.\n'; sane=1 ;;
-  esac
+ 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
 
-  unset path string
-
-  return "$sane"
+ bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
+ bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
 }
 
-# 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"
-
+installed_test() {
   set +u
-  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"
+  for i in $path_conf_etc/*; do
+    if [ -d "$i" ]; then
+      case "$i" in
+        *simplex) apps="smp $apps" ;;
+        *simplex-xftp) apps="xftp $apps" ;;
+      esac
     fi
   done
   set -u
-
-  if [ -z "$apps" ]; then
-    printf "${RED}No simplex servers installed! Aborting.${NC}\n"
-    exit 1
-  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
-
-      # 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
-      # If there isn't info file, populate it
-      printf "local_version_${server}=unset\n" >> "$path_conf_info/release"
-    fi
-  done
-
-  # Return 
-  return 0
 }
 
-# Checks the distro and sets the urls variables
-check_distro() {
-  . /etc/os-release
+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"
 
-  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
+  if diff -q "$path_bin_uninstall" "$path_tmp_bin_uninstall" > /dev/null 2>&1; then
+    printf -- "- ${YLW}Uninstall script is up-to-date${NC}.\n"
+    rm "$path_tmp_bin_uninstall"
+  else
+    printf -- "- Updating uninstall script..."
+    mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
+    printf "${GRN}Done!${NC}\n"
+  fi
 
-  version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
-  arch="$(uname -p)"
+  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
 
-  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
+  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
 }
 
-# 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
-
-  check_versions
-  check_distro
-
-  mkdir -p $path_conf_info $path_tmp_bin
-
-  return 0
-}
-
-#############################
-### Support functions END ###
-#############################
-
-######################
-### 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}"
+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}"
    
-    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}"
+  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"
-  done
+  fi
 
-  IFS="$OLD_IFS"
-  return 0
+  unset service scripts_systemd path_systemd path_tmp_systemd
 }
 
-# Updates binaries. This function depends on variables from "download_all"
 update_bins() {
-  OLD_IFS="$IFS"
+  service="${1}-server"
+  eval "bin=\$bin_${1}"
+  eval "path_bin=\$path_bin_${1}"
 
-  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}"
+  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}')"
 
-    # If systemd service is active
+  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 ${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 -- "- 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"
     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 -- "- 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"
     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}"
+  else
+    printf -- "- ${YLW}%s is up-to-date${NC}.\n" "$service"
   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
+  set_ver "$1"
 
-  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
+  unset service bin path_bin local_version
 }
 
-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
+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
 
-      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
+  os_test
+  installed_test
 
-  return "$check"
+  mkdir -p $path_conf_info
 }
 
-##########################
-### Main functions END ###
-##########################
-
-############
-### Init ###
-############
-
 main() {
-  # Early hook to print Done after script re-execution
-  if [ -n "${UPDATE_SCRIPT_DONE:-}" ]; then
+  checks
+
+  set +u
+  if [ "$1" != "continue" ]; then
+    set -u
+    printf "Updating scripts...\n"
+    update_scripts
+  else
+    set -u
     printf "${GRN}Done!${NC}\n"
   fi
 
-  # Early help menu
-  menu_init_help
-
-  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
+  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
+
+  rm -rf "$path_tmp_bin"
 }
 
 main "$@"

scripts/main/smp-server.service

@@ -5,22 +5,11 @@ Description=SMP server
 User=smp
 Group=smp
 Type=simple
-
 ExecStart=/usr/local/bin/smp-server start +RTS -N -RTS 
 ExecStopPost=/usr/local/bin/simplex-servers-stopscript smp-server
-
 LimitNOFILE=65535
 KillSignal=SIGINT
-
-TimeoutStartSec=infinity
 TimeoutStopSec=infinity
 
-Restart=on-failure
-RestartSec=10s
-StartLimitBurst=3
-StartLimitInterval=60s
-
-AmbientCapabilities=CAP_NET_BIND_SERVICE
-
 [Install]
 WantedBy=multi-user.target

scripts/main/xftp-server.service

@@ -5,21 +5,11 @@ Description=XFTP server
 User=xftp
 Group=xftp
 Type=simple
-
 ExecStart=/usr/local/bin/xftp-server start +RTS -N -RTS
 ExecStopPost=/usr/local/bin/simplex-servers-stopscript xftp-server
-
 LimitNOFILE=65535
 KillSignal=SIGINT
-
-TimeoutStartSec=infinity
 TimeoutStopSec=infinity
-
-Restart=on-failure
-RestartSec=10s
-StartLimitBurst=3
-StartLimitInterval=60s
-
 AmbientCapabilities=CAP_NET_BIND_SERVICE
    
 [Install]

scripts/reproduce-builds.sh

@@ -1,81 +0,0 @@
-#!/usr/bin/env sh
-set -eu
-
-TAG="$1"
-
-tempdir="$(mktemp -d)"
-init_dir="$PWD"
-
-mkdir -p "$init_dir/$TAG/from-source" "$init_dir/$TAG/prebuilt"
-
-git -C "$tempdir" clone https://github.com/simplex-chat/simplexmq.git &&\
-	cd "$tempdir/simplexmq" &&\
-	git checkout "$TAG"
-
-for os in 20.04 22.04 24.04; do
-	os_url="$(printf '%s' "$os" | tr '.' '_')"
-	mkdir -p "$init_dir/cache/cabal/builder-${os}" "$init_dir/cache/dist-newstyle/builder-${os}"
-	chmod g+wX "$init_dir/cache"
-
-	docker build \
-		--no-cache \
-		-f "$tempdir/simplexmq/Dockerfile.build" \
-		--build-arg TAG=${os} \
-		-t repro-${os} \
-		.
-
-	docker run \
-		-t \
-		-d \
-		-v "$init_dir/cache/cabal/builder-${os}:/root/.cabal" \
-		-v "$init_dir/cache/dist-newstyle/builder-${os}:/dist-newstyle" \
-		-v "$tempdir/simplexmq:/project" \
-		--name builder-${os} \
-		repro-${os}
-	
-	
-	apps='smp-server xftp-server ntf-server xftp'
-
-	# Regular build (all)
-	docker exec \
-		-t \
-		-e apps="$apps" \
-		builder-${os} \
-		sh -c 'ln -fs /dist-newstyle ./dist-newstyle && cabal update && cabal build && mkdir -p /out && for i in $apps; do bin=$(find /dist-newstyle -name "$i" -type f -executable); strip "$bin"; chmod +x "$bin"; mv "$bin" /out/; done'
-
-	docker cp \
-		builder-${os}:/out \
-		out-${os}
-
-	# PostgreSQL build (only smp-server)
-	docker exec \
-		-t \
-		builder-${os} \
-		sh -c 'ln -fs /dist-newstyle ./dist-newstyle && cabal update && cabal build -fserver_postgres exe:smp-server && mkdir -p /out && bin=$(find /dist-newstyle -name "smp-server" -type f -executable); strip "$bin"; chmod +x "$bin"; mv "$bin" /out/'
-
-	docker cp \
-		builder-${os}:/out/smp-server \
-		"$init_dir/$TAG/from-source/smp-server-postgres-ubuntu-${os_url}-x86-64"
-
-	curl -L \
-		--output-dir "$init_dir/$TAG/prebuilt/" \
-		-O \
-		"https://github.com/simplex-chat/simplexmq/releases/download/${TAG}/smp-server-postgres-ubuntu-${os_url}-x86-64"
-	
-	for app in $apps; do
-		curl -L \
-			--output-dir "$init_dir/$TAG/prebuilt/" \
-			-O \
-		       	"https://github.com/simplex-chat/simplexmq/releases/download/${TAG}/${app}-ubuntu-${os_url}-x86-64"
-
-		mv "./out-${os}/$app" "$init_dir/$TAG/from-source/${app}-ubuntu-${os_url}-x86-64"
-	done
-
-	docker stop builder-${os}
-	docker rm builder-${os} 
-	docker image rm repro-${os}
-done
-
-# Cleanup
-cd "$init_dir"
-rm -rf "$tempdir"

simplexmq.cabal

@@ -1,7 +1,11 @@
 cabal-version: 1.12
 
+-- This file has been generated from package.yaml by hpack version 0.35.0.
+--
+-- see: https://github.com/sol/hpack
+
 name:           simplexmq
-version:        6.3.1.0
+version:        6.0.3.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -62,31 +66,24 @@ flag use_crypton
   manual: True
   default: True
 
-flag client_library
-  description: Don't build server-related code.
-  manual: True
-  default: False
-
-flag client_postgres
-  description: Build with PostgreSQL instead of SQLite.
-  manual: True
-  default: False
-
-flag server_postgres
-  description: Build server with support of PostgreSQL.
-  manual: True
-  default: False
-
 library
   exposed-modules:
       Simplex.FileTransfer.Agent
       Simplex.FileTransfer.Chunks
       Simplex.FileTransfer.Client
       Simplex.FileTransfer.Client.Agent
+      Simplex.FileTransfer.Client.Main
       Simplex.FileTransfer.Client.Presets
       Simplex.FileTransfer.Crypto
       Simplex.FileTransfer.Description
       Simplex.FileTransfer.Protocol
+      Simplex.FileTransfer.Server
+      Simplex.FileTransfer.Server.Control
+      Simplex.FileTransfer.Server.Env
+      Simplex.FileTransfer.Server.Main
+      Simplex.FileTransfer.Server.Stats
+      Simplex.FileTransfer.Server.Store
+      Simplex.FileTransfer.Server.StoreLog
       Simplex.FileTransfer.Transport
       Simplex.FileTransfer.Types
       Simplex.FileTransfer.Util
@@ -100,14 +97,44 @@ library
       Simplex.Messaging.Agent.RetryInterval
       Simplex.Messaging.Agent.Stats
       Simplex.Messaging.Agent.Store
-      Simplex.Messaging.Agent.Store.AgentStore
-      Simplex.Messaging.Agent.Store.Common
-      Simplex.Messaging.Agent.Store.DB
-      Simplex.Messaging.Agent.Store.Interface
-      Simplex.Messaging.Agent.Store.Migrations
-      Simplex.Messaging.Agent.Store.Migrations.App
-      Simplex.Messaging.Agent.Store.Postgres.Options
-      Simplex.Messaging.Agent.Store.Shared
+      Simplex.Messaging.Agent.Store.SQLite
+      Simplex.Messaging.Agent.Store.SQLite.Common
+      Simplex.Messaging.Agent.Store.SQLite.DB
+      Simplex.Messaging.Agent.Store.SQLite.Migrations
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
@@ -125,13 +152,34 @@ library
       Simplex.Messaging.Encoding.String
       Simplex.Messaging.Notifications.Client
       Simplex.Messaging.Notifications.Protocol
+      Simplex.Messaging.Notifications.Server
+      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.Notifications.Transport
       Simplex.Messaging.Notifications.Types
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
+      Simplex.Messaging.Server
+      Simplex.Messaging.Server.CLI
+      Simplex.Messaging.Server.Control
+      Simplex.Messaging.Server.DataLog
+      Simplex.Messaging.Server.DataStore
+      Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.Expiration
-      Simplex.Messaging.Server.QueueStore.Postgres.Config
+      Simplex.Messaging.Server.Information
+      Simplex.Messaging.Server.Main
+      Simplex.Messaging.Server.MsgStore
+      Simplex.Messaging.Server.MsgStore.STM
+      Simplex.Messaging.Server.QueueStore
       Simplex.Messaging.Server.QueueStore.QueueInfo
+      Simplex.Messaging.Server.QueueStore.STM
+      Simplex.Messaging.Server.Stats
+      Simplex.Messaging.Server.StoreLog
       Simplex.Messaging.ServiceScheme
       Simplex.Messaging.Session
       Simplex.Messaging.TMap
@@ -145,6 +193,7 @@ library
       Simplex.Messaging.Transport.HTTP2.Server
       Simplex.Messaging.Transport.KeepAlive
       Simplex.Messaging.Transport.Server
+      Simplex.Messaging.Transport.WebSockets
       Simplex.Messaging.Util
       Simplex.Messaging.Version
       Simplex.Messaging.Version.Internal
@@ -153,116 +202,13 @@ library
       Simplex.RemoteControl.Discovery.Multicast
       Simplex.RemoteControl.Invitation
       Simplex.RemoteControl.Types
-  if flag(client_postgres)
-      exposed-modules:
-          Simplex.Messaging.Agent.Store.Postgres.Migrations.App
-          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
-          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
-  else
-      exposed-modules:
-          Simplex.Messaging.Agent.Store.SQLite
-          Simplex.Messaging.Agent.Store.SQLite.Common
-          Simplex.Messaging.Agent.Store.SQLite.DB
-          Simplex.Messaging.Agent.Store.SQLite.Migrations
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.App
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
-          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
-  if !flag(client_library)
-      exposed-modules:
-          Simplex.FileTransfer.Client.Main
-          Simplex.FileTransfer.Server
-          Simplex.FileTransfer.Server.Control
-          Simplex.FileTransfer.Server.Env
-          Simplex.FileTransfer.Server.Main
-          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.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(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(server_postgres)
-          exposed-modules:
-              Simplex.Messaging.Server.QueueStore.Postgres
-              Simplex.Messaging.Server.QueueStore.Postgres.Migrations
   other-modules:
       Paths_simplexmq
   hs-source-dirs:
       src
   default-extensions:
       StrictData
-  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-home-modules -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2
+  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-unused-packages -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
   include-dirs:
       cbits
   c-sources:
@@ -272,12 +218,14 @@ library
       crypto
   build-depends:
       aeson ==2.2.*
+    , ansi-terminal >=0.10 && <0.12
     , asn1-encoding ==0.9.*
     , asn1-types ==0.3.*
     , async ==2.2.*
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
+    , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
@@ -287,11 +235,14 @@ library
     , crypton-x509-validation ==1.6.*
     , cryptostore ==0.3.*
     , data-default ==0.7.*
+    , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
+    , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
     , memory ==0.18.*
@@ -300,55 +251,38 @@ library
     , network-info ==0.2.*
     , network-transport ==0.5.6
     , network-udp ==0.0.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
     , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
     , stm ==2.5.*
+    , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
     , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , websockets ==0.12.*
     , yaml ==0.11.*
     , zstd ==0.1.3.*
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON
-  if !flag(client_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) || 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
   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
   main-is: Main.hs
   other-modules:
       Paths_simplexmq
@@ -356,16 +290,75 @@ executable ntf-server
       apps/ntf-server
   default-extensions:
       StrictData
-  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
+  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-unused-packages -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
   build-depends:
-      base
-    , simple-logger
+      aeson ==2.2.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.14 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , crypton ==0.34.*
+    , crypton-x509 ==1.7.*
+    , crypton-x509-store ==1.6.*
+    , crypton-x509-validation ==1.6.*
+    , cryptostore ==0.3.*
+    , data-default ==0.7.*
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , hashable ==1.4.*
+    , hourglass ==0.2.*
+    , http-types ==0.12.*
+    , http2 >=4.2.2 && <4.3
+    , ini ==0.4.1
+    , iproute ==1.7.*
+    , iso8601-time ==0.1.*
+    , memory ==0.18.*
+    , mtl >=2.3.1 && <3.0
+    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
+    , network-transport ==0.5.6
+    , network-udp ==0.0.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
     , simplexmq
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , temporary ==1.3.*
+    , time ==1.12.*
+    , time-manager ==0.0.*
+    , tls >=1.9.0 && <1.10
+    , transformers ==0.6.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , yaml ==0.11.*
+    , zstd ==0.1.3.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
+  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 smp-server
-  if flag(client_library)
-      buildable: False
   main-is: Main.hs
   other-modules:
       Static
@@ -376,27 +369,79 @@ executable smp-server
       apps/smp-server/web
   default-extensions:
       StrictData
-  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
+  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-unused-packages -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
   build-depends:
-      base
-    , bytestring
-    , directory
+      aeson ==2.2.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.14 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , crypton ==0.34.*
+    , crypton-x509 ==1.7.*
+    , crypton-x509-store ==1.6.*
+    , crypton-x509-validation ==1.6.*
+    , cryptostore ==0.3.*
+    , data-default ==0.7.*
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
     , file-embed
-    , filepath
-    , network
-    , simple-logger
+    , filepath ==1.4.*
+    , hashable ==1.4.*
+    , hourglass ==0.2.*
+    , http-types ==0.12.*
+    , http2 >=4.2.2 && <4.3
+    , ini ==0.4.1
+    , iproute ==1.7.*
+    , iso8601-time ==0.1.*
+    , memory ==0.18.*
+    , mtl >=2.3.1 && <3.0
+    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
+    , network-transport ==0.5.6
+    , network-udp ==0.0.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
     , simplexmq
-    , text
-    , unliftio
-    , wai
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , temporary ==1.3.*
+    , time ==1.12.*
+    , time-manager ==0.0.*
+    , tls >=1.9.0 && <1.10
+    , transformers ==0.6.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
     , wai-app-static
-    , warp ==3.3.30
-    , warp-tls ==3.4.7
+    , warp
+    , warp-tls
+    , websockets ==0.12.*
+    , yaml ==0.11.*
+    , zstd ==0.1.3.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
+  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 xftp
-  if flag(client_library)
-      buildable: False
   main-is: Main.hs
   other-modules:
       Paths_simplexmq
@@ -404,15 +449,75 @@ executable xftp
       apps/xftp
   default-extensions:
       StrictData
-  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
+  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-unused-packages -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
   build-depends:
-      base
+      aeson ==2.2.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.14 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , crypton ==0.34.*
+    , crypton-x509 ==1.7.*
+    , crypton-x509-store ==1.6.*
+    , crypton-x509-validation ==1.6.*
+    , cryptostore ==0.3.*
+    , data-default ==0.7.*
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , hashable ==1.4.*
+    , hourglass ==0.2.*
+    , http-types ==0.12.*
+    , http2 >=4.2.2 && <4.3
+    , ini ==0.4.1
+    , iproute ==1.7.*
+    , iso8601-time ==0.1.*
+    , memory ==0.18.*
+    , mtl >=2.3.1 && <3.0
+    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
+    , network-transport ==0.5.6
+    , network-udp ==0.0.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
     , simplexmq
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , temporary ==1.3.*
+    , time ==1.12.*
+    , time-manager ==0.0.*
+    , tls >=1.9.0 && <1.10
+    , transformers ==0.6.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , yaml ==0.11.*
+    , zstd ==0.1.3.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
+  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 xftp-server
-  if flag(client_library)
-      buildable: False
   main-is: Main.hs
   other-modules:
       Paths_simplexmq
@@ -420,16 +525,75 @@ executable xftp-server
       apps/xftp-server
   default-extensions:
       StrictData
-  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
+  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-unused-packages -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
   build-depends:
-      base
-    , simple-logger
+      aeson ==2.2.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.14 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , crypton ==0.34.*
+    , crypton-x509 ==1.7.*
+    , crypton-x509-store ==1.6.*
+    , crypton-x509-validation ==1.6.*
+    , cryptostore ==0.3.*
+    , data-default ==0.7.*
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , hashable ==1.4.*
+    , hourglass ==0.2.*
+    , http-types ==0.12.*
+    , http2 >=4.2.2 && <4.3
+    , ini ==0.4.1
+    , iproute ==1.7.*
+    , iso8601-time ==0.1.*
+    , memory ==0.18.*
+    , mtl >=2.3.1 && <3.0
+    , network >=3.1.2.7 && <3.2
+    , network-info ==0.2.*
+    , network-transport ==0.5.6
+    , network-udp ==0.0.*
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , simple-logger ==0.1.*
     , simplexmq
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , temporary ==1.3.*
+    , time ==1.12.*
+    , time-manager ==0.0.*
+    , tls >=1.9.0 && <1.10
+    , transformers ==0.6.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , yaml ==0.11.*
+    , zstd ==0.1.3.*
   default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
+  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
 
 test-suite simplexmq-test
-  if flag(client_library)
-      buildable: False
   type: exitcode-stdio-1.0
   main-is: Test.hs
   other-modules:
@@ -440,16 +604,14 @@ test-suite simplexmq-test
       AgentTests.FunctionalAPITests
       AgentTests.MigrationTests
       AgentTests.NotificationTests
-      AgentTests.ServerChoice
+      AgentTests.SchemaDump
+      AgentTests.SQLiteTests
       CLITests
       CoreTests.BatchingTests
       CoreTests.CryptoFileTests
       CoreTests.CryptoTests
       CoreTests.EncodingTests
-      CoreTests.MsgStoreTests
       CoreTests.RetryIntervalTests
-      CoreTests.SOCKSSettings
-      CoreTests.StoreLogTests
       CoreTests.TRcvQueuesTests
       CoreTests.UtilTests
       CoreTests.VersionRangeTests
@@ -466,78 +628,84 @@ test-suite simplexmq-test
       XFTPCLI
       XFTPClient
       XFTPServerTests
-      Static
-      Static.Embedded
       Paths_simplexmq
-  if flag(client_postgres)
-      other-modules:
-          Fixtures
-  else
-      other-modules:
-          AgentTests.SchemaDump
-          AgentTests.SQLiteTests
   hs-source-dirs:
       tests
-      apps/smp-server/web
   default-extensions:
       StrictData
-  -- add -fhpc to ghc-options to run tests with coverage
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
+  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-unused-packages -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
-    , aeson
-    , async
-    , base64-bytestring
-    , bytestring
-    , containers
-    , crypton
-    , crypton-x509
-    , crypton-x509-store
-    , crypton-x509-validation
-    , directory
-    , file-embed
-    , filepath
-    , generic-random ==1.5.*
-    , hashable
-    , hspec ==2.11.*
-    , http-client
-    , http-types
-    , http2
-    , HUnit ==1.6.*
-    , ini
-    , iso8601-time
-    , main-tester ==0.2.*
-    , mtl
-    , network
+      HUnit ==1.6.*
     , QuickCheck ==2.14.*
-    , random
+    , aeson ==2.2.*
+    , ansi-terminal >=0.10 && <0.12
+    , asn1-encoding ==0.9.*
+    , asn1-types ==0.3.*
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.14 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , case-insensitive ==1.2.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , crypton ==0.34.*
+    , crypton-x509 ==1.7.*
+    , crypton-x509-store ==1.6.*
+    , crypton-x509-validation ==1.6.*
+    , cryptostore ==0.3.*
+    , data-default ==0.7.*
+    , deepseq ==1.4.*
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
+    , filepath ==1.4.*
+    , generic-random ==1.5.*
+    , hashable ==1.4.*
+    , hourglass ==0.2.*
+    , hspec ==2.11.*
+    , hspec-core ==2.11.*
+    , http-types ==0.12.*
+    , http2 >=4.2.2 && <4.3
+    , ini ==0.4.1
+    , iproute ==1.7.*
+    , iso8601-time ==0.1.*
+    , main-tester ==0.2.*
+    , memory ==0.18.*
+    , mtl >=2.3.1 && <3.0
+    , network >=3.1.2.7 && <3.2
+    , 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
     , silently ==1.2.*
-    , simple-logger
+    , simple-logger ==0.1.*
     , simplexmq
-    , stm
-    , text
-    , time
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , temporary ==1.3.*
+    , time ==1.12.*
+    , time-manager ==0.0.*
     , timeit ==2.0.*
-    , transformers
-    , unliftio
-    , unliftio-core
-    , unordered-containers
-    , wai
-    , wai-app-static
-    , warp
-    , warp-tls
-    , yaml
+    , tls >=1.9.0 && <1.10
+    , transformers ==0.6.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , websockets ==0.12.*
+    , yaml ==0.11.*
+    , zstd ==0.1.3.*
   default-language: Haskell2010
-  if flag(client_postgres)
-    cpp-options: -DdbPostgres
-  else
+  if flag(swift)
+    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
     build-depends:
-        deepseq ==1.4.*
-      , memory
-      , process
-      , sqlcipher-simple
-  if flag(client_postgres) || flag(server_postgres)
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
     build-depends:
-        postgresql-simple ==0.7.*
-  if flag(server_postgres)
-    cpp-options: -DdbServerPostgres
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

src/Simplex/FileTransfer/Agent.hs

@@ -51,7 +51,8 @@ import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
 import Simplex.FileTransfer.Chunks (toKB)
-import Simplex.FileTransfer.Client (XFTPChunkSpec (..), getChunkDigest, prepareChunkSizes, prepareChunkSpecs, singleChunkSize)
+import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
+import Simplex.FileTransfer.Client.Main
 import Simplex.FileTransfer.Crypto
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
@@ -65,8 +66,8 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
-import Simplex.Messaging.Agent.Store.AgentStore
-import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.SQLite
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
@@ -460,14 +461,14 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           pure srv
           where
             tryCreate = do
-              triedHosts <- newTVarIO S.empty
+              usedSrvs <- newTVarIO ([] :: [XFTPServer])
               let AgentClient {xftpServers} = c
               userSrvCount <- liftIO $ length <$> TM.lookupIO userId xftpServers
               withRetryIntervalCount (riFast ri) $ \n _ loop -> do
                 liftIO $ waitWhileSuspended c
                 liftIO $ waitForUserNetwork c
                 let triedAllSrvs = n > userSrvCount
-                createWithNextSrv triedHosts
+                createWithNextSrv usedSrvs
                   `catchAgentError` \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
@@ -476,10 +477,10 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
                     when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                   liftIO $ assertAgentForeground c
                   loop
-            createWithNextSrv triedHosts = do
+            createWithNextSrv usedSrvs = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
               when deleted $ throwE $ FILE NO_FILE
-              withNextSrv c userId storageSrvs triedHosts [] $ \srvAuth -> do
+              withNextSrv c userId usedSrvs [] $ \srvAuth -> do
                 replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
                 pure (replica, srvAuth)
 
@@ -545,8 +546,8 @@ runXFTPSndWorker c srv Worker {doWork} = do
         withStore' c $ \db -> updateSndFileComplete db sndFileId
       where
         addRecipients :: SndFileChunk -> SndFileChunkReplica -> AM SndFileChunkReplica
-        addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {sndChunkReplicaId, rcvIdsKeys}
-          | length rcvIdsKeys > numRecipients = throwE $ INTERNAL ("too many recipients, sndChunkReplicaId = " <> show sndChunkReplicaId)
+        addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {rcvIdsKeys}
+          | length rcvIdsKeys > numRecipients = throwE $ INTERNAL "too many recipients"
           | length rcvIdsKeys == numRecipients = pure cr
           | otherwise = do
               let numRecipients' = min (numRecipients - length rcvIdsKeys) maxRecipients

src/Simplex/FileTransfer/Client.hs

@@ -20,19 +20,15 @@ import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy as LB
 import Data.Int (Int64)
-import Data.List (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
-import Data.Maybe (listToMaybe)
-import Data.Time.Clock (UTCTime)
 import Data.Word (Word32)
 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 Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
+import Simplex.FileTransfer.Server.Env (supportedXFTPhandshakes)
 import Simplex.FileTransfer.Transport
 import Simplex.Messaging.Client
   ( NetworkConfig (..),
@@ -40,8 +36,8 @@ import Simplex.Messaging.Client
     TransportSession,
     chooseTransportHost,
     defaultNetworkConfig,
+    proxyUsername,
     transportClientConfig,
-    clientSocksCredentials,
     unexpectedResponse,
   )
 import qualified Simplex.Messaging.Crypto as C
@@ -56,7 +52,7 @@ import Simplex.Messaging.Protocol
     SenderId,
     pattern NoEntity,
   )
-import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
+import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Client
@@ -102,21 +98,21 @@ defaultXFTPClientConfig =
       clientALPN = Just supportedXFTPhandshakes
     }
 
-getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
-getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} proxySessTs disconnected = runExceptT $ do
-  let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
+getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
+getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} disconnected = runExceptT $ do
+  let username = proxyUsername transportSession
       ProtocolServer _ host port keyHash = srv
   useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
-  let tcConfig = (transportClientConfig xftpNetworkConfig useHost False) {alpn = clientALPN}
+  let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN}
       http2Config = xftpHTTP2Config tcConfig config
   clientVar <- newTVarIO Nothing
   let usePort = if null port then "443" else port
       clientDisconnected = readTVarIO clientVar >>= mapM_ disconnected
-  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client socksCreds useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
+  http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client (Just username) useHost usePort (Just keyHash) Nothing http2Config clientDisconnected
   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, batch = True}
   logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
   thParams@THandleParams {thVersion} <- case sessionALPN of
     Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
@@ -176,7 +172,7 @@ xftpHTTP2Config :: TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfi
 xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} =
   defaultHTTP2ClientConfig
     { bodyHeadSize = xftpBlockSize,
-      suportedTLSParams = defaultSupportedParams,
+      suportedTLSParams = supportedParameters,
       connTimeout = tcpConnectTimeout,
       transportConfig
     }
@@ -302,41 +298,3 @@ noFile HTTP2Body {bodyPart} a = case bodyPart of
 
 -- FACK :: FileCommand Recipient
 -- PING :: FileCommand Recipient
-
-singleChunkSize :: Int64 -> Maybe Word32
-singleChunkSize size' =
-  listToMaybe $ dropWhile (< chunkSize) serverChunkSizes
-  where
-    chunkSize = fromIntegral size'
-
-prepareChunkSizes :: Int64 -> [Word32]
-prepareChunkSizes size' = prepareSizes size'
-  where
-    (smallSize, bigSize)
-      | size' > size34 chunkSize3 = (chunkSize2, chunkSize3)
-      | size' > size34 chunkSize2 = (chunkSize1, chunkSize2)
-      | otherwise = (chunkSize0, chunkSize1)
-    size34 sz = (fromIntegral sz * 3) `div` 4
-    prepareSizes 0 = []
-    prepareSizes size
-      | size >= fromIntegral bigSize = replicate (fromIntegral n1) bigSize <> prepareSizes remSz
-      | size > size34 bigSize = [bigSize]
-      | otherwise = replicate (fromIntegral n2') smallSize
-      where
-        (n1, remSz) = size `divMod` fromIntegral bigSize
-        n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallSize) in if remSz2 == 0 then n2 else n2 + 1
-
-prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec]
-prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes
-  where
-    addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
-    addSpec (chunkOffset, specs) sz =
-      let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz}
-       in (chunkOffset + fromIntegral sz, spec : specs)
-
-getChunkDigest :: XFTPChunkSpec -> IO ByteString
-getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} =
-  withFile chunkPath ReadMode $ \h -> do
-    hSeek h AbsoluteSeek $ fromIntegral chunkOffset
-    chunk <- LB.hGet h (fromIntegral chunkSize)
-    pure $! LC.sha256Hash chunk

src/Simplex/FileTransfer/Client/Agent.hs

@@ -16,7 +16,6 @@ import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import Data.Text (Text)
 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)
@@ -31,7 +30,6 @@ type XFTPClientVar = TMVar (Either XFTPClientAgentError XFTPClient)
 
 data XFTPClientAgent = XFTPClientAgent
   { xftpClients :: TMap XFTPServer XFTPClientVar,
-    startedAt :: UTCTime,
     config :: XFTPClientAgentConfig
   }
 
@@ -58,20 +56,19 @@ data XFTPClientAgentError = XFTPClientAgentError XFTPServer XFTPClientError
 newXFTPAgent :: XFTPClientAgentConfig -> IO XFTPClientAgent
 newXFTPAgent config = do
   xftpClients <- TM.emptyIO
-  startedAt <- getCurrentTime
-  pure XFTPClientAgent {xftpClients, startedAt, config}
+  pure XFTPClientAgent {xftpClients, config}
 
 type ME a = ExceptT XFTPClientAgentError IO a
 
 getXFTPServerClient :: XFTPClientAgent -> XFTPServer -> ME XFTPClient
-getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
+getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
   atomically getClientVar >>= either newXFTPClient waitForXFTPClient
   where
     connectClient :: ME XFTPClient
     connectClient =
       ExceptT $
         first (XFTPClientAgentError srv)
-          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) startedAt clientDisconnected
+          <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) clientDisconnected
 
     clientDisconnected :: XFTPClient -> IO ()
     clientDisconnected _ = do

src/Simplex/FileTransfer/Client/Main.hs

@@ -19,7 +19,11 @@ module Simplex.FileTransfer.Client.Main
     singleChunkSize,
     prepareChunkSizes,
     prepareChunkSpecs,
+    maxFileSize,
+    maxFileSizeHard,
+    fileSizeLen,
     getChunkDigest,
+    SentRecipientReplica (..),
   )
 where
 
@@ -30,6 +34,7 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (toLower)
@@ -40,7 +45,7 @@ import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
 import Data.Word (Word32)
 import GHC.Records (HasField (getField))
@@ -75,6 +80,20 @@ import UnliftIO.Directory
 xftpClientVersion :: String
 xftpClientVersion = "1.0.1"
 
+-- | Soft limit for XFTP clients. Should be checked and reported to user.
+maxFileSize :: Int64
+maxFileSize = gb 1
+
+maxFileSizeStr :: String
+maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize
+
+-- | Hard internal limit for XFTP agent after which it refuses to prepare chunks.
+maxFileSizeHard :: Int64
+maxFileSizeHard = gb 5
+
+fileSizeLen :: Int64
+fileSizeLen = 8
+
 newtype CLIError = CLIError String
   deriving (Eq, Show, Exception)
 
@@ -212,6 +231,16 @@ data SentFileChunkReplica = SentFileChunkReplica
   }
   deriving (Show)
 
+data SentRecipientReplica = SentRecipientReplica
+  { chunkNo :: Int,
+    server :: XFTPServer,
+    rcvNo :: Int,
+    replicaId :: ChunkReplicaId,
+    replicaKey :: C.APrivateAuthKey,
+    digest :: FileDigest,
+    chunkSize :: FileSize Word32
+  }
+
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
@@ -385,6 +414,13 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       B.writeFile fdSndPath $ strEncode fdSnd
       pure (fdRcvPaths, fdSndPath)
 
+getChunkDigest :: XFTPChunkSpec -> IO ByteString
+getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} =
+  withFile chunkPath ReadMode $ \h -> do
+    hSeek h AbsoluteSeek $ fromIntegral chunkOffset
+    chunk <- LB.hGet h (fromIntegral chunkSize)
+    pure $! LC.sha256Hash chunk
+
 cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO ()
 cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose, yes} =
   getFileDescription' fileDescription >>= receive
@@ -500,6 +536,37 @@ getFileDescription' path =
   getFileDescription path >>= \case
     AVFD fd -> either (throwE . CLIError) pure $ checkParty fd
 
+singleChunkSize :: Int64 -> Maybe Word32
+singleChunkSize size' =
+  listToMaybe $ dropWhile (< chunkSize) serverChunkSizes
+  where
+    chunkSize = fromIntegral size'
+
+prepareChunkSizes :: Int64 -> [Word32]
+prepareChunkSizes size' = prepareSizes size'
+  where
+    (smallSize, bigSize)
+      | size' > size34 chunkSize3 = (chunkSize2, chunkSize3)
+      | size' > size34 chunkSize2 = (chunkSize1, chunkSize2)
+      | otherwise = (chunkSize0, chunkSize1)
+    size34 sz = (fromIntegral sz * 3) `div` 4
+    prepareSizes 0 = []
+    prepareSizes size
+      | size >= fromIntegral bigSize = replicate (fromIntegral n1) bigSize <> prepareSizes remSz
+      | size > size34 bigSize = [bigSize]
+      | otherwise = replicate (fromIntegral n2') smallSize
+      where
+        (n1, remSz) = size `divMod` fromIntegral bigSize
+        n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallSize) in if remSz2 == 0 then n2 else n2 + 1
+
+prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec]
+prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes
+  where
+    addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
+    addSpec (chunkOffset, specs) sz =
+      let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz}
+       in (chunkOffset + fromIntegral sz, spec : specs)
+
 getEncPath :: MonadIO m => Maybe FilePath -> String -> m FilePath
 getEncPath path name = (`uniqueCombine` (name <> ".encrypted")) =<< maybe (liftIO getCanonicalTemporaryDirectory) pure path
 

src/Simplex/FileTransfer/Description.hs

@@ -9,7 +9,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
@@ -38,10 +37,6 @@ module Simplex.FileTransfer.Description
     FileClientData,
     fileDescriptionURI,
     qrSizeLimit,
-    maxFileSize,
-    maxFileSizeStr,
-    maxFileSizeHard,
-    fileSizeLen,
   )
 where
 
@@ -67,10 +62,11 @@ import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word32)
 import qualified Data.Yaml as Y
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import Simplex.Messaging.Agent.QueryString
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, parseAll)
@@ -113,9 +109,6 @@ fdSeparator = "################################\n"
 
 newtype FileDigest = FileDigest {unFileDigest :: ByteString}
   deriving (Eq, Show)
-  deriving newtype (FromField)
-
-instance ToField FileDigest where toField (FileDigest s) = toField $ Binary s
 
 instance StrEncoding FileDigest where
   strEncode (FileDigest fd) = strEncode fd
@@ -129,6 +122,10 @@ instance ToJSON FileDigest where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+instance FromField FileDigest where fromField f = FileDigest <$> fromField f
+
+instance ToField FileDigest where toField (FileDigest s) = toField s
+
 data FileChunk = FileChunk
   { chunkNo :: Int,
     chunkSize :: FileSize Word32,
@@ -269,21 +266,6 @@ instance StrEncoding FileDescriptionURI where
 qrSizeLimit :: Int
 qrSizeLimit = 1002 -- ~2 chunks in URLencoded YAML with some spare size for server hosts
 
--- | Soft limit for XFTP clients. Should be checked and reported to user.
-maxFileSize :: Int64
-maxFileSize = gb 1
-
-maxFileSizeStr :: String
-maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize
-
--- | Hard internal limit for XFTP agent after which it refuses to prepare chunks.
-maxFileSizeHard :: Int64
-maxFileSizeHard = gb 5
-
-fileSizeLen :: Int64
-fileSizeLen = 8
-
-
 instance (Integral a, Show a) => StrEncoding (FileSize a) where
   strEncode (FileSize b)
     | b' /= 0 = bshow b
@@ -306,9 +288,9 @@ instance (Integral a, Show a) => StrEncoding (FileSize a) where
 instance (Integral a, Show a) => IsString (FileSize a) where
   fromString = either error id . strDecode . B.pack
 
-deriving newtype instance FromField a => FromField (FileSize a)
+instance FromField a => FromField (FileSize a) where fromField f = FileSize <$> fromField f
 
-deriving newtype instance ToField a => ToField (FileSize a)
+instance ToField a => ToField (FileSize a) where toField (FileSize s) = toField s
 
 groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
 groupReplicasByServer defChunkSize =

src/Simplex/FileTransfer/Protocol.hs

@@ -25,7 +25,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isNothing)
 import Data.Type.Equality
 import Data.Word (Word32)
-import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, blockedFilesXFTPVersion, xftpClientHandshakeStub)
+import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, xftpClientHandshakeStub)
 import Simplex.Messaging.Client (authTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -276,14 +276,12 @@ data FileResponse
 
 instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
   type Tag FileResponse = FileResponseTag
-  encodeProtocol v = \case
+  encodeProtocol _v = \case
     FRSndIds fId rIds -> e (FRSndIds_, ' ', fId, rIds)
     FRRcvIds rIds -> e (FRRcvIds_, ' ', rIds)
     FRFile rDhKey nonce -> e (FRFile_, ' ', rDhKey, nonce)
     FROk -> e FROk_
-    FRErr err -> case err of
-      BLOCKED _ | v < blockedFilesXFTPVersion -> e (FRErr_, ' ', AUTH)
-      _ -> e (FRErr_, ' ', err)
+    FRErr err -> e (FRErr_, ' ', err)
     FRPong -> e FRPong_
     where
       e :: Encoding a => a -> ByteString

src/Simplex/FileTransfer/Server.hs

@@ -33,6 +33,7 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
+import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
 import qualified Data.X509 as X
@@ -53,20 +54,18 @@ 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.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
-import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, 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 (SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..))
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.Server (runLocalTCPServer)
+import Simplex.Messaging.Transport.Server (runLocalTCPServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure)
@@ -92,35 +91,36 @@ 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
   where
     runServer :: M ()
     runServer = do
-      srvCreds@(chain, pk) <- asks tlsServerCreds
+      serverParams <- asks tlsServerParams
+      let (chain, pk) = tlsServerCredentials serverParams
       signKey <- liftIO $ case C.x509ToPrivate (pk, []) >>= C.privKey of
         Right pk' -> pure pk'
         Left e -> putStrLn ("servers 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 serverParams 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, batch = True}
             req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse}
         flip runReaderT env $ case sessionALPN of
           Nothing -> processRequest req0
@@ -181,7 +181,6 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
     stopServer = do
       withFileLog closeStoreLog
       saveServerStats
-      logInfo "Server stopped"
 
     expireFilesThread_ :: XFTPServerConfig -> [M ()]
     expireFilesThread_ XFTPServerConfig {fileExpiration = Just fileExp} = [expireFiles fileExp]
@@ -287,15 +286,11 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
               CPDelete fileId -> withUserRole $ unliftIO u $ do
                 fs <- asks store
                 r <- runExceptT $ do
-                  (fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId
+                  let asSender = ExceptT . atomically $ getFile fs SFSender fileId
+                  let asRecipient = ExceptT . atomically $ getFile fs SFRecipient fileId
+                  (fr, _) <- asSender `catchError` const asRecipient
                   ExceptT $ deleteServerFile_ fr
                 liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
-              CPBlock fileId info -> withUserRole $ unliftIO u $ do
-                fs <- asks store
-                r <- runExceptT $ do
-                  (fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId
-                  ExceptT $ blockServerFile fr info
-                liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
               CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit"
               CPQuit -> pure ()
               CPSkip -> pure ()
@@ -325,7 +320,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
               let THandleParams {thAuth} = thParams
               verifyXFTPTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) sig_ signed fId cmd >>= \case
                 VRVerified req -> uncurry send =<< processXFTPRequest body req
-                VRFailed e -> send (FRErr e) Nothing
+                VRFailed -> send (FRErr AUTH) Nothing
             Left e -> send (FRErr e) Nothing
           where
             send resp = sendXFTPResponse (corrId, fId, resp)
@@ -359,7 +354,7 @@ randomDelay = do
     threadDelay $ (d * (1000 + pc)) `div` 1000
 #endif
 
-data VerificationResult = VRVerified XFTPRequest | VRFailed XFTPErrorType
+data VerificationResult = VRVerified XFTPRequest | VRFailed
 
 verifyXFTPTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> XFTPFileId -> FileCmd -> M VerificationResult
 verifyXFTPTransmission auth_ tAuth authorized fId cmd =
@@ -371,19 +366,13 @@ verifyXFTPTransmission auth_ tAuth authorized fId cmd =
     verifyCmd :: SFileParty p -> M VerificationResult
     verifyCmd party = do
       st <- asks store
-      atomically $ verify =<< getFile st party fId
+      atomically $ verify <$> getFile st party fId
       where
         verify = \case
-          Right (fr, k) -> result <$> readTVar (fileStatus fr)
-            where
-              result = \case
-                EntityActive -> XFTPReqCmd fId fr cmd `verifyWith` k
-                EntityBlocked info -> VRFailed $ BLOCKED info
-                EntityOff -> noFileAuth
-          Left _ -> pure noFileAuth
-        noFileAuth = maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed AUTH
+          Right (fr, k) -> XFTPReqCmd fId fr cmd `verifyWith` k
+          _ -> maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed
     -- 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 auth_ tAuth authorized k then VRVerified req else VRFailed
 
 processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
 processXFTPRequest HTTP2Body {bodyPart} = \case
@@ -400,7 +389,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
     FACK -> noFile =<< ackFileReception fId fr
     -- it should never get to the commands below, they are passed in other constructors of XFTPRequest
     FNEW {} -> noFile $ FRErr INTERNAL
-    PING -> noFile $ FRErr INTERNAL
+    PING -> noFile FRPong
   XFTPReqPing -> noFile FRPong
   where
     noFile resp = pure (resp, Nothing)
@@ -410,12 +399,12 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       r <- runExceptT $ do
         sizes <- asks $ allowedChunkSizes . config
         unless (size file `elem` sizes) $ throwE SIZE
-        ts <- liftIO getFileTime
+        ts <- liftIO getSystemTime
         -- TODO validate body empty
         sId <- ExceptT $ addFileRetry st file 3 ts
         rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
         lift $ withFileLog $ \sl -> do
-          logAddFile sl sId file ts EntityActive
+          logAddFile sl sId file ts
           logAddRecipients sl sId rcps
         stats <- asks serverStats
         lift $ incFileStat filesCreated
@@ -423,10 +412,10 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRSndIds sId rIds
       pure $ either FRErr id r
-    addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId)
+    addFileRetry :: FileStore -> FileInfo -> Int -> SystemTime -> M (Either XFTPErrorType XFTPFileId)
     addFileRetry st file n ts =
       retryAdd n $ \sId -> runExceptT $ do
-        ExceptT $ addFile st sId file ts EntityActive
+        ExceptT $ addFile st sId file ts
         pure sId
     addRecipientRetry :: FileStore -> Int -> XFTPFileId -> RcvPublicAuthKey -> M (Either XFTPErrorType FileRecipient)
     addRecipientRetry st n sId rpk =
@@ -528,32 +517,20 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       pure FROk
 
 deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
-deleteServerFile_ fr@FileRec {senderId} = do
+deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
   withFileLog (`logDeleteFile` senderId)
-  deleteOrBlockServerFile_ fr filesDeleted (`deleteFile` senderId)
-
--- this also deletes the file from storage, but doesn't include it in delete statistics
-blockServerFile :: FileRec -> BlockingInfo -> M (Either XFTPErrorType ())
-blockServerFile fr@FileRec {senderId} info = do
-  withFileLog $ \sl -> logBlockFile sl senderId info
-  deleteOrBlockServerFile_ fr filesBlocked $ \st -> blockFile st senderId info True
-
-deleteOrBlockServerFile_ :: FileRec -> (FileServerStats -> IORef Int) -> (FileStore -> STM (Either XFTPErrorType ())) -> M (Either XFTPErrorType ())
-deleteOrBlockServerFile_ FileRec {filePath, fileInfo} stat storeAction = runExceptT $ do
-  path <- readTVarIO filePath
-  stats <- asks serverStats
-  ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
-  st <- asks store
-  void $ atomically $ storeAction st
-  lift $ incFileStat stat
+  runExceptT $ do
+    path <- readTVarIO filePath
+    stats <- asks serverStats
+    ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
+    st <- asks store
+    void $ atomically $ deleteFile st senderId
+    lift $ incFileStat filesDeleted
   where
     deletedStats stats = do
       liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
       liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
 
-getFileTime :: IO RoundedSystemTime
-getFileTime = getRoundedSystemTime fileTimePrecision
-
 expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
 expireServerFiles itemDelay expCfg = do
   st <- asks store

src/Simplex/FileTransfer/Server/Control.hs

@@ -6,13 +6,14 @@ module Simplex.FileTransfer.Server.Control where
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Simplex.FileTransfer.Protocol (XFTPFileId)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo)
+import Simplex.Messaging.Protocol (BasicAuth)
+
+data CPClientRole = CPRNone | CPRUser | CPRAdmin
 
 data ControlProtocol
   = CPAuth BasicAuth
   | CPStatsRTS
   | CPDelete XFTPFileId
-  | CPBlock XFTPFileId BlockingInfo
   | CPHelp
   | CPQuit
   | CPSkip
@@ -22,7 +23,6 @@ instance StrEncoding ControlProtocol where
     CPAuth tok -> "auth " <> strEncode tok
     CPStatsRTS -> "stats-rts"
     CPDelete fId -> strEncode (Str "delete", fId)
-    CPBlock fId info -> strEncode (Str "block", fId, info)
     CPHelp -> "help"
     CPQuit -> "quit"
     CPSkip -> ""
@@ -31,7 +31,6 @@ instance StrEncoding ControlProtocol where
       "auth" -> CPAuth <$> _strP
       "stats-rts" -> pure CPStatsRTS
       "delete" -> CPDelete <$> _strP
-      "block" -> CPBlock <$> _strP <*> _strP
       "help" -> pure CPHelp
       "quit" -> pure CPQuit
       "" -> pure CPSkip

src/Simplex/FileTransfer/Server/Env.hs

@@ -28,7 +28,8 @@ import Simplex.FileTransfer.Transport (VersionRangeXFTP)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), loadFingerprint, loadServerCredential)
+import Simplex.Messaging.Transport (ALPN)
+import Simplex.Messaging.Transport.Server (TransportServerConfig (..), loadFingerprint, loadTLSServerParams)
 import Simplex.Messaging.Util (tshow)
 import System.IO (IOMode (..))
 import UnliftIO.STM
@@ -56,7 +57,10 @@ data XFTPServerConfig = XFTPServerConfig
     fileTimeout :: Int,
     -- | time after which inactive clients can be disconnected and check interval, seconds
     inactiveClientExpiration :: Maybe ExpirationConfig,
-    xftpCredentials :: ServerCredentials,
+    -- CA certificate private key is not needed for initialization
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath,
     -- | XFTP client-server protocol version range
     xftpServerVRange :: VersionRangeXFTP,
     -- stats config - see SMP server config
@@ -71,7 +75,7 @@ data XFTPServerConfig = XFTPServerConfig
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
   ExpirationConfig
-    { ttl = 21600, -- seconds, 6 hours
+    { ttl = 43200, -- seconds, 12 hours
       checkInterval = 3600 -- seconds, 1 hours
     }
 
@@ -81,7 +85,7 @@ data XFTPEnv = XFTPEnv
     storeLog :: Maybe (StoreLog 'WriteMode),
     random :: TVar ChaChaDRG,
     serverIdentity :: C.KeyHash,
-    tlsServerCreds :: T.Credential,
+    tlsServerParams :: T.ServerParams,
     serverStats :: FileServerStats
   }
 
@@ -95,8 +99,11 @@ defaultFileExpiration =
       checkInterval = 2 * 3600 -- seconds, 2 hours
     }
 
+supportedXFTPhandshakes :: [ALPN]
+supportedXFTPhandshakes = ["xftp/1"]
+
 newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
-newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCredentials} = do
+newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
   random <- C.newRandom
   store <- newFileStore
   storeLog <- mapM (`readWriteFileStore` store) storeLogFile
@@ -105,10 +112,10 @@ newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCrede
   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!"
-  tlsServerCreds <- loadServerCredential xftpCredentials
-  Fingerprint fp <- loadFingerprint xftpCredentials
+  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- loadFingerprint caCertificateFile
   serverStats <- newFileServerStats =<< getCurrentTime
-  pure XFTPEnv {config, store, storeLog, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
+  pure XFTPEnv {config, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
 
 countUsedStorage :: M.Map k FileRec -> Int64
 countUsedStorage = M.foldl' (\acc FileRec {fileInfo = FileInfo {size}} -> acc + fromIntegral size) 0

src/Simplex/FileTransfer/Server/Main.hs

@@ -19,7 +19,7 @@ import Options.Applicative
 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.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration, supportedXFTPhandshakes)
 import Simplex.FileTransfer.Transport (supportedFileServerVRange)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
@@ -28,7 +28,7 @@ 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.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -51,9 +51,7 @@ xftpServerCLI cfgPath logPath = do
         True -> readIniFile iniFile >>= either exitError runServer
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
     Delete -> do
-      confirmOrExit
-        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
-        "Server NOT deleted"
+      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
@@ -103,7 +101,6 @@ xftpServerCLI cfgPath logPath = do
                \\n\
                \# control_port_admin_password:\n\
                \# control_port_user_password:\n\
-               \\n\
                \[TRANSPORT]\n\
                \# host is only used to print server address on start\n"
             <> ("host: " <> T.pack host <> "\n")
@@ -176,12 +173,9 @@ xftpServerCLI cfgPath logPath = do
                     { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
                       checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
                     },
-              xftpCredentials =
-                ServerCredentials
-                  { caCertificateFile = Just $ c caCrtFile,
-                    privateKeyFile = c serverKeyFile,
-                    certificateFile = c serverCrtFile
-                  },
+              caCertificateFile = c caCrtFile,
+              privateKeyFile = c serverKeyFile,
+              certificateFile = c serverCrtFile,
               xftpServerVRange = supportedFileServerVRange,
               logStatsInterval = logStats $> 86400, -- seconds
               logStatsStartTime = 0, -- seconds from 00:00 UTC
@@ -189,7 +183,8 @@ xftpServerCLI cfgPath logPath = do
               serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
               transportConfig =
                 defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
+                    alpn = Just supportedXFTPhandshakes
                   },
               responseDelay = 0
             }

src/Simplex/FileTransfer/Server/Stats.hs

@@ -20,7 +20,6 @@ data FileServerStats = FileServerStats
     filesUploaded :: IORef Int,
     filesExpired :: IORef Int,
     filesDeleted :: IORef Int,
-    filesBlocked :: IORef Int,
     filesDownloaded :: PeriodStats,
     fileDownloads :: IORef Int,
     fileDownloadAcks :: IORef Int,
@@ -35,7 +34,6 @@ data FileServerStatsData = FileServerStatsData
     _filesUploaded :: Int,
     _filesExpired :: Int,
     _filesDeleted :: Int,
-    _filesBlocked :: Int,
     _filesDownloaded :: PeriodStatsData,
     _fileDownloads :: Int,
     _fileDownloadAcks :: Int,
@@ -52,13 +50,12 @@ newFileServerStats ts = do
   filesUploaded <- newIORef 0
   filesExpired <- newIORef 0
   filesDeleted <- newIORef 0
-  filesBlocked <- newIORef 0
   filesDownloaded <- newPeriodStats
   fileDownloads <- newIORef 0
   fileDownloadAcks <- newIORef 0
   filesCount <- newIORef 0
   filesSize <- newIORef 0
-  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesBlocked, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
+  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
 
 getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
 getFileServerStatsData s = do
@@ -68,13 +65,12 @@ getFileServerStatsData s = do
   _filesUploaded <- readIORef $ filesUploaded s
   _filesExpired <- readIORef $ filesExpired s
   _filesDeleted <- readIORef $ filesDeleted s
-  _filesBlocked <- readIORef $ filesBlocked s
   _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
   _fileDownloads <- readIORef $ fileDownloads s
   _fileDownloadAcks <- readIORef $ fileDownloadAcks s
   _filesCount <- readIORef $ filesCount s
   _filesSize <- readIORef $ filesSize s
-  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
+  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
 
 -- this function is not thread safe, it is used on server start only
 setFileServerStats :: FileServerStats -> FileServerStatsData -> IO ()
@@ -85,7 +81,6 @@ setFileServerStats s d = do
   writeIORef (filesUploaded s) $! _filesUploaded d
   writeIORef (filesExpired s) $! _filesExpired d
   writeIORef (filesDeleted s) $! _filesDeleted d
-  writeIORef (filesBlocked s) $! _filesBlocked d
   setPeriodStats (filesDownloaded s) $! _filesDownloaded d
   writeIORef (fileDownloads s) $! _fileDownloads d
   writeIORef (fileDownloadAcks s) $! _fileDownloadAcks d
@@ -93,7 +88,7 @@ setFileServerStats s d = do
   writeIORef (filesSize s) $! _filesSize d
 
 instance StrEncoding FileServerStatsData where
-  strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
+  strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
     B.unlines
       [ "fromTime=" <> strEncode _fromTime,
         "filesCreated=" <> strEncode _filesCreated,
@@ -101,7 +96,6 @@ instance StrEncoding FileServerStatsData where
         "filesUploaded=" <> strEncode _filesUploaded,
         "filesExpired=" <> strEncode _filesExpired,
         "filesDeleted=" <> strEncode _filesDeleted,
-        "filesBlocked=" <> strEncode _filesBlocked,
         "filesCount=" <> strEncode _filesCount,
         "filesSize=" <> strEncode _filesSize,
         "filesDownloaded:",
@@ -116,12 +110,9 @@ instance StrEncoding FileServerStatsData where
     _filesUploaded <- "filesUploaded=" *> strP <* A.endOfLine
     _filesExpired <- "filesExpired=" *> strP <* A.endOfLine <|> pure 0
     _filesDeleted <- "filesDeleted=" *> strP <* A.endOfLine
-    _filesBlocked <- opt "filesBlocked="
     _filesCount <- "filesCount=" *> strP <* A.endOfLine <|> pure 0
     _filesSize <- "filesSize=" *> strP <* A.endOfLine <|> pure 0
     _filesDownloaded <- "filesDownloaded:" *> A.endOfLine *> strP <* A.endOfLine
     _fileDownloads <- "fileDownloads=" *> strP <* A.endOfLine
     _fileDownloadAcks <- "fileDownloadAcks=" *> strP <* A.endOfLine
-    pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
-    where
-      opt s = A.string s *> strP <* A.endOfLine <|> pure 0
+    pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}

src/Simplex/FileTransfer/Server/Store.hs

@@ -13,27 +13,24 @@ module Simplex.FileTransfer.Server.Store
     setFilePath,
     addRecipient,
     deleteFile,
-    blockFile,
     deleteRecipient,
     expiredFilePath,
     getFile,
     ackFile,
-    fileTimePrecision,
   )
 where
 
 import Control.Concurrent.STM
-import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Int (Int64)
 import Data.Set (Set)
 import qualified Data.Set as S
+import Data.Time.Clock.System (SystemTime (..))
 import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId)
 import Simplex.FileTransfer.Transport (XFTPErrorType (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
-import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..), ServerEntityStatus (..))
+import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (ifM, ($>>=))
@@ -49,15 +46,10 @@ data FileRec = FileRec
     fileInfo :: FileInfo,
     filePath :: TVar (Maybe FilePath),
     recipientIds :: TVar (Set RecipientId),
-    createdAt :: RoundedSystemTime,
-    fileStatus :: TVar ServerEntityStatus
+    createdAt :: SystemTime
   }
 
-fileTimePrecision :: Int64
-fileTimePrecision = 3600 -- truncate creation time to 1 hour
-
 data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
-  deriving (Show)
 
 instance StrEncoding FileRecipient where
   strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
@@ -70,19 +62,18 @@ newFileStore = do
   usedStorage <- newTVarIO 0
   pure FileStore {files, recipients, usedStorage}
 
-addFile :: FileStore -> SenderId -> FileInfo -> RoundedSystemTime -> ServerEntityStatus -> STM (Either XFTPErrorType ())
-addFile FileStore {files} sId fileInfo createdAt status =
+addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ())
+addFile FileStore {files} sId fileInfo createdAt =
   ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do
-    f <- newFileRec sId fileInfo createdAt status
+    f <- newFileRec sId fileInfo createdAt
     TM.insert sId f files
     pure $ Right ()
 
-newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> ServerEntityStatus -> STM FileRec
-newFileRec senderId fileInfo createdAt status = do
+newFileRec :: SenderId -> FileInfo -> SystemTime -> STM FileRec
+newFileRec senderId fileInfo createdAt = do
   recipientIds <- newTVar S.empty
   filePath <- newTVar Nothing
-  fileStatus <- newTVar status
-  pure FileRec {senderId, fileInfo, filePath, recipientIds, createdAt, fileStatus}
+  pure FileRec {senderId, fileInfo, filePath, recipientIds, createdAt}
 
 setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either XFTPErrorType ())
 setFilePath st sId fPath =
@@ -113,14 +104,6 @@ deleteFile FileStore {files, recipients, usedStorage} senderId = do
       pure $ Right ()
     _ -> pure $ Left AUTH
 
--- this function must be called after the file is deleted from the file system
-blockFile :: FileStore -> SenderId -> BlockingInfo -> Bool -> STM (Either XFTPErrorType ())
-blockFile st@FileStore {usedStorage} senderId info deleted =
-  withFile st senderId $ \FileRec {fileInfo, fileStatus} -> do
-    when deleted $ modifyTVar' usedStorage $ subtract (fromIntegral $ size fileInfo)
-    writeTVar fileStatus $! EntityBlocked info
-    pure $ Right ()
-
 deleteRecipient :: FileStore -> RecipientId -> FileRec -> STM ()
 deleteRecipient FileStore {recipients} rId FileRec {recipientIds} = do
   TM.delete rId recipients
@@ -137,8 +120,8 @@ getFile st party fId = case party of
 expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe (Maybe FilePath))
 expiredFilePath FileStore {files} sId old =
   TM.lookup sId files
-    $>>= \FileRec {filePath, createdAt = RoundedSystemTime createdAt} ->
-      if createdAt + fileTimePrecision < old
+    $>>= \FileRec {filePath, createdAt} ->
+      if systemSeconds createdAt < old
         then Just <$> readTVar filePath
         else pure Nothing
 

src/Simplex/FileTransfer/Server/StoreLog.hs

@@ -14,63 +14,58 @@ module Simplex.FileTransfer.Server.StoreLog
     logPutFile,
     logAddRecipients,
     logDeleteFile,
-    logBlockFile,
     logAckFile,
   )
 where
 
-import Control.Applicative ((<|>))
 import Control.Concurrent.STM
 import Control.Monad.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Composition ((.:), (.::))
+import Data.Composition ((.:), (.:.))
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Time.Clock.System (SystemTime)
 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, ServerEntityStatus (..))
+import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (bshow)
+import Simplex.Messaging.Util (bshow, whenM)
+import System.Directory (doesFileExist, renameFile)
 import System.IO
 
 data FileStoreLogRecord
-  = AddFile SenderId FileInfo RoundedSystemTime ServerEntityStatus
+  = AddFile SenderId FileInfo SystemTime
   | PutFile SenderId FilePath
   | AddRecipients SenderId (NonEmpty FileRecipient)
   | DeleteFile SenderId
-  | BlockFile SenderId BlockingInfo
-  | AckFile RecipientId -- TODO add senderId as well?
-  deriving (Show)
+  | AckFile RecipientId
 
 instance StrEncoding FileStoreLogRecord where
   strEncode = \case
-    AddFile sId file createdAt status -> strEncode (Str "FNEW", sId, file, createdAt, status)
+    AddFile sId file createdAt -> strEncode (Str "FNEW", sId, file, createdAt)
     PutFile sId path -> strEncode (Str "FPUT", sId, path)
     AddRecipients sId rcps -> strEncode (Str "FADD", sId, rcps)
     DeleteFile sId -> strEncode (Str "FDEL", sId)
-    BlockFile sId info -> strEncode (Str "FBLK", sId, info)
     AckFile rId -> strEncode (Str "FACK", rId)
   strP =
     A.choice
-      [ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP <*> (_strP <|> pure EntityActive)),
+      [ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP),
         "FPUT " *> (PutFile <$> strP_ <*> strP),
         "FADD " *> (AddRecipients <$> strP_ <*> strP),
         "FDEL " *> (DeleteFile <$> strP),
-        "FBLK " *> (BlockFile <$> strP_ <*> strP),
         "FACK " *> (AckFile <$> strP)
       ]
 
 logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
 logFileStoreRecord = writeStoreLogRecord
 
-logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> RoundedSystemTime -> ServerEntityStatus -> IO ()
-logAddFile s = logFileStoreRecord s .:: AddFile
+logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> SystemTime -> IO ()
+logAddFile s = logFileStoreRecord s .:. AddFile
 
 logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()
 logPutFile s = logFileStoreRecord s .: PutFile
@@ -81,14 +76,17 @@ logAddRecipients s = logFileStoreRecord s .: AddRecipients
 logDeleteFile :: StoreLog 'WriteMode -> SenderId -> IO ()
 logDeleteFile s = logFileStoreRecord s . DeleteFile
 
-logBlockFile :: StoreLog 'WriteMode -> SenderId -> BlockingInfo -> IO ()
-logBlockFile s fId = logFileStoreRecord s . BlockFile fId
-
 logAckFile :: StoreLog 'WriteMode -> RecipientId -> IO ()
 logAckFile s = logFileStoreRecord s . AckFile
 
 readWriteFileStore :: FilePath -> FileStore -> IO (StoreLog 'WriteMode)
-readWriteFileStore = readWriteStoreLog readFileStore writeFileStore
+readWriteFileStore f st = do
+  whenM (doesFileExist f) $ do
+    readFileStore f st
+    renameFile f $ f <> ".bak"
+  s <- openWriteStoreLog f
+  writeFileStore s st
+  pure s
 
 readFileStore :: FilePath -> FileStore -> IO ()
 readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.readFile f
@@ -100,11 +98,10 @@ 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 status -> addFile st sId file createdAt status
+      AddFile sId file createdAt -> addFile st sId file createdAt
       PutFile qId path -> setFilePath st qId path
       AddRecipients sId rcps -> runExceptT $ addRecipients sId rcps
       DeleteFile sId -> deleteFile st sId
-      BlockFile sId info -> blockFile st sId info True
       AckFile rId -> ackFile st rId
     addRecipients sId rcps = mapM_ (ExceptT . addRecipient st sId) rcps
 
@@ -114,9 +111,8 @@ 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, fileStatus} = do
-      status <- readTVarIO fileStatus
-      logAddFile s senderId fileInfo createdAt status
+    logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt} = do
+      logAddFile s senderId fileInfo createdAt
       (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

src/Simplex/FileTransfer/Transport.hs

@@ -11,9 +11,7 @@
 module Simplex.FileTransfer.Transport
   ( supportedFileServerVRange,
     authCmdsXFTPVersion,
-    blockedFilesXFTPVersion,
     xftpClientHandshakeStub,
-    supportedXFTPhandshakes,
     XFTPClientHandshake (..),
     -- xftpClientHandshake,
     XFTPServerHandshake (..),
@@ -34,6 +32,7 @@ module Simplex.FileTransfer.Transport
   )
 where
 
+import Control.Applicative ((<|>))
 import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
@@ -57,8 +56,8 @@ import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
-import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
-import Simplex.Messaging.Transport (ALPN, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
+import Simplex.Messaging.Protocol (CommandError)
+import Simplex.Messaging.Transport (SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
 import Simplex.Messaging.Transport.HTTP2.File
 import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version
@@ -92,21 +91,15 @@ initialXFTPVersion = VersionXFTP 1
 authCmdsXFTPVersion :: VersionXFTP
 authCmdsXFTPVersion = VersionXFTP 2
 
-blockedFilesXFTPVersion :: VersionXFTP
-blockedFilesXFTPVersion = VersionXFTP 3
-
 currentXFTPVersion :: VersionXFTP
-currentXFTPVersion = VersionXFTP 3
+currentXFTPVersion = VersionXFTP 2
 
 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
-
-supportedXFTPhandshakes :: [ALPN]
-supportedXFTPhandshakes = ["xftp/1"]
+xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
+xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion
 
 data XFTPServerHandshake = XFTPServerHandshake
   { xftpVersionRange :: VersionRangeXFTP,
@@ -214,8 +207,6 @@ data XFTPErrorType
     CMD {cmdErr :: CommandError}
   | -- | command authorization error - bad signature or non-existing SMP queue
     AUTH
-  | -- | command with the entity that was blocked
-    BLOCKED {blockInfo :: BlockingInfo}
   | -- | incorrent file size
     SIZE
   | -- | storage quota exceeded
@@ -236,46 +227,15 @@ data XFTPErrorType
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
     DUPLICATE_ -- not part of SMP protocol, used internally
-  deriving (Eq, Show)
+  deriving (Eq, Read, Show)
 
 instance StrEncoding XFTPErrorType where
   strEncode = \case
-    BLOCK -> "BLOCK"
-    SESSION -> "SESSION"
-    HANDSHAKE -> "HANDSHAKE"
     CMD e -> "CMD " <> bshow e
-    AUTH -> "AUTH"
-    BLOCKED info -> "BLOCKED " <> strEncode info
-    SIZE -> "SIZE"
-    QUOTA -> "QUOTA"
-    DIGEST -> "DIGEST"
-    CRYPTO -> "CRYPTO"
-    NO_FILE -> "NO_FILE"
-    HAS_FILE -> "HAS_FILE"
-    FILE_IO -> "FILE_IO"
-    TIMEOUT -> "TIMEOUT"
-    INTERNAL -> "INTERNAL"
-    DUPLICATE_ -> "DUPLICATE_"
-
+    e -> bshow e
   strP =
-    A.takeTill (== ' ') >>= \case
-      "BLOCK" -> pure BLOCK
-      "SESSION" -> pure SESSION
-      "HANDSHAKE" -> pure HANDSHAKE
-      "CMD" -> CMD <$> parseRead1
-      "AUTH" -> pure AUTH
-      "BLOCKED" -> BLOCKED <$> _strP
-      "SIZE" -> pure SIZE
-      "QUOTA" -> pure QUOTA
-      "DIGEST" -> pure DIGEST
-      "CRYPTO" -> pure CRYPTO
-      "NO_FILE" -> pure NO_FILE
-      "HAS_FILE" -> pure HAS_FILE
-      "FILE_IO" -> pure FILE_IO
-      "TIMEOUT" -> pure TIMEOUT
-      "INTERNAL" -> pure INTERNAL
-      "DUPLICATE_" -> pure DUPLICATE_
-      _ -> fail "bad error type"
+    "CMD " *> (CMD <$> parseRead1)
+      <|> parseRead1
 
 instance Encoding XFTPErrorType where
   smpEncode = \case
@@ -284,7 +244,6 @@ instance Encoding XFTPErrorType where
     HANDSHAKE -> "HANDSHAKE"
     CMD err -> "CMD " <> smpEncode err
     AUTH -> "AUTH"
-    BLOCKED info -> "BLOCKED " <> smpEncode info
     SIZE -> "SIZE"
     QUOTA -> "QUOTA"
     DIGEST -> "DIGEST"
@@ -303,7 +262,6 @@ instance Encoding XFTPErrorType where
       "HANDSHAKE" -> pure HANDSHAKE
       "CMD" -> CMD <$> _smpP
       "AUTH" -> pure AUTH
-      "BLOCKED" -> BLOCKED <$> _smpP
       "SIZE" -> pure SIZE
       "QUOTA" -> pure QUOTA
       "DIGEST" -> pure DIGEST

src/Simplex/FileTransfer/Types.hs

@@ -13,6 +13,8 @@ import Data.Int (Int64)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word32)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Description
 import qualified Simplex.Messaging.Crypto as C
@@ -22,7 +24,6 @@ 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 (..), fromTextField_)
 
 type RcvFileId = ByteString -- Agent entity ID
 
@@ -245,16 +246,6 @@ data DeletedSndChunkReplica = DeletedSndChunkReplica
   }
   deriving (Show)
 
-data SentRecipientReplica = SentRecipientReplica
-  { chunkNo :: Int,
-    server :: XFTPServer,
-    rcvNo :: Int,
-    replicaId :: ChunkReplicaId,
-    replicaKey :: C.APrivateAuthKey,
-    digest :: FileDigest,
-    chunkSize :: FileSize Word32
-  }
-
 data FileErrorType
   = -- | cannot proceed with download from not approved relays without proxy
     NOT_APPROVED

src/Simplex/Messaging/Agent/Client.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
@@ -31,7 +30,6 @@ module Simplex.Messaging.Agent.Client
     withConnLocks,
     withInvLock,
     withLockMap,
-    getMapLock,
     ipAddressProtected,
     closeAgentClient,
     closeProtocolServerClients,
@@ -58,10 +56,8 @@ module Simplex.Messaging.Agent.Client
     secureQueue,
     secureSndQueue,
     enableQueueNotifications,
-    EnableQueueNtfReq (..),
     enableQueuesNtfs,
     disableQueueNotifications,
-    DisableQueueNtfReq,
     disableQueuesNtfs,
     sendAgentMessage,
     getQueueInfo,
@@ -72,9 +68,7 @@ module Simplex.Messaging.Agent.Client
     agentNtfDeleteToken,
     agentNtfEnableCron,
     agentNtfCreateSubscription,
-    agentNtfCreateSubscriptions,
     agentNtfCheckSubscription,
-    agentNtfCheckSubscriptions,
     agentNtfDeleteSubscription,
     agentXFTPDownloadChunk,
     agentXFTPNewChunk,
@@ -94,7 +88,6 @@ module Simplex.Messaging.Agent.Client
     hasActiveSubscription,
     hasPendingSubscription,
     hasGetLock,
-    releaseGetLock,
     activeClientSession,
     agentClientStore,
     agentDRG,
@@ -122,7 +115,6 @@ module Simplex.Messaging.Agent.Client
     hasWorkToDo,
     hasWorkToDo',
     withWork,
-    withWorkItems,
     agentOperations,
     agentOperationBracket,
     waitUntilActive,
@@ -146,11 +138,11 @@ module Simplex.Messaging.Agent.Client
     withStore',
     withStoreBatch,
     withStoreBatch',
-    unsafeWithStore,
     storeError,
     userServers,
     pickServer,
     getNextServer,
+    withUserServers,
     withNextSrv,
     incSMPServerStat,
     incSMPServerStat',
@@ -158,7 +150,6 @@ module Simplex.Messaging.Agent.Client
     incXFTPServerStat',
     incXFTPServerSizeStat,
     incNtfServerStat,
-    incNtfServerStat',
     AgentWorkersDetails (..),
     getAgentWorkersDetails,
     AgentWorkersSummary (..),
@@ -194,12 +185,12 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (find, foldl', partition)
+import Data.List (deleteFirstsBy, foldl', partition, (\\))
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
@@ -207,6 +198,7 @@ import Data.Text.Encoding
 import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Word (Word16)
+import qualified Database.SQLite.Simple as SQL
 import Network.Socket (HostName)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..), XFTPClient, XFTPClientConfig (..), XFTPClientError)
 import qualified Simplex.FileTransfer.Client as X
@@ -222,8 +214,8 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
-import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), withTransaction)
+import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Agent.TRcvQueues (TRcvQueues (getRcvQueues))
 import qualified Simplex.Messaging.Agent.TRcvQueues as RQ
 import Simplex.Messaging.Client
@@ -265,6 +257,7 @@ import Simplex.Messaging.Protocol
     XFTPServer,
     XFTPServerWithAuth,
     pattern NoEntity,
+    sameSrvAddr',
   )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.QueueStore.QueueInfo
@@ -283,9 +276,6 @@ import UnliftIO.Concurrent (forkIO, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, removeFile)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
-#if !defined(dbPostgres)
-import qualified Database.SQLite.Simple as SQL
-#endif
 
 type ClientVar msg = SessionVar (Either (AgentErrorType, Maybe UTCTime) (Client msg))
 
@@ -343,7 +333,6 @@ data AgentClient = AgentClient
     smpSubWorkers :: TMap SMPTransportSession (SessionVar (Async ())),
     clientId :: Int,
     agentEnv :: Env,
-    proxySessTs :: TVar UTCTime,
     smpServersStats :: TMap (UserId, SMPServer) AgentSMPServerStats,
     xftpServersStats :: TMap (UserId, XFTPServer) AgentXFTPServerStats,
     ntfServersStats :: TMap (UserId, NtfServer) AgentNtfServerStats,
@@ -472,7 +461,6 @@ newAgentClient :: Int -> InitialAgentServers -> UTCTime -> Env -> IO AgentClient
 newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs agentEnv = do
   let cfg = config agentEnv
       qSize = tbqSize cfg
-  proxySessTs <- newTVarIO =<< getCurrentTime
   acThread <- newTVarIO Nothing
   active <- newTVarIO True
   subQ <- newTBQueueIO qSize
@@ -503,7 +491,7 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
   getMsgLocks <- TM.emptyIO
   connLocks <- TM.emptyIO
   invLocks <- TM.emptyIO
-  deleteLock <- createLockIO
+  deleteLock <- atomically createLock
   smpSubWorkers <- TM.emptyIO
   smpServersStats <- TM.emptyIO
   xftpServersStats <- TM.emptyIO
@@ -545,7 +533,6 @@ newAgentClient clientId InitialAgentServers {smp, ntf, xftp, netCfg} currentTs a
         smpSubWorkers,
         clientId,
         agentEnv,
-        proxySessTs,
         smpServersStats,
         xftpServersStats,
         ntfServersStats,
@@ -559,7 +546,7 @@ slowNetworkConfig cfg@NetworkConfig {tcpConnectTimeout, tcpTimeout, tcpTimeoutPe
     slow :: Integral a => a -> a
     slow t = (t * 3) `div` 2
 
-agentClientStore :: AgentClient -> DBStore
+agentClientStore :: AgentClient -> SQLiteStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store
 {-# INLINE agentClientStore #-}
 
@@ -621,7 +608,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do
 getSMPProxyClient :: AgentClient -> Maybe SMPServerWithAuth -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay)
 getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} proxySrv_ destSess@(userId, destSrv, qId) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
-  proxySrv <- maybe (getNextServer c userId proxySrvs [destSrv]) pure proxySrv_
+  proxySrv <- maybe (getNextServer c userId [destSrv]) pure proxySrv_
   ts <- liftIO getCurrentTime
   atomically (getClientVar proxySrv ts) >>= \(tSess, auth, v) ->
     either (newProxyClient tSess auth ts) (waitForProxyClient tSess auth) v
@@ -670,7 +657,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq
         Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT
 
 smpConnectClient :: AgentClient -> SMPTransportSession -> TMap SMPServer ProxiedRelayVar -> SMPClientVar -> AM SMPConnectedClient
-smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} tSess@(_, srv, _) prs v =
+smpConnectClient c@AgentClient {smpClients, msgQ} tSess@(_, srv, _) prs v =
   newProtocolClient c tSess smpClients connectClient v
     `catchAgentError` \e -> lift (resubscribeSMPSession c tSess) >> throwE e
   where
@@ -680,8 +667,7 @@ smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs} tSess@(_, srv, _)
       g <- asks random
       env <- ask
       liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
-        ts <- readTVarIO proxySessTs
-        smp <- ExceptT $ getProtocolClient g tSess cfg (Just msgQ) ts $ smpClientDisconnected c tSess env v' prs
+        smp <- ExceptT $ getProtocolClient g tSess cfg (Just msgQ) $ smpClientDisconnected c tSess env v' prs
         pure SMPConnectedClient {connectedClient = smp, proxiedRelays = prs}
 
 smpClientDisconnected :: AgentClient -> SMPTransportSession -> Env -> SMPClientVar -> TMap SMPServer ProxiedRelayVar -> SMPClient -> IO ()
@@ -770,7 +756,7 @@ reconnectSMPClient c tSess@(_, srv, _) qs = handleNotify $ do
     notifySub connId cmd = atomically $ writeTBQueue (subQ c) ("", connId, AEvt (sAEntity @e) cmd)
 
 getNtfServerClient :: AgentClient -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} tSess@(_, srv, _) = do
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq} tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess ntfClients ts)
@@ -782,9 +768,8 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} tS
     connectClient v = do
       cfg <- lift $ getClientConfig c ntfCfg
       g <- asks random
-      ts <- readTVarIO proxySessTs
       liftError' (protocolClientError NTF $ B.unpack $ strEncode srv) $
-        getProtocolClient g tSess cfg Nothing ts $
+        getProtocolClient g tSess cfg Nothing $
           clientDisconnected v
 
     clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
@@ -794,7 +779,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs} tS
       logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv
 
 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
-getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs} tSess@(_, srv, _) = do
+getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq} tSess@(_, srv, _) = do
   unlessM (readTVarIO active) $ throwE INACTIVE
   ts <- liftIO getCurrentTime
   atomically (getSessVar workerSeq tSess xftpClients ts)
@@ -806,9 +791,8 @@ getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs}
     connectClient v = do
       cfg <- asks $ xftpCfg . config
       xftpNetworkConfig <- getNetworkConfig c
-      ts <- readTVarIO proxySessTs
       liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
-        X.getXFTPClient tSess cfg {xftpNetworkConfig} ts $
+        X.getXFTPClient tSess cfg {xftpNetworkConfig} $
           clientDisconnected v
 
     clientDisconnected :: XFTPClientVar -> XFTPClient -> IO ()
@@ -1076,7 +1060,7 @@ sendOrProxySMPCommand ::
   (SMPClient -> ProxiedRelay -> ExceptT SMPClientError IO (Either ProxyClientError ())) ->
   (SMPClient -> ExceptT SMPClientError IO ()) ->
   AM (Maybe SMPServer)
-sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
+sendOrProxySMPCommand c userId destSrv connId cmdStr senderId sendCmdViaProxy sendCmdDirectly = do
   tSess <- mkTransportSession c userId destSrv connId
   ifM shouldUseProxy (sendViaProxy Nothing tSess) (sendDirectly tSess $> Nothing)
   where
@@ -1095,7 +1079,7 @@ sendOrProxySMPCommand c userId destSrv@ProtocolServer {host = destHosts} connId
         SPFAllow -> True
         SPFAllowProtected -> ipAddressProtected cfg destSrv
         SPFProhibit -> False
-    unknownServer = liftIO $ maybe True (\srvs -> all (`S.notMember` knownHosts srvs) destHosts) <$> TM.lookupIO userId (smpServers c)
+    unknownServer = liftIO $ maybe True (notElem destSrv . knownSrvs) <$> TM.lookupIO userId (smpServers c)
     sendViaProxy :: Maybe SMPServerWithAuth -> SMPTransportSession -> AM (Maybe SMPServer)
     sendViaProxy proxySrv_ destSess@(_, _, connId_) = do
       r <- tryAgentError . withProxySession c proxySrv_ destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess@ProxiedRelay {prBasicAuth}) -> do
@@ -1215,8 +1199,7 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
   g <- asks random
   liftIO $ do
     let tSess = (userId, srv, Nothing)
-    ts <- readTVarIO $ proxySessTs c
-    getProtocolClient g tSess cfg Nothing ts (\_ -> pure ()) >>= \case
+    getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
       Right smp -> do
         rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
         (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
@@ -1246,8 +1229,7 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
   rcvPath <- getTempFilePath workDir
   liftIO $ do
     let tSess = (userId, srv, Nothing)
-    ts <- readTVarIO $ proxySessTs c
-    X.getXFTPClient tSess cfg {xftpNetworkConfig} ts (\_ -> pure ()) >>= \case
+    X.getXFTPClient tSess cfg {xftpNetworkConfig} (\_ -> pure ()) >>= \case
       Right xftp -> withTestChunk filePath $ do
         (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
         (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -1291,8 +1273,7 @@ runNTFServerTest c userId (ProtoServerWithAuth srv _) = do
   g <- asks random
   liftIO $ do
     let tSess = (userId, srv, Nothing)
-    ts <- readTVarIO $ proxySessTs c
-    getProtocolClient g tSess cfg Nothing ts (\_ -> pure ()) >>= \case
+    getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
       Right ntf -> do
         (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
         (dhKey, _) <- atomically $ C.generateKeyPair g
@@ -1390,7 +1371,6 @@ temporaryAgentError = \case
   PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> tempBrokerError e
   PROXY _ _ (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION)) -> True
   INACTIVE -> True
-  CRITICAL True _ -> True -- critical errors that do not show restart button are likely to be permanent
   _ -> False
   where
     tempBrokerError = \case
@@ -1430,7 +1410,7 @@ subscribeQueues c qs = do
     checkQueue rq = do
       prohibited <- liftIO $ hasGetLock c rq
       pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED "subscribeQueues") else Right rq
-    subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses RcvQueue SMPClientError ())
+    subscribeQueues_ :: Env -> TVar (Maybe SessionId) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
     subscribeQueues_ env session smp qs' = do
       let (userId, srv, _) = transportSession' smp
       atomically $ incSMPServerStat' c userId srv connSubAttempts $ length qs'
@@ -1461,33 +1441,31 @@ activeClientSession c tSess sessId = sameSess <$> tryReadSessVar tSess (smpClien
       Just (Right (SMPConnectedClient smp _)) -> sessId == sessionId (thParams smp)
       _ -> False
 
-type BatchResponses q e r = NonEmpty (q, Either e r)
+type BatchResponses e r = NonEmpty (RcvQueue, Either e r)
 
--- Please note: this function does not preserve order of results to be the same as the order of arguments,
--- it includes arguments in the results instead.
-sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses q SMPClientError r)) -> AgentClient -> [q] -> AM' [(q, Either AgentErrorType r)]
+sendTSessionBatches :: forall q r. ByteString -> (q -> RcvQueue) -> (SMPClient -> NonEmpty q -> IO (BatchResponses SMPClientError r)) -> AgentClient -> [q] -> AM' [(RcvQueue, Either AgentErrorType r)]
 sendTSessionBatches statCmd toRQ action c qs =
   concatMap L.toList <$> (mapConcurrently sendClientBatch =<< batchQueues)
   where
     batchQueues :: AM' [(SMPTransportSession, NonEmpty q)]
     batchQueues = do
       mode <- getSessionMode c
-      pure . M.assocs $ foldr (batch mode) M.empty qs
+      pure . M.assocs $ foldl' (batch mode) M.empty qs
       where
-        batch mode q m =
+        batch mode m q =
           let tSess = mkSMPTSession (toRQ q) mode
            in M.alter (Just . maybe [q] (q <|)) tSess m
-    sendClientBatch :: (SMPTransportSession, NonEmpty q) -> AM' (BatchResponses q AgentErrorType r)
+    sendClientBatch :: (SMPTransportSession, NonEmpty q) -> AM' (BatchResponses AgentErrorType r)
     sendClientBatch (tSess@(_, srv, _), qs') =
       tryAgentError' (getSMPServerClient c tSess) >>= \case
-        Left e -> pure $ L.map (,Left e) qs'
+        Left e -> pure $ L.map ((,Left e) . toRQ) qs'
         Right (SMPConnectedClient smp _) -> liftIO $ do
           logServer' "-->" c srv (bshow (length qs') <> " queues") statCmd
           L.map agentError <$> action smp qs'
           where
             agentError = second . first $ protocolClientError SMP $ clientServer smp
 
-sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateAuthKey, SMP.RecipientId) -> IO (NonEmpty (Either SMPClientError ()))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses RcvQueue SMPClientError ())
+sendBatch :: (SMPClient -> NonEmpty (SMP.RcvPrivateAuthKey, SMP.RecipientId) -> IO (NonEmpty (Either SMPClientError ()))) -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
 sendBatch smpCmdFunc smp qs = L.zip qs <$> smpCmdFunc smp (L.map queueCreds qs)
   where
     queueCreds RcvQueue {rcvPrivateKey, rcvId} = (rcvPrivateKey, rcvId)
@@ -1594,7 +1572,7 @@ getQueueMessage c rq@RcvQueue {server, rcvId, rcvPrivateKey} = do
 
 decryptSMPMessage :: RcvQueue -> SMP.RcvMessage -> AM SMP.ClientRcvMsgBody
 decryptSMPMessage rq SMP.RcvMessage {msgId, msgBody = SMP.EncRcvMsgBody body} =
-  liftEither $ parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body
+  liftEither . parse SMP.clientRcvMsgBodyP (AGENT A_MESSAGE) =<< decrypt body
   where
     decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId)
 
@@ -1616,44 +1594,28 @@ enableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} notifierKey rcvNtf
   withSMPClient c rq "NKEY <nkey>" $ \smp ->
     enableSMPQueueNotifications smp rcvPrivateKey rcvId notifierKey rcvNtfPublicDhKey
 
-data EnableQueueNtfReq = EnableQueueNtfReq
-  { eqnrNtfSub :: NtfSubscription,
-    eqnrRq :: RcvQueue,
-    eqnrAuthKeyPair :: C.AAuthKeyPair,
-    eqnrRcvKeyPair :: C.KeyPairX25519
-  }
-
-enableQueuesNtfs :: AgentClient -> [EnableQueueNtfReq] -> AM' [(EnableQueueNtfReq, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
-enableQueuesNtfs = sendTSessionBatches "NKEY" eqnrRq enableQueues_
+enableQueuesNtfs :: AgentClient -> [(RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)] -> AM' [(RcvQueue, Either AgentErrorType (SMP.NotifierId, SMP.RcvNtfPublicDhKey))]
+enableQueuesNtfs = sendTSessionBatches "NKEY" fst3 enableQueues_
   where
-    enableQueues_ :: SMPClient -> NonEmpty EnableQueueNtfReq -> IO (NonEmpty (EnableQueueNtfReq, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
-    enableQueues_ smp qs' = L.zip qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
-    queueCreds :: EnableQueueNtfReq -> (SMP.RcvPrivateAuthKey, SMP.RecipientId, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
-    queueCreds EnableQueueNtfReq {eqnrRq, eqnrAuthKeyPair, eqnrRcvKeyPair} =
-      let RcvQueue {rcvPrivateKey, rcvId} = eqnrRq
-          (ntfPublicKey, _) = eqnrAuthKeyPair
-          (rcvNtfPubDhKey, _) = eqnrRcvKeyPair
-       in (rcvPrivateKey, rcvId, ntfPublicKey, rcvNtfPubDhKey)
+    fst3 (x, _, _) = x
+    enableQueues_ :: SMPClient -> NonEmpty (RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey) -> IO (NonEmpty (RcvQueue, Either (ProtocolClientError ErrorType) (SMP.NotifierId, RcvNtfPublicDhKey)))
+    enableQueues_ smp qs' = L.zipWith ((,) . fst3) qs' <$> enableSMPQueuesNtfs smp (L.map queueCreds qs')
+    queueCreds :: (RcvQueue, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey) -> (SMP.RcvPrivateAuthKey, SMP.RecipientId, SMP.NtfPublicAuthKey, SMP.RcvNtfPublicDhKey)
+    queueCreds (RcvQueue {rcvPrivateKey, rcvId}, notifierKey, rcvNtfPublicDhKey) = (rcvPrivateKey, rcvId, notifierKey, rcvNtfPublicDhKey)
 
 disableQueueNotifications :: AgentClient -> RcvQueue -> AM ()
 disableQueueNotifications c rq@RcvQueue {rcvId, rcvPrivateKey} =
   withSMPClient c rq "NDEL" $ \smp ->
     disableSMPQueueNotifications smp rcvPrivateKey rcvId
 
-type DisableQueueNtfReq = (NtfSubscription, RcvQueue)
-
-disableQueuesNtfs :: AgentClient -> [DisableQueueNtfReq] -> AM' [(DisableQueueNtfReq, Either AgentErrorType ())]
-disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_
-  where
-    disableQueues_ :: SMPClient -> NonEmpty DisableQueueNtfReq -> IO (NonEmpty (DisableQueueNtfReq, Either (ProtocolClientError ErrorType) ()))
-    disableQueues_ smp qs' = L.zip qs' <$> disableSMPQueuesNtfs smp (L.map queueCreds qs')
-    queueCreds :: DisableQueueNtfReq -> (SMP.RcvPrivateAuthKey, SMP.RecipientId)
-    queueCreds (_, RcvQueue {rcvPrivateKey, rcvId}) = (rcvPrivateKey, rcvId)
+disableQueuesNtfs :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())]
+disableQueuesNtfs = sendTSessionBatches "NDEL" id $ sendBatch disableSMPQueuesNtfs
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
-sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
+sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
   withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId msgId
+  atomically $ releaseGetLock c rq
 
 hasGetLock :: AgentClient -> RcvQueue -> IO Bool
 hasGetLock c RcvQueue {server, rcvId} =
@@ -1725,8 +1687,8 @@ agentNtfReplaceToken :: AgentClient -> NtfTokenId -> NtfToken -> DeviceToken ->
 agentNtfReplaceToken c tknId NtfToken {ntfServer, ntfPrivKey} token =
   withNtfClient c ntfServer tknId "TRPL" $ \ntf -> ntfReplaceToken ntf ntfPrivKey tknId token
 
-agentNtfDeleteToken :: AgentClient -> NtfServer -> C.APrivateAuthKey -> NtfTokenId -> AM ()
-agentNtfDeleteToken c ntfServer ntfPrivKey tknId =
+agentNtfDeleteToken :: AgentClient -> NtfTokenId -> NtfToken -> AM ()
+agentNtfDeleteToken c tknId NtfToken {ntfServer, ntfPrivKey} =
   withNtfClient c ntfServer tknId "TDEL" $ \ntf -> ntfDeleteToken ntf ntfPrivKey tknId
 
 agentNtfEnableCron :: AgentClient -> NtfTokenId -> NtfToken -> Word16 -> AM ()
@@ -1737,34 +1699,10 @@ agentNtfCreateSubscription :: AgentClient -> NtfTokenId -> NtfToken -> SMPQueueN
 agentNtfCreateSubscription c tknId NtfToken {ntfServer, ntfPrivKey} smpQueue nKey =
   withNtfClient c ntfServer tknId "SNEW" $ \ntf -> ntfCreateSubscription ntf ntfPrivKey (NewNtfSub tknId smpQueue nKey)
 
-agentNtfCreateSubscriptions :: AgentClient -> NtfToken -> NonEmpty (NewNtfEntity 'Subscription) -> AM' (NonEmpty (Either AgentErrorType NtfSubscriptionId))
-agentNtfCreateSubscriptions = withNtfBatch "SNEW" ntfCreateSubscriptions
-
-agentNtfCheckSubscription :: AgentClient -> NtfToken -> NtfSubscriptionId -> AM NtfSubStatus
-agentNtfCheckSubscription c NtfToken {ntfServer, ntfPrivKey} subId =
+agentNtfCheckSubscription :: AgentClient -> NtfSubscriptionId -> NtfToken -> AM NtfSubStatus
+agentNtfCheckSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
   withNtfClient c ntfServer subId "SCHK" $ \ntf -> ntfCheckSubscription ntf ntfPrivKey subId
 
-agentNtfCheckSubscriptions :: AgentClient -> NtfToken -> NonEmpty NtfSubscriptionId -> AM' (NonEmpty (Either AgentErrorType NtfSubStatus))
-agentNtfCheckSubscriptions = withNtfBatch "SCHK" ntfCheckSubscriptions
-
--- This batch sends all commands to one ntf server (client can only use one server at a time)
-withNtfBatch ::
-  ByteString ->
-  (NtfClient -> C.APrivateAuthKey -> NonEmpty a -> IO (NonEmpty (Either NtfClientError r))) ->
-  AgentClient ->
-  NtfToken ->
-  NonEmpty a ->
-  AM' (NonEmpty (Either AgentErrorType r))
-withNtfBatch cmdStr action c NtfToken {ntfServer, ntfPrivKey} subs = do
-  let tSess = (0, ntfServer, Nothing)
-  tryAgentError' (getNtfServerClient c tSess) >>= \case
-    Left e -> pure $ L.map (\_ -> Left e) subs
-    Right ntf -> liftIO $ do
-      logServer' "-->" c ntfServer (bshow (length subs) <> " subscriptions") cmdStr
-      L.map agentError <$> action ntf ntfPrivKey subs
-      where
-        agentError = first $ protocolClientError NTF $ clientServer ntf
-
 agentNtfDeleteSubscription :: AgentClient -> NtfSubscriptionId -> NtfToken -> AM ()
 agentNtfDeleteSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
   withNtfClient c ntfServer subId "SDEL" $ \ntf -> ntfDeleteSubscription ntf ntfPrivKey subId
@@ -1834,9 +1772,9 @@ agentCbEncryptOnce clientVersion dhRcvPubKey msg = do
 
 -- | NaCl crypto-box decrypt - both for messages received from the server
 -- and per-queue E2E encrypted messages from the sender that were inside.
-agentCbDecrypt :: C.DhSecretX25519 -> C.CbNonce -> ByteString -> Either AgentErrorType ByteString
+agentCbDecrypt :: C.DhSecretX25519 -> C.CbNonce -> ByteString -> AM ByteString
 agentCbDecrypt dhSecret nonce msg =
-  first cryptoError $
+  liftEither . first cryptoError $
     C.cbDecrypt dhSecret nonce msg
 
 cryptoError :: C.CryptoError -> AgentErrorType
@@ -1862,39 +1800,12 @@ withWork c doWork getWork action =
   withStore' c getWork >>= \case
     Right (Just r) -> action r
     Right Nothing -> noWork
-    -- worker is stopped here (noWork) because the next iteration is likely to produce the same result
     Left e@SEWorkItemError {} -> noWork >> notifyErr (CRITICAL False) e
     Left e -> notifyErr INTERNAL e
   where
     noWork = liftIO $ noWorkToDo doWork
     notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
 
-withWorkItems :: AgentClient -> TMVar () -> (DB.Connection -> IO (Either StoreError [Either StoreError a])) -> (NonEmpty a -> AM ()) -> AM ()
-withWorkItems c doWork getWork action = do
-  withStore' c getWork >>= \case
-    Right [] -> noWork
-    Right rs -> do
-      let (errs, items) = partitionEithers rs
-      case L.nonEmpty items of
-        Just items' -> action items'
-        Nothing -> do
-          let criticalErr = find workItemError errs
-          forM_ criticalErr $ \err -> do
-            notifyErr (CRITICAL False) err
-            when (all workItemError errs) noWork
-      unless (null errs) $
-        atomically $
-          writeTBQueue (subQ c) ("", "", AEvt SAENone $ ERRS $ map (\e -> ("", INTERNAL $ show e)) errs)
-    Left e
-      | workItemError e -> noWork >> notifyErr (CRITICAL False) e
-      | otherwise -> notifyErr INTERNAL e
-  where
-    workItemError = \case
-      SEWorkItemError {} -> True
-      _ -> False
-    noWork = liftIO $ noWorkToDo doWork
-    notifyErr err e = atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR $ err $ show e)
-
 noWorkToDo :: TMVar () -> IO ()
 noWorkToDo = void . atomically . tryTakeTMVar
 {-# INLINE noWorkToDo #-}
@@ -1993,13 +1904,6 @@ withStore c action = do
   withExceptT storeError . ExceptT . liftIO . agentOperationBracket c AODatabase (\_ -> pure ()) $
     withTransaction st action `E.catches` handleDBErrors
   where
-#if defined(dbPostgres)
-    -- TODO [postgres] postgres specific error handling
-    handleDBErrors :: [E.Handler IO (Either StoreError a)]
-    handleDBErrors =
-      [ E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
-      ]
-#else
     handleDBErrors :: [E.Handler IO (Either StoreError a)]
     handleDBErrors =
       [ E.Handler $ \(e :: SQL.SQLError) ->
@@ -2008,12 +1912,6 @@ withStore c action = do
            in pure . Left . (if busy then SEDatabaseBusy else SEInternal) $ bshow se,
         E.Handler $ \(E.SomeException e) -> pure . Left $ SEInternal $ bshow e
       ]
-#endif
-
-unsafeWithStore :: AgentClient -> (DB.Connection -> IO a) -> AM' a
-unsafeWithStore c action = do
-  st <- asks store
-  liftIO $ agentOperationBracket c AODatabase (\_ -> pure ()) $ withTransaction st action
 
 withStoreBatch :: Traversable t => AgentClient -> (DB.Connection -> t (IO (Either AgentErrorType a))) -> AM' (t (Either AgentErrorType a))
 withStoreBatch c actions = do
@@ -2037,7 +1935,7 @@ storeError = \case
   SEConnDuplicate -> CONN DUPLICATE
   SEBadConnType CRcv -> CONN SIMPLEX
   SEBadConnType CSnd -> CONN SIMPLEX
-  SEInvitationNotFound cxt invId -> CMD PROHIBITED $ "SEInvitationNotFound " <> cxt <> ", invitationId = " <> show invId
+  SEInvitationNotFound -> CMD PROHIBITED "SEInvitationNotFound"
   -- this error is never reported as store error,
   -- it is used to wrap agent operations when "transaction-like" store access is needed
   -- NOTE: network IO should NOT be used inside AgentStoreMonad
@@ -2051,82 +1949,33 @@ userServers c = case protocolTypeI @p of
   SPXFTP -> xftpServers c
 {-# INLINE userServers #-}
 
-pickServer :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p) -> AM (ProtoServerWithAuth p)
+pickServer :: forall p. NonEmpty (ProtoServerWithAuth p) -> AM (ProtoServerWithAuth p)
 pickServer = \case
-  (_, srv) :| [] -> pure srv
+  srv :| [] -> pure srv
   servers -> do
     gen <- asks randomServer
-    atomically $ snd . (servers L.!!) <$> stateTVar gen (randomR (0, L.length servers - 1))
+    atomically $ (servers L.!!) <$> stateTVar gen (randomR (0, L.length servers - 1))
 
-getNextServer ::
-  (ProtocolTypeI p, UserProtocol p) =>
-  AgentClient ->
-  UserId ->
-  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
-  [ProtocolServer p] ->
-  AM (ProtoServerWithAuth p)
-getNextServer c userId srvsSel usedSrvs = do
-  srvs <- getUserServers_ c userId srvsSel
-  snd <$> getNextServer_ srvs (usedOperatorsHosts srvs usedSrvs)
+getNextServer :: forall p. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> [ProtocolServer p] -> AM (ProtoServerWithAuth p)
+getNextServer c userId usedSrvs = withUserServers c userId $ \srvs ->
+  case L.nonEmpty $ deleteFirstsBy sameSrvAddr' (L.toList srvs) (map noAuthSrv usedSrvs) of
+    Just srvs' -> pickServer srvs'
+    _ -> pickServer srvs
 
-usedOperatorsHosts :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p) -> [ProtocolServer p] -> (Set (Maybe OperatorId), Set TransportHost)
-usedOperatorsHosts srvs usedSrvs = (usedOperators, usedHosts)
-  where
-    usedHosts = S.unions $ map serverHosts usedSrvs
-    usedOperators = S.fromList $ mapMaybe usedOp $ L.toList srvs
-    usedOp (op, srv) = if hasUsedHost srv then Just op else Nothing
-    hasUsedHost (ProtoServerWithAuth srv _) = any (`S.member` usedHosts) $ serverHosts srv
-
-getNextServer_ ::
-  (ProtocolTypeI p, UserProtocol p) =>
-  NonEmpty (Maybe OperatorId, ProtoServerWithAuth p) ->
-  (Set (Maybe OperatorId), Set TransportHost) ->
-  AM (NonEmpty (Maybe OperatorId, ProtoServerWithAuth p), ProtoServerWithAuth p)
-getNextServer_ servers (usedOperators, usedHosts) = do
-  -- choose from servers of unused operators, when possible
-  let otherOpsSrvs = filterOrAll ((`S.notMember` usedOperators) . fst) servers
-      -- choose from servers with unused hosts when possible
-      unusedSrvs = filterOrAll (isUnusedServer usedHosts) otherOpsSrvs
-  (otherOpsSrvs,) <$> pickServer unusedSrvs
-  where
-    filterOrAll p srvs = fromMaybe srvs $ L.nonEmpty $ L.filter p srvs
-
-isUnusedServer :: Set TransportHost -> (Maybe OperatorId, ProtoServerWithAuth p) -> Bool
-isUnusedServer usedHosts (_, ProtoServerWithAuth ProtocolServer {host} _) = all (`S.notMember` usedHosts) host
-
-getUserServers_ ::
-  (ProtocolTypeI p, UserProtocol p) =>
-  AgentClient ->
-  UserId ->
-  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
-  AM (NonEmpty (Maybe OperatorId, ProtoServerWithAuth p))
-getUserServers_ c userId srvsSel =
+withUserServers :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> (NonEmpty (ProtoServerWithAuth p) -> AM a) -> AM a
+withUserServers c userId action =
   liftIO (TM.lookupIO userId $ userServers c) >>= \case
-    Just srvs -> pure $ srvsSel srvs
+    Just srvs -> action $ enabledSrvs srvs
     _ -> throwE $ INTERNAL "unknown userId - no user servers"
 
--- This function checks used servers and operators every time to allow
--- changing configuration while retry look is executing.
--- This function is not thread safe.
-withNextSrv ::
-  (ProtocolTypeI p, UserProtocol p) =>
-  AgentClient ->
-  UserId ->
-  (UserServers p -> NonEmpty (Maybe OperatorId, ProtoServerWithAuth p)) ->
-  TVar (Set TransportHost) ->
-  [ProtocolServer p] ->
-  (ProtoServerWithAuth p -> AM a) ->
-  AM a
-withNextSrv c userId srvsSel triedHosts usedSrvs action = do
-  srvs <- getUserServers_ c userId srvsSel
-  let (usedOperators, usedHosts) = usedOperatorsHosts srvs usedSrvs
-  tried <- readTVarIO triedHosts
-  let triedOrUsed = S.union tried usedHosts
-  (otherOpsSrvs, srvAuth@(ProtoServerWithAuth srv _)) <- getNextServer_ srvs (usedOperators, triedOrUsed)
-  let newHosts = serverHosts srv
-      unusedSrvs = L.filter (isUnusedServer $ S.union triedOrUsed newHosts) otherOpsSrvs
-      !tried' = if null unusedSrvs then S.empty else S.union tried newHosts
-  atomically $ writeTVar triedHosts tried'
+withNextSrv :: forall p a. (ProtocolTypeI p, UserProtocol p) => AgentClient -> UserId -> TVar [ProtocolServer p] -> [ProtocolServer p] -> (ProtoServerWithAuth p -> AM a) -> AM a
+withNextSrv c userId usedSrvs initUsed action = do
+  used <- readTVarIO usedSrvs
+  srvAuth@(ProtoServerWithAuth srv _) <- getNextServer c userId used
+  srvs_ <- liftIO $ TM.lookupIO userId $ userServers c
+  let unused = maybe [] ((\\ used) . map protoServer . L.toList . enabledSrvs) srvs_
+      used' = if null unused then initUsed else srv : used
+  atomically $ writeTVar usedSrvs $! used'
   action srvAuth
 
 incSMPServerStat :: AgentClient -> UserId -> SMPServer -> (AgentSMPServerStats -> TVar Int) -> STM ()
@@ -2152,13 +2001,9 @@ incXFTPServerStat_ = incServerStat (\AgentClient {xftpServersStats = s} -> s) ne
 {-# INLINE incXFTPServerStat_ #-}
 
 incNtfServerStat :: AgentClient -> UserId -> NtfServer -> (AgentNtfServerStats -> TVar Int) -> STM ()
-incNtfServerStat c userId srv sel = incNtfServerStat' c userId srv sel 1
+incNtfServerStat c userId srv sel = incServerStat (\AgentClient {ntfServersStats = s} -> s) newAgentNtfServerStats c userId srv sel 1
 {-# INLINE incNtfServerStat #-}
 
-incNtfServerStat' :: AgentClient -> UserId -> NtfServer -> (AgentNtfServerStats -> TVar Int) -> Int -> STM ()
-incNtfServerStat' = incServerStat (\AgentClient {ntfServersStats = s} -> s) newAgentNtfServerStats
-{-# INLINE incNtfServerStat' #-}
-
 incServerStat :: Num n => (AgentClient -> TMap (UserId, ProtocolServer p) s) -> STM s -> AgentClient -> UserId -> ProtocolServer p -> (s -> TVar n) -> n -> STM ()
 incServerStat statsSel mkNewStats c userId srv sel n = do
   TM.lookup (userId, srv) (statsSel c) >>= \case

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

@@ -17,14 +17,11 @@ module Simplex.Messaging.Agent.Env.SQLite
     AgentConfig (..),
     InitialAgentServers (..),
     ServerCfg (..),
-    ServerRoles (..),
-    OperatorId,
     UserServers (..),
     NetworkConfig (..),
     presetServerCfg,
-    allRoles,
+    enabledServerCfg,
     mkUserServers,
-    serverHosts,
     defaultAgentConfig,
     defaultReconnectInterval,
     tryAgentError,
@@ -45,20 +42,18 @@ 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
 import Crypto.Random
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as JQ
+import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe)
-import Data.Set (Set)
-import qualified Data.Set as S
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16)
@@ -67,10 +62,8 @@ import Numeric.Natural
 import Simplex.FileTransfer.Client (XFTPClientConfig (..), defaultXFTPClientConfig)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
-import Simplex.Messaging.Agent.Store (createStore)
-import Simplex.Messaging.Agent.Store.Common (DBStore)
-import Simplex.Messaging.Agent.Store.Interface (DBOpts)
-import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), MigrationError (..))
+import Simplex.Messaging.Agent.Store.SQLite
+import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange)
@@ -78,14 +71,15 @@ import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Notifications.Transport (NTFVersion)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (defaultJSON)
-import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
+import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth, ProtocolServer, ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
 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.Transport (SMPVersion, TLS, Transport (..))
+import Simplex.Messaging.Transport.Client (defaultSMPPort)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
 import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
+import UnliftIO (SomeException)
 import UnliftIO.STM
 
 type AM' a = ReaderT Env IO a
@@ -101,42 +95,29 @@ data InitialAgentServers = InitialAgentServers
 
 data ServerCfg p = ServerCfg
   { server :: ProtoServerWithAuth p,
-    operator :: Maybe OperatorId,
-    enabled :: Bool,
-    roles :: ServerRoles
+    preset :: Bool,
+    tested :: Maybe Bool,
+    enabled :: Bool
   }
   deriving (Show)
 
-data ServerRoles = ServerRoles
-  { storage :: Bool,
-    proxy :: Bool
-  }
-  deriving (Show)
+enabledServerCfg :: ProtoServerWithAuth p -> ServerCfg p
+enabledServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
 
-allRoles :: ServerRoles
-allRoles = ServerRoles True True
-
-presetServerCfg :: Bool -> ServerRoles -> Maybe OperatorId -> ProtoServerWithAuth p -> ServerCfg p
-presetServerCfg enabled roles operator server =
-  ServerCfg {server, operator, enabled, roles}
+presetServerCfg :: Bool -> ProtoServerWithAuth p -> ServerCfg p
+presetServerCfg enabled server = ServerCfg {server, preset = True, tested = Nothing, enabled}
 
 data UserServers p = UserServers
-  { storageSrvs :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p),
-    proxySrvs :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p),
-    knownHosts :: Set TransportHost
+  { enabledSrvs :: NonEmpty (ProtoServerWithAuth p),
+    knownSrvs :: NonEmpty (ProtocolServer p)
   }
 
-type OperatorId = Int64
-
 -- This function sets all servers as enabled in case all passed servers are disabled.
 mkUserServers :: NonEmpty (ServerCfg p) -> UserServers p
-mkUserServers srvs = UserServers {storageSrvs = filterSrvs storage, proxySrvs = filterSrvs proxy, knownHosts}
+mkUserServers srvs = UserServers {enabledSrvs, knownSrvs}
   where
-    filterSrvs role = L.map (\ServerCfg {operator, server} -> (operator, server)) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled, roles} -> enabled && role roles) srvs
-    knownHosts = S.unions $ L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> serverHosts srv) srvs
-
-serverHosts :: ProtocolServer p -> Set TransportHost
-serverHosts ProtocolServer {host} = S.fromList $ L.toList host
+    enabledSrvs = L.map (\ServerCfg {server} -> server) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled} -> enabled) srvs
+    knownSrvs = L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> srv) srvs
 
 data AgentConfig = AgentConfig
   { tcpPort :: Maybe ServiceName,
@@ -169,8 +150,6 @@ data AgentConfig = AgentConfig
     xftpMaxRecipientsPerRequest :: Int,
     deleteErrorCount :: Int,
     ntfCron :: Word16,
-    ntfBatchSize :: Int,
-    ntfSubFirstCheckInterval :: NominalDiffTime,
     ntfSubCheckInterval :: NominalDiffTime,
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
@@ -214,9 +193,9 @@ defaultAgentConfig =
       rcvAuthAlg = C.AuthAlg C.SEd25519, -- this will stay as Ed25519
       sndAuthAlg = C.AuthAlg C.SEd25519, -- TODO replace with X25519 when switching to v7
       connIdBytes = 12,
-      tbqSize = 128,
-      smpCfg = defaultSMPClientConfig,
-      ntfCfg = defaultNTFClientConfig,
+      tbqSize = 64,
+      smpCfg = defaultSMPClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)},
+      ntfCfg = defaultNTFClientConfig {defaultTransport = ("443", transport @TLS)},
       xftpCfg = defaultXFTPClientConfig,
       reconnectInterval = defaultReconnectInterval,
       messageRetryInterval = defaultMessageRetryInterval,
@@ -240,9 +219,7 @@ defaultAgentConfig =
       xftpMaxRecipientsPerRequest = 200,
       deleteErrorCount = 10,
       ntfCron = 20, -- minutes
-      ntfBatchSize = 150,
-      ntfSubFirstCheckInterval = nominalDay,
-      ntfSubCheckInterval = 3 * nominalDay,
+      ntfSubCheckInterval = nominalDay,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
       caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
@@ -255,7 +232,7 @@ defaultAgentConfig =
 
 data Env = Env
   { config :: AgentConfig,
-    store :: DBStore,
+    store :: SQLiteStore,
     random :: TVar ChaChaDRG,
     randomServer :: TVar StdGen,
     ntfSupervisor :: NtfSupervisor,
@@ -263,7 +240,7 @@ data Env = Env
     multicastSubscribers :: TMVar Int
   }
 
-newSMPAgentEnv :: AgentConfig -> DBStore -> IO Env
+newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
 newSMPAgentEnv config store = do
   random <- C.newRandom
   randomServer <- newTVarIO =<< liftIO newStdGen
@@ -272,18 +249,17 @@ newSMPAgentEnv config store = do
   multicastSubscribers <- newTMVarIO 0
   pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}
 
-createAgentStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createAgentStore = createStore
+createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createAgentStore dbFilePath dbKey keepKey = createSQLiteStore dbFilePath dbKey keepKey Migrations.app
 
 data NtfSupervisor = NtfSupervisor
   { ntfTkn :: TVar (Maybe NtfToken),
-    ntfSubQ :: TBQueue (NtfSupervisorCommand, NonEmpty ConnId),
+    ntfSubQ :: TBQueue (ConnId, NtfSupervisorCommand),
     ntfWorkers :: TMap NtfServer Worker,
-    ntfSMPWorkers :: TMap SMPServer Worker,
-    ntfTknDelWorkers :: TMap NtfServer Worker
+    ntfSMPWorkers :: TMap SMPServer Worker
   }
 
-data NtfSupervisorCommand = NSCCreate | NSCSmpDelete | NSCDeleteSub
+data NtfSupervisorCommand = NSCCreate | NSCDelete | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer
   deriving (Show)
 
 newNtfSubSupervisor :: Natural -> IO NtfSupervisor
@@ -292,8 +268,7 @@ newNtfSubSupervisor qSize = do
   ntfSubQ <- newTBQueueIO qSize
   ntfWorkers <- TM.emptyIO
   ntfSMPWorkers <- TM.emptyIO
-  ntfTknDelWorkers <- TM.emptyIO
-  pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers, ntfTknDelWorkers}
+  pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers}
 
 data XFTPAgent = XFTPAgent
   { -- if set, XFTP file paths will be considered as relative to this directory
@@ -333,9 +308,7 @@ 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
+mkInternal = INTERNAL . show
 {-# INLINE mkInternal #-}
 
 data Worker = Worker
@@ -357,8 +330,6 @@ updateRestartCount t (RestartCount minute count) = do
 
 $(pure [])
 
-$(JQ.deriveJSON defaultJSON ''ServerRoles)
-
 instance ProtocolTypeI p => ToJSON (ServerCfg p) where
   toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
   toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)

src/Simplex/Messaging/Agent/Lock.hs

@@ -1,12 +1,10 @@
 module Simplex.Messaging.Agent.Lock
   ( Lock,
     createLock,
-    createLockIO,
     withLock,
     withLock',
     withGetLock,
     withGetLocks,
-    getPutLock,
   )
 where
 
@@ -26,10 +24,6 @@ createLock :: STM Lock
 createLock = newEmptyTMVar
 {-# INLINE createLock #-}
 
-createLockIO :: IO Lock
-createLockIO = newEmptyTMVarIO
-{-# INLINE createLockIO #-}
-
 withLock :: MonadUnliftIO m => Lock -> String -> ExceptT e m a -> ExceptT e m a
 withLock lock name = ExceptT . withLock' lock name . runExceptT
 {-# INLINE withLock #-}

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -1,9 +1,7 @@
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -15,7 +13,6 @@ module Simplex.Messaging.Agent.NtfSubSupervisor
     nsRemoveNtfToken,
     sendNtfSubCommand,
     instantNotifications,
-    deleteToken,
     closeNtfSupervisor,
     getNtfServer,
   )
@@ -25,32 +22,23 @@ import Control.Logger.Simple (logError, logInfo)
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
-import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (first)
-import Data.Either (fromRight, partitionEithers)
-import Data.Functor (($>))
-import Data.List (foldl')
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes)
-import qualified Data.Set as S
+import Data.Text (Text)
 import Data.Time (UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Clock (diffUTCTime)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.Protocol (AEvent (..), AEvt (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
-import Simplex.Messaging.Agent.Store.AgentStore
-import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol
+import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..))
 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.Protocol (NtfServer, SMPServer, sameSrvAddr)
+import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
 import UnliftIO.Concurrent (forkIO)
@@ -59,134 +47,91 @@ import qualified UnliftIO.Exception as E
 runNtfSupervisor :: AgentClient -> AM' ()
 runNtfSupervisor c = do
   ns <- asks ntfSupervisor
-  runExceptT startTknDelete >>= \case
-    Left e -> notifyErr e
-    Right _ -> pure ()
   forever $ do
-    cmd <- atomically . readTBQueue $ ntfSubQ ns
-    handleErr . agentOperationBracket c AONtfNetwork waitUntilActive $
-      runExceptT (processNtfCmd c cmd) >>= \case
-        Left e -> notifyErr e
+    cmd@(connId, _) <- atomically . readTBQueue $ ntfSubQ ns
+    handleErr connId . agentOperationBracket c AONtfNetwork waitUntilActive $
+      runExceptT (processNtfSub c cmd) >>= \case
+        Left e -> notifyErr connId e
         Right _ -> return ()
   where
-    startTknDelete :: AM ()
-    startTknDelete = do
-      pendingDelServers <- withStore' c getPendingDelTknServers
-      lift . forM_ pendingDelServers $ getNtfTknDelWorker True c
-    handleErr :: AM' () -> AM' ()
-    handleErr = E.handle $ \(e :: E.SomeException) -> do
+    handleErr :: ConnId -> AM' () -> AM' ()
+    handleErr connId = E.handle $ \(e :: E.SomeException) -> do
       logError $ "runNtfSupervisor error " <> tshow e
-      notifyErr e
-    notifyErr e = notifyInternalError' c $ "runNtfSupervisor error " <> show e
+      notifyErr connId e
+    notifyErr connId e = notifyInternalError c connId $ "runNtfSupervisor error " <> show e
 
-partitionErrs :: (a -> ConnId) -> [a] -> [Either AgentErrorType b] -> ([(ConnId, AgentErrorType)], [b])
-partitionErrs f xs = partitionEithers . zipWith (\x -> first (f x,)) xs
-{-# INLINE partitionErrs #-}
-
-ntfSubConnId :: NtfSubscription -> ConnId
-ntfSubConnId NtfSubscription {connId} = connId
-
-processNtfCmd :: AgentClient -> (NtfSupervisorCommand, NonEmpty ConnId) -> AM ()
-processNtfCmd c (cmd, connIds) = do
-  logInfo $ "processNtfCmd - cmd = " <> tshow cmd
-  let connIds' = L.toList connIds
+processNtfSub :: AgentClient -> (ConnId, NtfSupervisorCommand) -> AM ()
+processNtfSub c (connId, cmd) = do
+  logInfo $ "processNtfSub - connId = " <> tshow connId <> " - cmd = " <> tshow cmd
   case cmd of
     NSCCreate -> do
-      (cErrs, rqSubActions) <- lift $ partitionErrs id connIds' <$> withStoreBatch c (\db -> map (getQueueSub db) connIds')
-      notifyErrs c cErrs
-      logInfo $ "processNtfCmd, NSCCreate - length rqSubs = " <> tshow (length rqSubActions)
-      let (ns, rs, css, cns) = partitionQueueSubActions rqSubActions
-      createNewSubs ns
-      resetSubs rs
-      lift $ do
-        mapM_ (getNtfSMPWorker True c) (S.fromList css)
-        mapM_ (getNtfNTFWorker True c) (S.fromList cns)
-      where
-        getQueueSub ::
-          DB.Connection ->
-          ConnId ->
-          IO (Either AgentErrorType (RcvQueue, Maybe NtfSupervisorSub))
-        getQueueSub db connId = fmap (first storeError) $ runExceptT $ do
-          rq <- ExceptT $ getPrimaryRcvQueue db connId
-          sub <- liftIO $ getNtfSubscription db connId
-          pure (rq, sub)
-        createNewSubs :: [RcvQueue] -> AM ()
-        createNewSubs rqs = do
+      (a, RcvQueue {userId, server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
+        a <- liftIO $ getNtfSubscription db connId
+        q <- ExceptT $ getPrimaryRcvQueue db connId
+        pure (a, q)
+      logInfo $ "processNtfSub, NSCCreate - a = " <> tshow a
+      case a of
+        Nothing -> do
           withTokenServer $ \ntfServer -> do
-            let newSubs = map (rqToNewSub ntfServer) rqs
-            (cErrs, _) <- lift $ partitionErrs ntfSubConnId newSubs <$> withStoreBatch c (\db -> map (storeNewSub db) newSubs)
-            notifyErrs c cErrs
-            kickSMPWorkers rqs
+            case clientNtfCreds of
+              Just ClientNtfCreds {notifierId} -> do
+                let newSub = newNtfSubscription userId connId smpServer (Just notifierId) ntfServer NASKey
+                withStore c $ \db -> createNtfSubscription db newSub $ NSANtf NSACreate
+                lift . void $ getNtfNTFWorker True c ntfServer
+              Nothing -> do
+                let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
+                withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
+                lift . void $ getNtfSMPWorker True c smpServer
+        (Just (sub@NtfSubscription {ntfSubStatus, ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
+          case (clientNtfCreds, ntfQueueId) of
+            (Just ClientNtfCreds {notifierId}, Just ntfQueueId')
+              | sameSrvAddr smpServer smpServer' && notifierId == ntfQueueId' -> create
+              | otherwise -> rotate
+            (Nothing, Nothing) -> create
+            _ -> rotate
           where
-            rqToNewSub :: NtfServer -> RcvQueue -> NtfSubscription
-            rqToNewSub ntfServer RcvQueue {userId, connId, server} = newNtfSubscription userId connId server Nothing ntfServer NASNew
-            storeNewSub :: DB.Connection -> NtfSubscription -> IO (Either AgentErrorType ())
-            storeNewSub db sub = first storeError <$> createNtfSubscription db sub (NSASMP NSASmpKey)
-        resetSubs :: [(RcvQueue, NtfSubscription)] -> AM ()
-        resetSubs rqSubs = do
-          withTokenServer $ \ntfServer -> do
-            let subsToReset = map (toResetSub ntfServer) rqSubs
-            (cErrs, _) <- lift $ partitionErrs ntfSubConnId subsToReset <$> withStoreBatch' c (\db -> map (storeResetSub db) subsToReset)
-            notifyErrs c cErrs
-            let rqs = map fst rqSubs
-            kickSMPWorkers rqs
-          where
-            toResetSub :: NtfServer -> (RcvQueue, NtfSubscription) -> NtfSubscription
-            toResetSub ntfServer (rq, sub) =
-              let RcvQueue {server = smpServer} = rq
-               in sub {smpServer, ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
-            storeResetSub :: DB.Connection -> NtfSubscription -> IO ()
-            storeResetSub db sub = supervisorUpdateNtfSub db sub (NSASMP NSASmpKey)
-        partitionQueueSubActions ::
-          [(RcvQueue, Maybe NtfSupervisorSub)] ->
-          ( [RcvQueue], -- new subs
-            [(RcvQueue, NtfSubscription)], -- reset subs
-            [SMPServer], -- continue work (SMP)
-            [NtfServer] -- continue work (Ntf)
-          )
-        partitionQueueSubActions = foldr decideSubWork ([], [], [], [])
-          where
-            -- sub = Nothing, needs to be created
-            decideSubWork (rq, Nothing) (ns, rs, css, cns) = (rq : ns, rs, css, cns)
-            decideSubWork (rq, Just (sub, subAction_)) (ns, rs, css, cns) =
-              case (clientNtfCreds rq, ntfQueueId sub) of
-                -- notifier ID created on SMP server (on ntf server subscription can be registered or not yet),
-                -- need to clarify action
-                (Just ClientNtfCreds {notifierId}, Just ntfQueueId')
-                  | sameSrvAddr (qServer rq) subSMPServer && notifierId == ntfQueueId' -> contOrReset
-                  | otherwise -> reset
-                (Nothing, Nothing) -> contOrReset
-                _ -> reset
-              where
-                NtfSubscription {ntfServer = subNtfServer, smpServer = subSMPServer} = sub
-                contOrReset = case subAction_ of
-                  -- action was set to NULL after worker internal error
-                  Nothing -> reset
-                  Just (action, _)
-                    -- subscription was marked for deletion / is being deleted
-                    | isDeleteNtfSubAction action -> reset
-                    -- continue work on subscription (e.g. supervisor was repeatedly tasked with creating a subscription)
-                    | otherwise -> case action of
-                        NSASMP _ -> (ns, rs, qServer rq : css, cns)
-                        NSANtf _ -> (ns, rs, css, subNtfServer : cns)
-                reset = (ns, (rq, sub) : rs, css, cns)
+            create :: AM ()
+            create = case action_ of
+              -- action was set to NULL after worker internal error
+              Nothing -> resetSubscription
+              Just (action, _)
+                -- subscription was marked for deletion / is being deleted
+                | isDeleteNtfSubAction action -> do
+                    if ntfSubStatus == NASNew || ntfSubStatus == NASOff || ntfSubStatus == NASDeleted
+                      then resetSubscription
+                      else withTokenServer $ \ntfServer -> do
+                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NSANtf NSACreate)
+                        lift . void $ getNtfNTFWorker True c ntfServer
+                | otherwise -> case action of
+                    NSANtf _ -> lift . void $ getNtfNTFWorker True c subNtfServer
+                    NSASMP _ -> lift . void $ getNtfSMPWorker True c smpServer
+            rotate :: AM ()
+            rotate = do
+              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NSANtf NSARotate)
+              lift . void $ getNtfNTFWorker True c subNtfServer
+            resetSubscription :: AM ()
+            resetSubscription =
+              withTokenServer $ \ntfServer -> do
+                let sub' = sub {ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
+                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NSASMP NSASmpKey)
+                lift . void $ getNtfSMPWorker True c smpServer
+    NSCDelete -> do
+      sub_ <- withStore' c $ \db -> do
+        supervisorUpdateNtfAction db connId (NSANtf NSADelete)
+        getNtfSubscription db connId
+      logInfo $ "processNtfSub, NSCDelete - sub_ = " <> tshow sub_
+      case sub_ of
+        (Just (NtfSubscription {ntfServer}, _)) -> lift . void $ getNtfNTFWorker True c ntfServer
+        _ -> pure () -- err "NSCDelete - no subscription"
     NSCSmpDelete -> do
-      (cErrs, rqs) <- lift $ partitionErrs id connIds' <$> withStoreBatch c (\db -> map (getQueue db) connIds')
-      logInfo $ "processNtfCmd, NSCSmpDelete - length rqs = " <> tshow (length rqs)
-      (cErrs', _) <- lift $ partitionErrs qConnId rqs <$> withStoreBatch' c (\db -> map (updateAction db) rqs)
-      notifyErrs c (cErrs <> cErrs')
-      kickSMPWorkers rqs
-      where
-        getQueue :: DB.Connection -> ConnId -> IO (Either AgentErrorType RcvQueue)
-        getQueue db connId = first storeError <$> getPrimaryRcvQueue db connId
-        updateAction :: DB.Connection -> RcvQueue -> IO ()
-        updateAction db rq = supervisorUpdateNtfAction db (qConnId rq) (NSASMP NSASmpDelete)
-    NSCDeleteSub -> void $ lift $ withStoreBatch' c $ \db -> map (deleteNtfSubscription' db) connIds'
-  where
-    kickSMPWorkers :: [RcvQueue] -> AM ()
-    kickSMPWorkers rqs = do
-      let smpServers = S.fromList $ map qServer rqs
-      lift $ mapM_ (getNtfSMPWorker True c) smpServers
+      withStore' c (`getPrimaryRcvQueue` connId) >>= \case
+        Right rq@RcvQueue {server = smpServer} -> do
+          logInfo $ "processNtfSub, NSCSmpDelete - rq = " <> tshow rq
+          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NSASMP NSASmpDelete)
+          lift . void $ getNtfSMPWorker True c smpServer
+        _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
+    NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
+    NSCNtfSMPWorker smpServer -> lift . void $ getNtfSMPWorker True c smpServer
 
 getNtfNTFWorker :: Bool -> AgentClient -> NtfServer -> AM' Worker
 getNtfNTFWorker hasWork c server = do
@@ -198,11 +143,6 @@ getNtfSMPWorker hasWork c server = do
   ws <- asks $ ntfSMPWorkers . ntfSupervisor
   getAgentWorker "ntf_smp" hasWork c server ws $ runNtfSMPWorker c server
 
-getNtfTknDelWorker :: Bool -> AgentClient -> NtfServer -> AM' Worker
-getNtfTknDelWorker hasWork c server = do
-  ws <- asks $ ntfTknDelWorkers . ntfSupervisor
-  getAgentWorker "ntf_tkn_del" hasWork c server ws $ runNtfTknDelWorker c server
-
 withTokenServer :: (NtfServer -> AM ()) -> AM ()
 withTokenServer action = lift getNtfToken >>= mapM_ (\NtfToken {ntfServer} -> action ntfServer)
 
@@ -213,288 +153,153 @@ runNtfWorker c srv Worker {doWork} =
     ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
   where
     runNtfOperation :: AM ()
-    runNtfOperation = do
-      ntfBatchSize <- asks $ ntfBatchSize . config
-      withWorkItems c doWork (\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
-        if null creates && null checks && null deletes && null rotates
-          then
-            let (_, _, firstActionTs) = L.head nextSubs
-             in lift $ rescheduleWork doWork currTs firstActionTs
-          else do
-            retrySubActions c creates createSubs
-            retrySubActions c checks checkSubs
-            retrySubActions c deletes deleteSubs
-            retrySubActions c rotates rotateSubs
-    splitActions :: UTCTime -> NonEmpty (NtfSubNTFAction, NtfSubscription, NtfActionTs) -> ([NtfSubscription], [NtfSubscription], [NtfSubscription], [NtfSubscription])
-    splitActions currTs = foldr addAction ([], [], [], [])
+    runNtfOperation =
+      withWork c doWork (`getNextNtfSubNTFAction` srv) $
+        \nextSub@(NtfSubscription {connId}, _, _) -> do
+          logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
+          ri <- asks $ reconnectInterval . config
+          withRetryInterval ri $ \_ loop -> do
+            liftIO $ waitWhileSuspended c
+            liftIO $ waitForUserNetwork c
+            processSub nextSub
+              `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
+    processSub :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> AM ()
+    processSub (sub@NtfSubscription {userId, connId, smpServer, ntfSubId}, action, actionTs) = do
+      ts <- liftIO getCurrentTime
+      unlessM (lift $ rescheduleAction doWork ts actionTs) $
+        case action of
+          NSACreate ->
+            lift getNtfToken >>= \case
+              Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+                RcvQueue {clientNtfCreds} <- withStore c (`getPrimaryRcvQueue` connId)
+                case clientNtfCreds of
+                  Just ClientNtfCreds {ntfPrivateKey, notifierId} -> do
+                    atomically $ incNtfServerStat c userId ntfServer ntfCreateAttempts
+                    nSubId <- agentNtfCreateSubscription c tknId tkn (SMPQueueNtf smpServer notifierId) ntfPrivateKey
+                    atomically $ incNtfServerStat c userId ntfServer ntfCreated
+                    -- possible improvement: smaller retry until Active, less frequently (daily?) once Active
+                    let actionTs' = addUTCTime 30 ts
+                    withStore' c $ \db ->
+                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) actionTs'
+                  _ -> workerInternalError c connId "NSACreate - no notifier queue credentials"
+              _ -> workerInternalError c connId "NSACreate - no active token"
+          NSACheck ->
+            lift getNtfToken >>= \case
+              Just tkn@NtfToken {ntfServer} ->
+                case ntfSubId of
+                  Just nSubId -> do
+                    atomically $ incNtfServerStat c userId ntfServer ntfCheckAttempts
+                    agentNtfCheckSubscription c nSubId tkn >>= \case
+                      NSAuth -> do
+                        withStore' c $ \db ->
+                          updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
+                        ns <- asks ntfSupervisor
+                        atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+                      status -> updateSubNextCheck ts status
+                    atomically $ incNtfServerStat c userId ntfServer ntfChecked
+                  Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
+              _ -> workerInternalError c connId "NSACheck - no active token"
+          NSADelete ->
+            deleteNtfSub $ do
+              let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
+              withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
+              ns <- asks ntfSupervisor
+              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+          NSARotate ->
+            deleteNtfSub $ do
+              withStore' c $ \db -> deleteNtfSubscription db connId
+              ns <- asks ntfSupervisor
+              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
       where
-        addAction (cmd, sub, ts) acc@(creates, checks, deletes, rotates) = case cmd of
-          NSACreate -> (sub : creates, checks, deletes, rotates)
-          NSACheck
-            | ts <= currTs -> (creates, sub : checks, deletes, rotates)
-            | otherwise -> acc
-          NSADelete -> (creates, checks, sub : deletes, rotates)
-          NSARotate -> (creates, checks, deletes, sub : rotates)
-    createSubs :: [NtfSubscription] -> AM' [NtfSubscription]
-    createSubs ntfSubs =
-      getNtfToken >>= \case
-        Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
-          subsRqs_ <- zip ntfSubs <$> withStoreBatch c (\db -> map (getQueue db) ntfSubs)
-          let (errs1, subs_, newSubs_) = splitSubs tknId subsRqs_
-          incStatByUserId ntfServer ntfCreateAttempts subs_
-          case (L.nonEmpty subs_, L.nonEmpty newSubs_) of
-            (Just subs, Just newSubs) -> do
-              rs <- L.zip subs <$> agentNtfCreateSubscriptions c tkn newSubs
-              let (ntfSubs', errs2, nSubIds) = splitResults $ L.toList rs
-                  subs' = map fst nSubIds
-                  errs2' = map (first ntfSubConnId) errs2
-              incStatByUserId ntfServer ntfCreated subs'
-              ts <- liftIO getCurrentTime
-              int <- asks $ ntfSubFirstCheckInterval . config
-              let checkTs = addUTCTime int ts
-              (errs3, _) <- partitionErrs ntfSubConnId subs' <$> withStoreBatch' c (\db -> map (updateSubNSACheck db checkTs) nSubIds)
-              workerErrors c $ errs1 <> errs2' <> errs3
-              pure ntfSubs'
-            _ -> workerErrors c errs1 $> []
-        _ -> do
-          let errs = map (\sub -> (ntfSubConnId sub, INTERNAL "NSACreate - no active token")) ntfSubs
-          workerErrors c errs
-          pure []
-      where
-        getQueue :: DB.Connection -> NtfSubscription -> IO (Either AgentErrorType RcvQueue)
-        getQueue db NtfSubscription {connId} = first storeError <$> getPrimaryRcvQueue db connId
-        splitSubs :: NtfTokenId -> [(NtfSubscription, Either AgentErrorType RcvQueue)] -> ([(ConnId, AgentErrorType)], [NtfSubscription], [NewNtfEntity 'Subscription])
-        splitSubs tknId = foldr splitSub ([], [], [])
-          where
-            splitSub (sub, rq) (errs, subs, newSubs) = case rq of
-              Right RcvQueue {clientNtfCreds = Just creds} -> (errs, sub : subs, toNewSub sub creds : newSubs)
-              Right _ -> ((ntfSubConnId sub, INTERNAL "NSACreate - no notifier queue credentials") : errs, subs, newSubs)
-              Left e -> ((ntfSubConnId sub, e) : errs, subs, newSubs)
-            toNewSub NtfSubscription {smpServer} ClientNtfCreds {ntfPrivateKey, notifierId} =
-              NewNtfSub tknId (SMPQueueNtf smpServer notifierId) ntfPrivateKey
-        updateSubNSACheck :: DB.Connection -> UTCTime -> (NtfSubscription, NtfSubscriptionId) -> IO ()
-        updateSubNSACheck db checkTs (sub, nSubId) = updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) checkTs
-    checkSubs :: [NtfSubscription] -> AM' [NtfSubscription]
-    checkSubs ntfSubs =
-      getNtfToken >>= \case
-        Just tkn@NtfToken {ntfServer, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
-          let (errs1, subs_, subIds_) = splitSubs ntfSubs
-          incStatByUserId ntfServer ntfCheckAttempts subs_
-          case (L.nonEmpty subs_, L.nonEmpty subIds_) of
-            (Just subs, Just subIds) -> do
-              rs <- L.zip subs <$> agentNtfCheckSubscriptions c tkn subIds
-              let (ntfSubs', errs2, nSubStatuses) = splitResults $ L.toList rs
-                  subs' = map fst nSubStatuses
-                  (errs2', authSubs) = partitionEithers $ map (\case (sub, NTF _ SMP.AUTH) -> Right sub; e -> Left $ first ntfSubConnId e) errs2
-              incStatByUserId ntfServer ntfChecked subs'
-              ts <- liftIO getCurrentTime
-              int <- asks $ ntfSubCheckInterval . config
-              let nextCheckTs = addUTCTime int ts
-              (errs3, srvs) <- partitionErrs ntfSubConnId subs' <$> withStoreBatch' c (\db -> map (updateSub db ntfServer ts nextCheckTs) nSubStatuses)
-              (errs4, srvs') <- partitionErrs ntfSubConnId authSubs <$> withStoreBatch' c (\db -> map (recreateNtfSub db ntfServer ts) authSubs)
-              mapM_ (getNtfSMPWorker True c) $ S.fromList (catMaybes srvs <> srvs')
-              workerErrors c $ errs1 <> errs2' <> errs3 <> errs4
-              pure ntfSubs'
-            _ -> workerErrors c errs1 $> []
-        _ -> do
-          let errs = map (\sub -> (ntfSubConnId sub, INTERNAL "NSACheck - no active token")) ntfSubs
-          workerErrors c errs
-          pure []
-      where
-        splitSubs :: [NtfSubscription] -> ([(ConnId, AgentErrorType)], [NtfSubscription], [NtfSubscriptionId])
-        splitSubs = foldr splitSub ([], [], [])
-          where
-            splitSub sub (errs, subs, subIds) = case sub of
-              NtfSubscription {ntfSubId = Just subId} -> (errs, sub : subs, subId : subIds)
-              _ -> ((ntfSubConnId sub, INTERNAL "NSACheck - no subscription ID") : errs, subs, subIds)
-        updateSub :: DB.Connection -> NtfServer -> UTCTime -> UTCTime -> (NtfSubscription, NtfSubStatus) -> IO (Maybe SMPServer)
-        updateSub db ntfServer ts nextCheckTs (sub, status)
-          | ntfShouldSubscribe status =
-              let sub' = sub {ntfSubStatus = NASCreated status}
-               in Nothing <$ updateNtfSubscription db sub' (NSANtf NSACheck) nextCheckTs
-          -- ntf server stopped subscribing to this queue
-          | otherwise = Just <$> recreateNtfSub db ntfServer ts sub
-        recreateNtfSub :: DB.Connection -> NtfServer -> UTCTime -> NtfSubscription -> IO SMPServer
-        recreateNtfSub db ntfServer ts sub@NtfSubscription {smpServer} =
-          let sub' = sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew}
-           in smpServer <$ updateNtfSubscription db sub' (NSASMP NSASmpKey) ts
-    incStatByUserId :: NtfServer -> (AgentNtfServerStats -> TVar Int) -> [NtfSubscription] -> AM' ()
-    incStatByUserId ntfServer sel ss =
-      forM_ (M.assocs userIdsCounts) $ \(userId, count) ->
-        atomically $ incNtfServerStat' c userId ntfServer sel count
-      where
-        userIdsCounts = foldl' (\acc NtfSubscription {userId} -> M.insertWith (+) userId 1 acc) M.empty ss
-    -- NSADelete and NSARotate are deprecated, but their processing is kept for legacy db records;
-    -- These actions are not batched
-    deleteSubs :: [NtfSubscription] -> AM' [NtfSubscription]
-    deleteSubs ntfSubs = do
-      retrySubs_ <- mapM (runCatching deleteSub) ntfSubs
-      pure $ catMaybes retrySubs_
-      where
-        deleteSub :: NtfSubscription -> AM (Maybe NtfSubscription)
-        deleteSub sub@NtfSubscription {smpServer} =
-          deleteNtfSub sub $ do
-            let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
-            ts <- liftIO getCurrentTime
-            withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
-            lift . void $ getNtfSMPWorker True c smpServer
-    rotateSubs :: [NtfSubscription] -> AM' [NtfSubscription]
-    rotateSubs ntfSubs = do
-      retrySubs_ <- mapM (runCatching rotateSub) ntfSubs
-      pure $ catMaybes retrySubs_
-      where
-        rotateSub :: NtfSubscription -> AM (Maybe NtfSubscription)
-        rotateSub sub@NtfSubscription {connId} =
-          deleteNtfSub sub $ do
-            withStore' c $ \db -> deleteNtfSubscription db connId
-            ns <- asks ntfSupervisor
-            atomically $ writeTBQueue (ntfSubQ ns) (NSCCreate, [connId])
-    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)
-    -- 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
-      Just nSubId ->
-        lift getNtfToken >>= \case
-          Just tkn@NtfToken {ntfServer} -> do
-            atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
-            tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
-              Right _ -> do
+        deleteNtfSub continue = case ntfSubId of
+          Just nSubId ->
+            lift getNtfToken >>= \case
+              Just tkn@NtfToken {ntfServer} -> do
+                atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
+                tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
+                  Left e | temporaryOrHostError e -> throwE e
+                  _ -> continue
                 atomically $ incNtfServerStat c userId ntfServer ntfDeleted
-                continue'
-              Left e
-                | temporaryOrHostError e -> pure $ Just sub -- don't continue, retry
-                | otherwise -> continue'
-          Nothing -> continue'
-      _ -> continue'
-      where
-        continue' = continue $> Nothing -- continue without retry
+              Nothing -> continue
+          _ -> continue
+        updateSubNextCheck ts toStatus = do
+          checkInterval <- asks $ ntfSubCheckInterval . config
+          let nextCheckTs = addUTCTime checkInterval ts
+          updateSub (NASCreated toStatus) (NSANtf NSACheck) nextCheckTs
+        updateSub toStatus toAction actionTs' =
+          withStore' c $ \db ->
+            updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'
 
 runNtfSMPWorker :: AgentClient -> SMPServer -> Worker -> AM ()
-runNtfSMPWorker c srv Worker {doWork} = forever $ do
-  waitForWork doWork
-  ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfSMPOperation
+runNtfSMPWorker c srv Worker {doWork} = do
+  env <- ask
+  forever $ do
+    waitForWork doWork
+    ExceptT . liftIO . agentOperationBracket c AONtfNetwork throwWhenInactive $
+      runReaderT (runExceptT runNtfSMPOperation) env
   where
-    runNtfSMPOperation :: AM ()
-    runNtfSMPOperation = do
-      ntfBatchSize <- asks $ ntfBatchSize . config
-      withWorkItems c doWork (\db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
-        logInfo $ "runNtfSMPWorker - length nextSubs = " <> tshow (length nextSubs)
-        let (creates, deletes) = splitActions nextSubs
-        retrySubActions c creates createNotifierKeys
-        retrySubActions c deletes deleteNotifierKeys
-    splitActions :: NonEmpty (NtfSubSMPAction, NtfSubscription) -> ([NtfSubscription], [NtfSubscription])
-    splitActions = foldr addAction ([], [])
-      where
-        addAction (cmd, sub) (creates, deletes) = case cmd of
-          NSASmpKey -> (sub : creates, deletes)
-          NSASmpDelete -> (creates, sub : deletes)
-    createNotifierKeys :: [NtfSubscription] -> AM' [NtfSubscription]
-    createNotifierKeys ntfSubs =
-      getNtfToken >>= \case
-        Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
-          (errs1, subRqKeys) <- prepareQueueSmpKey ntfSubs
-          rs <- enableQueuesNtfs c subRqKeys
-          let (subRqKeys', errs2, successes) = splitResults rs
-              ntfSubs' = map eqnrNtfSub subRqKeys'
-              errs2' = map (first (qConnId . eqnrRq)) errs2
-          ts <- liftIO getCurrentTime
-          (errs3, srvs) <- partitionErrs (qConnId . eqnrRq . fst) successes <$> withStoreBatch' c (\db -> map (storeNtfSubCreds db ts) successes)
-          mapM_ (getNtfNTFWorker True c) $ S.fromList srvs
-          workerErrors c $ errs1 <> errs2' <> errs3
-          pure ntfSubs'
-        _ -> do
-          let errs = map (\sub -> (ntfSubConnId sub, INTERNAL "NSASmpKey - no active token")) ntfSubs
-          workerErrors c errs
-          pure []
-      where
-        prepareQueueSmpKey :: [NtfSubscription] -> AM' ([(ConnId, AgentErrorType)], [EnableQueueNtfReq])
-        prepareQueueSmpKey subs = do
-          alg <- asks (rcvAuthAlg . config)
-          g <- asks random
-          partitionErrs ntfSubConnId subs <$> withStoreBatch c (\db -> map (getQueue db alg g) subs)
-          where
-            getQueue :: DB.Connection -> C.AuthAlg -> TVar ChaChaDRG -> NtfSubscription -> IO (Either AgentErrorType EnableQueueNtfReq)
-            getQueue db (C.AuthAlg a) g sub = fmap (first storeError) $ runExceptT $ do
-              rq <- ExceptT $ getPrimaryRcvQueue db (ntfSubConnId sub)
-              authKeyPair <- atomically $ C.generateAuthKeyPair a g
-              rcvNtfKeyPair <- atomically $ C.generateKeyPair g
-              pure (EnableQueueNtfReq sub rq authKeyPair rcvNtfKeyPair)
-        storeNtfSubCreds :: DB.Connection -> UTCTime -> (EnableQueueNtfReq, (SMP.NotifierId, SMP.RcvNtfPublicDhKey)) -> IO NtfServer
-        storeNtfSubCreds db ts (EnableQueueNtfReq {eqnrNtfSub, eqnrAuthKeyPair = (ntfPublicKey, ntfPrivateKey), eqnrRcvKeyPair = (_, pk)}, (notifierId, srvPubDhKey)) = do
-          let NtfSubscription {ntfServer} = eqnrNtfSub
-              rcvNtfDhSecret = C.dh' srvPubDhKey pk
-          setRcvQueueNtfCreds db (ntfSubConnId eqnrNtfSub) $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
-          updateNtfSubscription db eqnrNtfSub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
-          pure ntfServer
-    deleteNotifierKeys :: [NtfSubscription] -> AM' [NtfSubscription]
-    deleteNotifierKeys ntfSubs = do
-      (errs1, subRqs) <- partitionErrs ntfSubConnId ntfSubs <$> withStoreBatch c (\db -> map (resetCredsGetQueue db) ntfSubs)
-      rs <- disableQueuesNtfs c subRqs
-      let (subRqs', errs2, successes) = splitResults rs
-          ntfSubs' = map fst subRqs'
-          errs2' = map (first (qConnId . snd)) errs2
-          disabledRqs = map (snd . fst) successes
-      (errs3, _) <- partitionErrs qConnId disabledRqs <$> withStoreBatch' c (\db -> map (deleteSub db) disabledRqs)
-      workerErrors c $ errs1 <> errs2' <> errs3
-      pure ntfSubs'
-      where
-        resetCredsGetQueue :: DB.Connection -> NtfSubscription -> IO (Either AgentErrorType DisableQueueNtfReq)
-        resetCredsGetQueue db sub@NtfSubscription {connId} = fmap (first storeError) $ runExceptT $ do
-          liftIO $ setRcvQueueNtfCreds db connId Nothing
-          rq <- ExceptT $ getPrimaryRcvQueue db connId
-          pure (sub, rq)
-        deleteSub :: DB.Connection -> RcvQueue -> IO ()
-        deleteSub db rq = deleteNtfSubscription db (qConnId rq)
+    runNtfSMPOperation =
+      withWork c doWork (`getNextNtfSubSMPAction` srv) $
+        \nextSub@(NtfSubscription {connId}, _, _) -> do
+          logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
+          ri <- asks $ reconnectInterval . config
+          withRetryInterval ri $ \_ loop -> do
+            liftIO $ waitWhileSuspended c
+            liftIO $ waitForUserNetwork c
+            processSub nextSub
+              `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
+    processSub :: (NtfSubscription, NtfSubSMPAction, NtfActionTs) -> AM ()
+    processSub (sub@NtfSubscription {connId, ntfServer}, smpAction, actionTs) = do
+      ts <- liftIO getCurrentTime
+      unlessM (lift $ rescheduleAction doWork ts actionTs) $
+        case smpAction of
+          NSASmpKey ->
+            lift getNtfToken >>= \case
+              Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+                rq <- withStore c (`getPrimaryRcvQueue` connId)
+                C.AuthAlg a <- asks (rcvAuthAlg . config)
+                g <- asks random
+                (ntfPublicKey, ntfPrivateKey) <- atomically $ C.generateAuthKeyPair a g
+                (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
+                (notifierId, rcvNtfSrvPubDhKey) <- enableQueueNotifications c rq ntfPublicKey rcvNtfPubDhKey
+                let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
+                withStore' c $ \db -> do
+                  setRcvQueueNtfCreds db connId $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
+                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
+                ns <- asks ntfSupervisor
+                atomically $ sendNtfSubCommand ns (connId, NSCNtfWorker ntfServer)
+              _ -> workerInternalError c connId "NSASmpKey - no active token"
+          NSASmpDelete -> do
+            -- TODO should we remove it after successful removal from the server?
+            rq_ <- withStore' c $ \db -> do
+              setRcvQueueNtfCreds db connId Nothing
+              getPrimaryRcvQueue db connId
+            mapM_ (disableQueueNotifications c) rq_
+            withStore' c $ \db -> deleteNtfSubscription db connId
 
-retrySubActions :: AgentClient -> [NtfSubscription] -> ([NtfSubscription] -> AM' [NtfSubscription]) -> AM ()
-retrySubActions _ [] _ = pure ()
-retrySubActions c subs action = do
-  v <- newTVarIO subs
-  ri <- asks $ reconnectInterval . config
-  withRetryInterval ri $ \_ loop -> do
-    liftIO $ waitWhileSuspended c
-    liftIO $ waitForUserNetwork c
-    subs' <- readTVarIO v
-    retrySubs <- lift $ action subs'
-    unless (null retrySubs) $ do
-      atomically $ writeTVar v retrySubs
-      retryNetworkLoop c loop
+rescheduleAction :: TMVar () -> UTCTime -> UTCTime -> AM' Bool
+rescheduleAction doWork ts actionTs
+  | actionTs <= ts = pure False
+  | otherwise = do
+      void . atomically $ tryTakeTMVar doWork
+      void . forkIO $ do
+        liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime actionTs ts
+        atomically $ hasWorkToDo' doWork
+      pure True
 
---                                                (temporary errs, other errs, successes)
-splitResults :: [(a, Either AgentErrorType r)] -> ([a], [(a, AgentErrorType)], [(a, r)])
-splitResults = foldr addRes ([], [], [])
+retryOnError :: AgentClient -> Text -> AM () -> (AgentErrorType -> AM ()) -> AgentErrorType -> AM ()
+retryOnError c name loop done e = do
+  logError $ name <> " error: " <> tshow e
+  case e of
+    BROKER _ NETWORK -> retryLoop
+    BROKER _ TIMEOUT -> retryLoop
+    _ -> done e
   where
-    addRes (a, r_) (as, errs, rs) = case r_ of
-      Right r -> (as, errs, (a, r) : rs)
-      Left e
-        | temporaryOrHostError e -> (a : as, errs, rs)
-        | otherwise -> (as, (a, e) : errs, rs)
-
-rescheduleWork :: TMVar () -> UTCTime -> UTCTime -> AM' ()
-rescheduleWork doWork ts actionTs = do
-  void . atomically $ tryTakeTMVar doWork
-  void . forkIO $ do
-    liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime actionTs ts
-    atomically $ hasWorkToDo' doWork
-
-retryNetworkLoop :: AgentClient -> AM () -> AM ()
-retryNetworkLoop c loop = do
-  atomically $ endAgentOperation c AONtfNetwork
-  liftIO $ throwWhenInactive c
-  atomically $ beginAgentOperation c AONtfNetwork
-  loop
-
-workerErrors :: AgentClient -> [(ConnId, AgentErrorType)] -> AM' ()
-workerErrors c connErrs =
-  unless (null connErrs) $ do
-    void $ withStoreBatch' c (\db -> map (setNullNtfSubscriptionAction db . fst) connErrs)
-    notifyErrs c connErrs
+    retryLoop = do
+      atomically $ endAgentOperation c AONtfNetwork
+      liftIO $ throwWhenInactive c
+      atomically $ beginAgentOperation c AONtfNetwork
+      loop
 
 workerInternalError :: AgentClient -> ConnId -> String -> AM ()
 workerInternalError c connId internalErrStr = do
@@ -506,14 +311,6 @@ notifyInternalError :: MonadIO m => AgentClient -> ConnId -> String -> m ()
 notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
 {-# INLINE notifyInternalError #-}
 
-notifyInternalError' :: MonadIO m => AgentClient -> String -> m ()
-notifyInternalError' AgentClient {subQ} internalErrStr = atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
-{-# INLINE notifyInternalError' #-}
-
-notifyErrs :: MonadIO m => AgentClient -> [(ConnId, AgentErrorType)] -> m ()
-notifyErrs AgentClient {subQ} connErrs = unless (null connErrs) $ atomically $ writeTBQueue subQ ("", "", AEvt SAENone $ ERRS connErrs)
-{-# INLINE notifyErrs #-}
-
 getNtfToken :: AM' (Maybe NtfToken)
 getNtfToken = do
   tkn <- asks $ ntfTkn . ntfSupervisor
@@ -525,7 +322,7 @@ nsUpdateToken ns tkn = writeTVar (ntfTkn ns) $ Just tkn
 nsRemoveNtfToken :: NtfSupervisor -> STM ()
 nsRemoveNtfToken ns = writeTVar (ntfTkn ns) Nothing
 
-sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> STM ()
+sendNtfSubCommand :: NtfSupervisor -> (ConnId, NtfSupervisorCommand) -> STM ()
 sendNtfSubCommand ns cmd = do
   tkn <- readTVar (ntfTkn ns)
   when (instantNotifications tkn) $ writeTBQueue (ntfSubQ ns) cmd
@@ -535,51 +332,10 @@ instantNotifications = \case
   Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> True
   _ -> False
 
-deleteToken :: AgentClient -> NtfToken -> AM ()
-deleteToken c tkn@NtfToken {ntfServer, ntfTokenId, ntfPrivKey} = do
-  setToDelete <- withStore' c $ \db -> do
-    removeNtfToken db tkn
-    case ntfTokenId of
-      Just tknId -> addNtfTokenToDelete db ntfServer ntfPrivKey tknId $> True
-      Nothing -> pure False
-  ns <- asks ntfSupervisor
-  atomically $ nsRemoveNtfToken ns
-  when setToDelete $ void $ lift $ getNtfTknDelWorker True c ntfServer
-
-runNtfTknDelWorker :: AgentClient -> NtfServer -> Worker -> AM ()
-runNtfTknDelWorker c srv Worker {doWork} =
-  forever $ do
-    waitForWork doWork
-    ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
-  where
-    runNtfOperation :: AM ()
-    runNtfOperation =
-      withWork c doWork (`getNextNtfTokenToDelete` srv) $
-        \nextTknToDelete -> do
-          logInfo $ "runNtfTknDelWorker, nextTknToDelete " <> tshow nextTknToDelete
-          ri <- asks $ reconnectInterval . config
-          withRetryInterval ri $ \_ loop -> do
-            liftIO $ waitWhileSuspended c
-            liftIO $ waitForUserNetwork c
-            processTknToDelete nextTknToDelete `catchAgentError` retryTmpError loop nextTknToDelete
-    retryTmpError :: AM () -> NtfTokenToDelete -> AgentErrorType -> AM ()
-    retryTmpError loop (tknDbId, _, _) e = do
-      logError $ "ntf tkn del error: " <> tshow e
-      if temporaryOrHostError e
-        then retryNetworkLoop c loop
-        else do
-          withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
-          notifyInternalError' c (show e)
-    processTknToDelete :: NtfTokenToDelete -> AM ()
-    processTknToDelete (tknDbId, ntfPrivKey, tknId) = do
-      agentNtfDeleteToken c srv ntfPrivKey tknId
-      withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
-
 closeNtfSupervisor :: NtfSupervisor -> IO ()
 closeNtfSupervisor ns = do
   stopWorkers $ ntfWorkers ns
   stopWorkers $ ntfSMPWorkers ns
-  stopWorkers $ ntfTknDelWorkers ns
   where
     stopWorkers workers = atomically (swapTVar workers M.empty) >>= mapM_ (liftIO . cancelWorker)
 

src/Simplex/Messaging/Agent/Protocol.hs

@@ -108,7 +108,6 @@ module Simplex.Messaging.Agent.Protocol
     ConnReqUriData (..),
     CRClientData,
     ServiceScheme,
-    sameConnReqContact,
     simplexChat,
     connReqUriP',
     AgentErrorType (..),
@@ -140,7 +139,6 @@ module Simplex.Messaging.Agent.Protocol
     serializeQueueStatus,
     queueStatusT,
     agentMessageType,
-    aMessageType,
     extraSMPServerHosts,
     updateSMPServerHosts,
   )
@@ -168,7 +166,8 @@ import Data.Time.Clock.System (SystemTime)
 import Data.Type.Equality
 import Data.Typeable ()
 import Data.Word (Word16, Word32)
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
+import Database.SQLite.Simple.FromField
+import Database.SQLite.Simple.ToField
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Transport (XFTPErrorType)
@@ -199,6 +198,7 @@ import Simplex.Messaging.Protocol
     NMsgMeta,
     ProtocolServer (..),
     SMPClientVersion,
+    SMPMsgMeta,
     SMPServer,
     SMPServerWithAuth,
     SndPublicAuthKey,
@@ -277,14 +277,14 @@ supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPA
 e2eEncConnInfoLength :: VersionSMPA -> PQSupport -> Int
 e2eEncConnInfoLength v = \case
   -- reduced by 3726 (roughly the increase of message ratchet header size + key and ciphertext in reply link)
-  PQSupportOn | v >= pqdrSMPAgentVersion -> 11106
-  _ -> 14832
+  PQSupportOn | v >= pqdrSMPAgentVersion -> 11122
+  _ -> 14848
 
 e2eEncAgentMsgLength :: VersionSMPA -> PQSupport -> Int
 e2eEncAgentMsgLength v = \case
   -- reduced by 2222 (the increase of message ratchet header size)
-  PQSupportOn | v >= pqdrSMPAgentVersion -> 13618
-  _ -> 15840
+  PQSupportOn | v >= pqdrSMPAgentVersion -> 13634
+  _ -> 15856
 
 -- | SMP agent event
 type ATransmission = (ACorrId, AEntityId, AEvt)
@@ -344,7 +344,6 @@ data AEvent (e :: AEntity) where
   INFO :: PQSupport -> ConnInfo -> AEvent AEConn
   CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
   END :: AEvent AEConn
-  DELD :: AEvent AEConn
   CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
   DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone
   DOWN :: SMPServer -> [ConnId] -> AEvent AENone
@@ -356,17 +355,16 @@ data AEvent (e :: AEntity) where
   MERR :: AgentMsgId -> AgentErrorType -> AEvent AEConn
   MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> AEvent AEConn
   MSG :: MsgMeta -> MsgFlags -> MsgBody -> AEvent AEConn
-  MSGNTF :: MsgId -> Maybe UTCTime -> AEvent AEConn
+  MSGNTF :: SMPMsgMeta -> AEvent AEConn
   RCVD :: MsgMeta -> NonEmpty MsgReceipt -> AEvent AEConn
   QCONT :: AEvent AEConn
-  DEL_RCVQS :: NonEmpty (ConnId, SMPServer, SMP.RecipientId, Maybe AgentErrorType) -> AEvent AEConn
-  DEL_CONNS :: NonEmpty ConnId -> AEvent AEConn
+  DEL_RCVQ :: SMPServer -> SMP.RecipientId -> Maybe AgentErrorType -> AEvent AEConn
+  DEL_CONN :: AEvent AEConn
   DEL_USER :: Int64 -> AEvent AENone
   STAT :: ConnectionStats -> AEvent AEConn
   OK :: AEvent AEConn
   JOINED :: SndQueueSecured -> AEvent AEConn
   ERR :: AgentErrorType -> AEvent AEConn
-  ERRS :: [(ConnId, AgentErrorType)] -> AEvent AENone
   SUSPENDED :: AEvent AENone
   RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
   RFDONE :: FilePath -> AEvent AERcvFile
@@ -415,7 +413,6 @@ data AEventTag (e :: AEntity) where
   INFO_ :: AEventTag AEConn
   CON_ :: AEventTag AEConn
   END_ :: AEventTag AEConn
-  DELD_ :: AEventTag AEConn
   CONNECT_ :: AEventTag AENone
   DISCONNECT_ :: AEventTag AENone
   DOWN_ :: AEventTag AENone
@@ -430,14 +427,13 @@ data AEventTag (e :: AEntity) where
   MSGNTF_ :: AEventTag AEConn
   RCVD_ :: AEventTag AEConn
   QCONT_ :: AEventTag AEConn
-  DEL_RCVQS_ :: AEventTag AEConn
-  DEL_CONNS_ :: AEventTag AEConn
+  DEL_RCVQ_ :: AEventTag AEConn
+  DEL_CONN_ :: AEventTag AEConn
   DEL_USER_ :: AEventTag AENone
   STAT_ :: AEventTag AEConn
   OK_ :: AEventTag AEConn
   JOINED_ :: AEventTag AEConn
   ERR_ :: AEventTag AEConn
-  ERRS_ :: AEventTag AENone
   SUSPENDED_ :: AEventTag AENone
   -- XFTP commands and responses
   RFDONE_ :: AEventTag AERcvFile
@@ -470,7 +466,6 @@ aEventTag = \case
   INFO {} -> INFO_
   CON _ -> CON_
   END -> END_
-  DELD -> DELD_
   CONNECT {} -> CONNECT_
   DISCONNECT {} -> DISCONNECT_
   DOWN {} -> DOWN_
@@ -485,14 +480,13 @@ aEventTag = \case
   MSGNTF {} -> MSGNTF_
   RCVD {} -> RCVD_
   QCONT -> QCONT_
-  DEL_RCVQS _ -> DEL_RCVQS_
-  DEL_CONNS _ -> DEL_CONNS_
+  DEL_RCVQ {} -> DEL_RCVQ_
+  DEL_CONN -> DEL_CONN_
   DEL_USER _ -> DEL_USER_
   STAT _ -> STAT_
   OK -> OK_
   JOINED _ -> JOINED_
   ERR _ -> ERR_
-  ERRS _ -> ERRS_
   SUSPENDED -> SUSPENDED_
   RFPROG {} -> RFPROG_
   RFDONE {} -> RFDONE_
@@ -856,7 +850,20 @@ agentMessageType = \case
   AgentConnInfo _ -> AM_CONN_INFO
   AgentConnInfoReply {} -> AM_CONN_INFO_REPLY
   AgentRatchetInfo _ -> AM_RATCHET_INFO
-  AgentMessage _ aMsg -> aMessageType aMsg
+  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_
 
 data APrivHeader = APrivHeader
   { -- | sequential ID assigned by the sending agent
@@ -934,22 +941,6 @@ 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
@@ -1014,10 +1005,6 @@ 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)
@@ -1271,12 +1258,6 @@ instance Eq AConnectionRequestUri where
 
 deriving instance Show AConnectionRequestUri
 
-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')
-
 data ConnReqUriData = ConnReqUriData
   { crScheme :: ServiceScheme,
     crAgentVRange :: VersionRangeSMPA,

src/Simplex/Messaging/Agent/Stats.hs

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

src/Simplex/Messaging/Agent/Store.hs

@@ -29,12 +29,8 @@ import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
-import Simplex.Messaging.Agent.Store.Common
-import Simplex.Messaging.Agent.Store.Interface (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 (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448)
+import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport, RatchetX448)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
   ( MsgBody,
@@ -46,16 +42,13 @@ import Simplex.Messaging.Protocol
     RcvDhSecret,
     RcvNtfDhSecret,
     RcvPrivateAuthKey,
-    SenderCanSecure,
     SndPrivateAuthKey,
     SndPublicAuthKey,
+    SenderCanSecure,
     VersionSMPC,
   )
 import qualified Simplex.Messaging.Protocol as SMP
 
-createStore :: DBOpts -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-createStore dbOpts = createDBStore dbOpts appMigrations
-
 -- * Queue types
 
 data QueueStored = QSStored | QSNew
@@ -543,17 +536,9 @@ data SndMsgData = SndMsgData
     msgBody :: MsgBody,
     pqEncryption :: PQEncryption,
     internalHash :: MsgHash,
-    prevMsgHash :: MsgHash,
-    sndMsgPrepData_ :: Maybe SndMsgPrepData
+    prevMsgHash :: MsgHash
   }
 
-data SndMsgPrepData = SndMsgPrepData
-  { encryptKey :: MsgEncryptKeyX448,
-    paddedLen :: Int,
-    sndMsgBodyId :: Int64
-  }
-  deriving (Show)
-
 data SndMsg = SndMsg
   { internalId :: InternalId,
     internalSndId :: InternalSndId,
@@ -569,17 +554,7 @@ data PendingMsgData = PendingMsgData
     msgBody :: MsgBody,
     pqEncryption :: PQEncryption,
     msgRetryState :: Maybe RI2State,
-    internalTs :: InternalTs,
-    internalSndId :: InternalSndId,
-    prevMsgHash :: PrevSndMsgHash,
-    pendingMsgPrepData_ :: Maybe PendingMsgPrepData
-  }
-  deriving (Show)
-
-data PendingMsgPrepData = PendingMsgPrepData
-  { encryptKey :: MsgEncryptKeyX448,
-    paddedLen :: Int,
-    sndMsgBody :: AMessage
+    internalTs :: InternalTs
   }
   deriving (Show)
 
@@ -648,7 +623,7 @@ data StoreError
   | -- | Confirmation not found.
     SEConfirmationNotFound
   | -- | Invitation not found
-    SEInvitationNotFound String InvitationId
+    SEInvitationNotFound
   | -- | Message not found
     SEMsgNotFound
   | -- | Command not found

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

@@ -1,14 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Simplex.Messaging.Agent.Store.Common
-#if defined(dbPostgres)
-  ( module Simplex.Messaging.Agent.Store.Postgres.Common,
-  )
-  where
-import Simplex.Messaging.Agent.Store.Postgres.Common
-#else
-  ( module Simplex.Messaging.Agent.Store.SQLite.Common,
-  )
-  where
-import Simplex.Messaging.Agent.Store.SQLite.Common
-#endif

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

@@ -1,18 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Simplex.Messaging.Agent.Store.DB
-#if defined(dbPostgres)
-  ( module Simplex.Messaging.Agent.Store.Postgres.DB,
-    FromField (..),
-    ToField (..),
-  )
-  where
-import Simplex.Messaging.Agent.Store.Postgres.DB
-#else
-  ( module Simplex.Messaging.Agent.Store.SQLite.DB,
-    FromField (..),
-    ToField (..),
-  )
-  where
-import Simplex.Messaging.Agent.Store.SQLite.DB
-#endif

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

@@ -1,14 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module Simplex.Messaging.Agent.Store.Interface
-#if defined(dbPostgres)
-  ( module Simplex.Messaging.Agent.Store.Postgres,
-  )
-  where
-import Simplex.Messaging.Agent.Store.Postgres
-#else
-  ( module Simplex.Messaging.Agent.Store.SQLite,
-  )
-  where
-import Simplex.Messaging.Agent.Store.SQLite
-#endif

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

@@ -1,78 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-
-module Simplex.Messaging.Agent.Store.Migrations
-  ( Migration (..),
-    MigrationsToRun (..),
-    DownMigration (..),
-    DBMigrate (..),
-    sharedMigrateSchema,
-    -- for tests
-    migrationsToRun,
-    toDownMigration,
-  )
-where
-
-import Control.Monad
-import Data.Char (toLower)
-import Data.Functor (($>))
-import Data.Maybe (isNothing, mapMaybe)
-import Simplex.Messaging.Agent.Store.Shared
-import System.Exit (exitFailure)
-import System.IO (hFlush, stdout)
-
-migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
-migrationsToRun [] [] = Right MTRNone
-migrationsToRun appMs [] = Right $ MTRUp appMs
-migrationsToRun [] dbMs
-  | length dms == length dbMs = Right $ MTRDown dms
-  | otherwise = Left $ MTRENoDown $ mapMaybe nameNoDown dbMs
-  where
-    dms = mapMaybe toDownMigration dbMs
-    nameNoDown m = if isNothing (down m) then Just $ name m else Nothing
-migrationsToRun (a : as) (d : ds)
-  | name a == name d = migrationsToRun as ds
-  | otherwise = Left $ MTREDifferent (name a) (name d)
-
-data DBMigrate = DBMigrate
-  { initialize :: IO (),
-    getCurrent :: IO [Migration],
-    run :: MigrationsToRun -> IO (),
-    backup :: IO ()
-  }
-
-sharedMigrateSchema :: DBMigrate -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ())
-sharedMigrateSchema dbm dbNew' migrations confirmMigrations = do
-  initialize dbm
-  currentMs <- getCurrent dbm
-  case migrationsToRun migrations currentMs of
-    Left e -> do
-      when (confirmMigrations == MCConsole) $ confirmOrExit ("Database state error: " <> mtrErrorDescription e)
-      pure . Left $ MigrationError e
-    Right MTRNone -> pure $ Right ()
-    Right ms@(MTRUp ums)
-      | dbNew' -> run dbm ms $> Right ()
-      | otherwise -> case confirmMigrations of
-          MCYesUp -> runWithBackup ms
-          MCYesUpDown -> runWithBackup ms
-          MCConsole -> confirm err >> runWithBackup ms
-          MCError -> pure $ Left err
-      where
-        err = MEUpgrade $ map upMigration ums -- "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map name ums)
-    Right ms@(MTRDown dms) -> case confirmMigrations of
-      MCYesUpDown -> runWithBackup ms
-      MCConsole -> confirm err >> runWithBackup ms
-      MCYesUp -> pure $ Left err
-      MCError -> pure $ Left err
-      where
-        err = MEDowngrade $ map downName dms
-  where
-    runWithBackup ms = backup dbm >> run dbm ms $> Right ()
-    confirm err = confirmOrExit $ migrationErrorDescription err
-
-confirmOrExit :: String -> IO ()
-confirmOrExit s = do
-  putStrLn s
-  putStr "Continue (y/N): "
-  hFlush stdout
-  ok <- getLine
-  when (map toLower ok /= "y") exitFailure

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

@@ -1,14 +0,0 @@
-{-# 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

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

@@ -1,128 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Agent.Store.Postgres
-  ( DBOpts (..),
-    Migrations.getCurrentMigrations,
-    checkSchemaExists,
-    createDBStore,
-    closeDBStore,
-    reopenDBStore,
-    execSQL,
-  )
-where
-
-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.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 (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, safeDecodeUtf8)
-import System.Exit (exitFailure)
-import UnliftIO.MVar
-
--- | 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.
-createDBStore :: DBOpts -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError DBStore)
-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 :: DBOpts -> IO DBStore
-connectPostgresStore DBOpts {connstr, schema, poolSize, createSchema} = do
-  dbSem <- newMVar ()
-  dbPool <- newTBQueueIO poolSize
-  dbClosed <- newTVarIO True
-  let st = DBStore {dbConnstr = connstr, dbSchema = schema, dbPoolSize = fromIntegral poolSize, dbPool, dbSem, dbNew = False, dbClosed}
-  dbNew <- connectPool st createSchema
-  pure st {dbNew}
-
--- 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).
-connectPool :: DBStore -> Bool -> IO Bool
-connectPool DBStore {dbConnstr, dbSchema, dbPoolSize, dbPool, dbClosed} createSchema = uninterruptibleMask_ $ do
-  (conn, dbNew) <- connectDB dbConnstr dbSchema createSchema -- TODO [postgres] analogue for dbBusyLoop?
-  conns <- replicateM (dbPoolSize - 1) $ fst <$> connectDB dbConnstr dbSchema False
-  mapM_ (atomically . writeTBQueue dbPool) (conn : conns)
-  atomically $ writeTVar dbClosed False
-  pure dbNew
-
-connectDB :: ByteString -> ByteString -> Bool -> IO (DB.Connection, Bool)
-connectDB connstr schema createSchema = do
-  db <- PSQL.connectPostgreSQL connstr
-  dbNew <- prepare db `onException` PSQL.close db
-  pure (db, dbNew)
-  where
-    prepare db = do
-      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
-      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
-
-closeDBStore :: DBStore -> IO ()
-closeDBStore DBStore {dbPool, dbPoolSize, dbClosed} =
-  ifM (readTVarIO dbClosed) (putStrLn "closeDBStore: already closed") $ uninterruptibleMask_ $ do
-    replicateM_ dbPoolSize $ atomically (readTBQueue dbPool) >>= DB.close
-    atomically $ writeTVar dbClosed True
-
-reopenDBStore :: DBStore -> IO ()
-reopenDBStore st =
-  ifM
-    (readTVarIO $ dbClosed st)
-    (void $ connectPool st False)
-    (putStrLn "reopenDBStore: already opened")
-
--- not used with postgres client (used for ExecAgentStoreSQL, ExecChatStoreSQL)
-execSQL :: PSQL.Connection -> Text -> IO [Text]
-execSQL _db _query = throwIO (userError "not implemented")

src/Simplex/Messaging/Agent/Store/Postgres/Common.hs

@@ -1,64 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TupleSections #-}
-
-module Simplex.Messaging.Agent.Store.Postgres.Common
-  ( DBStore (..),
-    DBOpts (..),
-    withConnection,
-    withConnection',
-    withTransaction,
-    withTransaction',
-    withTransactionPriority,
-  )
-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 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 :: ByteString,
-    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
-  }
-
-withConnectionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
-withConnectionPriority DBStore {dbPool, dbSem} _priority =
-  bracket
-    (withMVar dbSem $ \_ -> atomically $ readTBQueue dbPool)
-    (atomically . writeTBQueue dbPool)
-
-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
-{-# INLINE withTransaction #-}
-
--- TODO [postgres] analogue for dbBusyLoop?
-withTransactionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
-withTransactionPriority st priority action = withConnectionPriority st priority transaction
-  where
-    transaction conn = PSQL.withTransaction conn $ action conn

src/Simplex/Messaging/Agent/Store/Postgres/DB.hs

@@ -1,89 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Agent.Store.Postgres.DB
-  ( BoolInt (..),
-    PSQL.Binary (..),
-    PSQL.Connection,
-    FromField (..),
-    ToField (..),
-    PSQL.connect,
-    PSQL.close,
-    execute,
-    execute_,
-    executeMany,
-    PSQL.query,
-    PSQL.query_,
-    blobFieldDecoder,
-    fromTextField_,
-  )
-where
-
-import Control.Monad (void)
-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 (Field (..), FieldParser, FromField (..), returnError)
-import Database.PostgreSQL.Simple.ToField (ToField (..))
-import Database.PostgreSQL.Simple.TypeInfo.Static (textOid, varcharOid)
-
-newtype BoolInt = BI {unBI :: Bool}
-
-instance FromField BoolInt where
-  fromField field dat = BI . (/= (0 :: Int)) <$> fromField field dat
-  {-# INLINE fromField #-}
-
-instance ToField BoolInt where
-  toField (BI b) = toField ((if b then 1 else 0) :: Int)
-  {-# INLINE toField #-}
-
-execute :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> q -> IO ()
-execute db q qs = void $ PSQL.execute db q qs
-{-# INLINE execute #-}
-
-execute_ :: PSQL.Connection -> PSQL.Query -> IO ()
-execute_ db q = void $ PSQL.execute_ db q
-{-# INLINE execute_ #-}
-
-executeMany :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> [q] -> IO ()
-executeMany db q qs = void $ PSQL.executeMany db q qs
-{-# INLINE executeMany #-}
-
--- orphan instances
-
--- used in FileSize
-instance FromField Word32 where
-  fromField field dat = do
-    i :: Int64 <- fromField field dat
-    if i >= 0 && i <= fromIntegral (maxBound :: Word32)
-      then pure (fromIntegral i :: Word32)
-      else returnError ConversionFailed field "Negative value can't be converted to Word32"
-
--- used in Version
-instance FromField Word16 where
-  fromField field dat = do
-    i :: Int64 <- fromField field dat
-    if i >= 0 && i <= fromIntegral (maxBound :: Word16)
-      then pure (fromIntegral i :: Word16)
-      else returnError ConversionFailed field "Negative value can't be converted to Word16"
-
-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"

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

@@ -1,68 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TupleSections #-}
-
-module Simplex.Messaging.Agent.Store.Postgres.Migrations
-  ( initialize,
-    run,
-    getCurrentMigrations,
-  )
-where
-
-import Control.Exception (throwIO)
-import Control.Monad (void)
-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)
-import qualified Database.PostgreSQL.LibPQ as LibPQ
-import Database.PostgreSQL.Simple (Only (..))
-import qualified Database.PostgreSQL.Simple as PSQL
-import Database.PostgreSQL.Simple.Internal (Connection (..))
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Simplex.Messaging.Agent.Store.Postgres.Common
-import Simplex.Messaging.Agent.Store.Shared
-import Simplex.Messaging.Util (($>>=))
-import UnliftIO.MVar
-
-initialize :: DBStore -> IO ()
-initialize st = withTransaction' st $ \db ->
-  void $
-    PSQL.execute_
-      db
-      [sql|
-      CREATE TABLE IF NOT EXISTS migrations (
-        name TEXT NOT NULL,
-        ts TIMESTAMP NOT NULL,
-        down TEXT,
-        PRIMARY KEY (name)
-      )
-    |]
-
-run :: DBStore -> MigrationsToRun -> IO ()
-run st = \case
-  MTRUp [] -> pure ()
-  MTRUp ms -> mapM_ runUp ms
-  MTRDown ms -> mapM_ runDown $ reverse ms
-  MTRNone -> pure ()
-  where
-    runUp Migration {name, up, down} = withTransaction' st $ \db -> do
-      insert db
-      execSQL db up
-      where
-        insert db = void $ PSQL.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
-    runDown DownMigration {downName, downQuery} = withTransaction' st $ \db -> do
-      execSQL db downQuery
-      void $ PSQL.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
-    execSQL db query =
-      withMVar (connectionHandle db) $ \pqConn ->
-        LibPQ.exec pqConn (TE.encodeUtf8 query) $>>= LibPQ.resultErrorMessage >>= \case
-          Just e | not (B.null e) -> throwIO $ userError $ B.unpack e
-          _ -> pure ()
-
-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}

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs

@@ -1,21 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
-module Simplex.Messaging.Agent.Store.Postgres.Migrations.App (appMigrations) where
-
-import Data.List (sortOn)
-import Data.Text (Text)
-import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
-import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
-import Simplex.Messaging.Agent.Store.Shared (Migration (..))
-
-schemaMigrations :: [(String, Text, Maybe Text)]
-schemaMigrations =
-  [ ("20241210_initial", m20241210_initial, Nothing),
-    ("20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies)
-  ]
-
--- | The list of migrations in ascending order by date
-appMigrations :: [Migration]
-appMigrations = sortOn name $ map migration schemaMigrations
-  where
-    migration (name, up, down) = Migration {name, up, down = down}

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20241210_initial.hs

@@ -1,545 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Text.RawString.QQ (r)
-
-m20241210_initial :: Text
-m20241210_initial =
-  T.pack
-    [r|
-CREATE TABLE users(
-  user_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  deleted SMALLINT NOT NULL DEFAULT 0
-);
-CREATE TABLE servers(
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  key_hash BYTEA NOT NULL,
-  PRIMARY KEY(host, port)
-);
-CREATE TABLE connections(
-  conn_id BYTEA NOT NULL PRIMARY KEY,
-  conn_mode TEXT NOT NULL,
-  last_internal_msg_id BIGINT NOT NULL DEFAULT 0,
-  last_internal_rcv_msg_id BIGINT NOT NULL DEFAULT 0,
-  last_internal_snd_msg_id BIGINT NOT NULL DEFAULT 0,
-  last_external_snd_msg_id BIGINT NOT NULL DEFAULT 0,
-  last_rcv_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
-  last_snd_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
-  smp_agent_version INTEGER NOT NULL DEFAULT 1,
-  duplex_handshake SMALLINT NULL DEFAULT 0,
-  enable_ntfs SMALLINT,
-  deleted SMALLINT NOT NULL DEFAULT 0,
-  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
-  ratchet_sync_state TEXT NOT NULL DEFAULT 'ok',
-  deleted_at_wait_delivery TIMESTAMPTZ,
-  pq_support SMALLINT NOT NULL DEFAULT 0
-);
-CREATE TABLE rcv_queues(
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  rcv_id BYTEA NOT NULL,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  rcv_private_key BYTEA NOT NULL,
-  rcv_dh_secret BYTEA NOT NULL,
-  e2e_priv_key BYTEA NOT NULL,
-  e2e_dh_secret BYTEA,
-  snd_id BYTEA NOT NULL,
-  snd_key BYTEA,
-  status TEXT NOT NULL,
-  smp_server_version INTEGER NOT NULL DEFAULT 1,
-  smp_client_version INTEGER,
-  ntf_public_key BYTEA,
-  ntf_private_key BYTEA,
-  ntf_id BYTEA,
-  rcv_ntf_dh_secret BYTEA,
-  rcv_queue_id BIGINT NOT NULL,
-  rcv_primary SMALLINT NOT NULL,
-  replace_rcv_queue_id BIGINT NULL,
-  delete_errors BIGINT NOT NULL DEFAULT 0,
-  server_key_hash BYTEA,
-  switch_status TEXT,
-  deleted SMALLINT NOT NULL DEFAULT 0,
-  snd_secure SMALLINT NOT NULL DEFAULT 0,
-  last_broker_ts TIMESTAMPTZ,
-  PRIMARY KEY(host, port, rcv_id),
-  FOREIGN KEY(host, port) REFERENCES servers
-  ON DELETE RESTRICT ON UPDATE CASCADE,
-  UNIQUE(host, port, snd_id)
-);
-CREATE TABLE snd_queues(
-  host TEXT NOT NULL,
-  port TEXT NOT NULL,
-  snd_id BYTEA NOT NULL,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  snd_private_key BYTEA NOT NULL,
-  e2e_dh_secret BYTEA NOT NULL,
-  status TEXT NOT NULL,
-  smp_server_version INTEGER NOT NULL DEFAULT 1,
-  smp_client_version INTEGER NOT NULL DEFAULT 1,
-  snd_public_key BYTEA,
-  e2e_pub_key BYTEA,
-  snd_queue_id BIGINT NOT NULL,
-  snd_primary SMALLINT NOT NULL,
-  replace_snd_queue_id BIGINT NULL,
-  server_key_hash BYTEA,
-  switch_status TEXT,
-  snd_secure SMALLINT NOT NULL DEFAULT 0,
-  PRIMARY KEY(host, port, snd_id),
-  FOREIGN KEY(host, port) REFERENCES servers
-  ON DELETE RESTRICT ON UPDATE CASCADE
-);
-CREATE TABLE messages(
-  conn_id BYTEA NOT NULL REFERENCES connections(conn_id)
-  ON DELETE CASCADE,
-  internal_id BIGINT NOT NULL,
-  internal_ts TIMESTAMPTZ NOT NULL,
-  internal_rcv_id BIGINT,
-  internal_snd_id BIGINT,
-  msg_type BYTEA NOT NULL,
-  msg_body BYTEA NOT NULL DEFAULT ''::BYTEA,
-  msg_flags TEXT NULL,
-  pq_encryption SMALLINT NOT NULL DEFAULT 0,
-  PRIMARY KEY(conn_id, internal_id)
-);
-CREATE TABLE rcv_messages(
-  conn_id BYTEA NOT NULL,
-  internal_rcv_id BIGINT NOT NULL,
-  internal_id BIGINT NOT NULL,
-  external_snd_id BIGINT NOT NULL,
-  broker_id BYTEA NOT NULL,
-  broker_ts TIMESTAMPTZ NOT NULL,
-  internal_hash BYTEA NOT NULL,
-  external_prev_snd_hash BYTEA NOT NULL,
-  integrity BYTEA NOT NULL,
-  user_ack SMALLINT NULL DEFAULT 0,
-  rcv_queue_id BIGINT NOT NULL,
-  PRIMARY KEY(conn_id, internal_rcv_id),
-  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
-  ON DELETE CASCADE
-);
-ALTER TABLE messages
-ADD CONSTRAINT fk_messages_rcv_messages
-  FOREIGN KEY (conn_id, internal_rcv_id) REFERENCES rcv_messages
-  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
-CREATE TABLE snd_messages(
-  conn_id BYTEA NOT NULL,
-  internal_snd_id BIGINT NOT NULL,
-  internal_id BIGINT NOT NULL,
-  internal_hash BYTEA NOT NULL,
-  previous_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
-  retry_int_slow BIGINT,
-  retry_int_fast BIGINT,
-  rcpt_internal_id BIGINT,
-  rcpt_status TEXT,
-  PRIMARY KEY(conn_id, internal_snd_id),
-  FOREIGN KEY(conn_id, internal_id) REFERENCES messages
-  ON DELETE CASCADE
-);
-ALTER TABLE messages
-ADD CONSTRAINT fk_messages_snd_messages
-  FOREIGN KEY (conn_id, internal_snd_id) REFERENCES snd_messages
-  ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
-CREATE TABLE conn_confirmations(
-  confirmation_id BYTEA NOT NULL PRIMARY KEY,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  e2e_snd_pub_key BYTEA NOT NULL,
-  sender_key BYTEA,
-  ratchet_state BYTEA NOT NULL,
-  sender_conn_info BYTEA NOT NULL,
-  accepted SMALLINT NOT NULL,
-  own_conn_info BYTEA,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  smp_reply_queues BYTEA NULL,
-  smp_client_version INTEGER
-);
-CREATE TABLE conn_invitations(
-  invitation_id BYTEA NOT NULL PRIMARY KEY,
-  contact_conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  cr_invitation BYTEA NOT NULL,
-  recipient_conn_info BYTEA NOT NULL,
-  accepted SMALLINT NOT NULL DEFAULT 0,
-  own_conn_info BYTEA,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE ratchets(
-  conn_id BYTEA NOT NULL PRIMARY KEY REFERENCES connections
-  ON DELETE CASCADE,
-  x3dh_priv_key_1 BYTEA,
-  x3dh_priv_key_2 BYTEA,
-  ratchet_state BYTEA,
-  e2e_version INTEGER NOT NULL DEFAULT 1,
-  x3dh_pub_key_1 BYTEA,
-  x3dh_pub_key_2 BYTEA,
-  pq_priv_kem BYTEA,
-  pq_pub_kem BYTEA
-);
-CREATE TABLE skipped_messages(
-  skipped_message_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  conn_id BYTEA NOT NULL REFERENCES ratchets
-  ON DELETE CASCADE,
-  header_key BYTEA NOT NULL,
-  msg_n BIGINT NOT NULL,
-  msg_key BYTEA NOT NULL
-);
-CREATE TABLE ntf_servers(
-  ntf_host TEXT NOT NULL,
-  ntf_port TEXT NOT NULL,
-  ntf_key_hash BYTEA NOT NULL,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  PRIMARY KEY(ntf_host, ntf_port)
-);
-CREATE TABLE ntf_tokens(
-  provider TEXT NOT NULL,
-  device_token TEXT NOT NULL,
-  ntf_host TEXT NOT NULL,
-  ntf_port TEXT NOT NULL,
-  tkn_id BYTEA,
-  tkn_pub_key BYTEA NOT NULL,
-  tkn_priv_key BYTEA NOT NULL,
-  tkn_pub_dh_key BYTEA NOT NULL,
-  tkn_priv_dh_key BYTEA NOT NULL,
-  tkn_dh_secret BYTEA,
-  tkn_status TEXT NOT NULL,
-  tkn_action BYTEA,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  ntf_mode BYTEA NULL,
-  PRIMARY KEY(provider, device_token, ntf_host, ntf_port),
-  FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
-  ON DELETE RESTRICT ON UPDATE CASCADE
-);
-CREATE TABLE ntf_subscriptions(
-  conn_id BYTEA NOT NULL,
-  smp_host TEXT NULL,
-  smp_port TEXT NULL,
-  smp_ntf_id BYTEA,
-  ntf_host TEXT NOT NULL,
-  ntf_port TEXT NOT NULL,
-  ntf_sub_id BYTEA,
-  ntf_sub_status TEXT NOT NULL,
-  ntf_sub_action BYTEA,
-  ntf_sub_smp_action BYTEA,
-  ntf_sub_action_ts TIMESTAMPTZ,
-  updated_by_supervisor SMALLINT NOT NULL DEFAULT 0,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  smp_server_key_hash BYTEA,
-  ntf_failed SMALLINT DEFAULT 0,
-  smp_failed SMALLINT DEFAULT 0,
-  PRIMARY KEY(conn_id),
-  FOREIGN KEY(smp_host, smp_port) REFERENCES servers(host, port)
-  ON DELETE SET NULL ON UPDATE CASCADE,
-  FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
-  ON DELETE RESTRICT ON UPDATE CASCADE
-);
-CREATE TABLE commands(
-  command_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  host TEXT,
-  port TEXT,
-  corr_id BYTEA NOT NULL,
-  command_tag BYTEA NOT NULL,
-  command BYTEA NOT NULL,
-  agent_version INTEGER NOT NULL DEFAULT 1,
-  server_key_hash BYTEA,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT '1970-01-01 00:00:00',
-  failed SMALLINT DEFAULT 0,
-  FOREIGN KEY(host, port) REFERENCES servers
-  ON DELETE RESTRICT ON UPDATE CASCADE
-);
-CREATE TABLE snd_message_deliveries(
-  snd_message_delivery_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  snd_queue_id BIGINT NOT NULL,
-  internal_id BIGINT NOT NULL,
-  failed SMALLINT DEFAULT 0,
-  FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
-);
-CREATE TABLE xftp_servers(
-  xftp_server_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  xftp_host TEXT NOT NULL,
-  xftp_port TEXT NOT NULL,
-  xftp_key_hash BYTEA NOT NULL,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  UNIQUE(xftp_host, xftp_port, xftp_key_hash)
-);
-CREATE TABLE rcv_files(
-  rcv_file_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  rcv_file_entity_id BYTEA NOT NULL,
-  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
-  size BIGINT NOT NULL,
-  digest BYTEA NOT NULL,
-  key BYTEA NOT NULL,
-  nonce BYTEA NOT NULL,
-  chunk_size BIGINT NOT NULL,
-  prefix_path TEXT NOT NULL,
-  tmp_path TEXT,
-  save_path TEXT NOT NULL,
-  status TEXT NOT NULL,
-  deleted SMALLINT NOT NULL DEFAULT 0,
-  error TEXT,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  save_file_key BYTEA,
-  save_file_nonce BYTEA,
-  failed SMALLINT DEFAULT 0,
-  redirect_id BIGINT REFERENCES rcv_files ON DELETE SET NULL,
-  redirect_entity_id BYTEA,
-  redirect_size BIGINT,
-  redirect_digest BYTEA,
-  approved_relays SMALLINT NOT NULL DEFAULT 0,
-  UNIQUE(rcv_file_entity_id)
-);
-CREATE TABLE rcv_file_chunks(
-  rcv_file_chunk_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  rcv_file_id BIGINT NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
-  chunk_no BIGINT NOT NULL,
-  chunk_size BIGINT NOT NULL,
-  digest BYTEA NOT NULL,
-  tmp_path TEXT,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE rcv_file_chunk_replicas(
-  rcv_file_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  rcv_file_chunk_id BIGINT NOT NULL REFERENCES rcv_file_chunks ON DELETE CASCADE,
-  replica_number BIGINT NOT NULL,
-  xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
-  replica_id BYTEA NOT NULL,
-  replica_key BYTEA NOT NULL,
-  received SMALLINT NOT NULL DEFAULT 0,
-  delay BIGINT,
-  retries BIGINT NOT NULL DEFAULT 0,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE snd_files(
-  snd_file_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  snd_file_entity_id BYTEA NOT NULL,
-  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
-  num_recipients BIGINT NOT NULL,
-  digest BYTEA,
-  key BYTEA NOT NUll,
-  nonce BYTEA NOT NUll,
-  path TEXT NOT NULL,
-  prefix_path TEXT,
-  status TEXT NOT NULL,
-  deleted SMALLINT NOT NULL DEFAULT 0,
-  error TEXT,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  src_file_key BYTEA,
-  src_file_nonce BYTEA,
-  failed SMALLINT DEFAULT 0,
-  redirect_size BIGINT,
-  redirect_digest BYTEA
-);
-CREATE TABLE snd_file_chunks(
-  snd_file_chunk_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  snd_file_id BIGINT NOT NULL REFERENCES snd_files ON DELETE CASCADE,
-  chunk_no BIGINT NOT NULL,
-  chunk_offset BIGINT NOT NULL,
-  chunk_size BIGINT NOT NULL,
-  digest BYTEA NOT NULL,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE snd_file_chunk_replicas(
-  snd_file_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  snd_file_chunk_id BIGINT NOT NULL REFERENCES snd_file_chunks ON DELETE CASCADE,
-  replica_number BIGINT NOT NULL,
-  xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
-  replica_id BYTEA NOT NULL,
-  replica_key BYTEA NOT NULL,
-  replica_status TEXT NOT NULL,
-  delay BIGINT,
-  retries BIGINT NOT NULL DEFAULT 0,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE snd_file_chunk_replica_recipients(
-  snd_file_chunk_replica_recipient_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  snd_file_chunk_replica_id BIGINT NOT NULL REFERENCES snd_file_chunk_replicas ON DELETE CASCADE,
-  rcv_replica_id BYTEA NOT NULL,
-  rcv_replica_key BYTEA NOT NULL,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE deleted_snd_chunk_replicas(
-  deleted_snd_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
-  xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
-  replica_id BYTEA NOT NULL,
-  replica_key BYTEA NOT NULL,
-  chunk_digest BYTEA NOT NULL,
-  delay BIGINT,
-  retries BIGINT NOT NULL DEFAULT 0,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  failed SMALLINT DEFAULT 0
-);
-CREATE TABLE encrypted_rcv_message_hashes(
-  encrypted_rcv_message_hash_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  hash BYTEA NOT NULL,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE processed_ratchet_key_hashes(
-  processed_ratchet_key_hash_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
-  hash BYTEA NOT NULL,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE TABLE servers_stats(
-  servers_stats_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  servers_stats TEXT,
-  started_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
-  updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-INSERT INTO servers_stats DEFAULT VALUES;
-CREATE TABLE ntf_tokens_to_delete(
-  ntf_token_to_delete_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
-  ntf_host TEXT NOT NULL,
-  ntf_port TEXT NOT NULL,
-  ntf_key_hash BYTEA NOT NULL,
-  tkn_id BYTEA NOT NULL,
-  tkn_priv_key BYTEA NOT NULL,
-  del_failed SMALLINT DEFAULT 0,
-  created_at TIMESTAMPTZ NOT NULL DEFAULT (now())
-);
-CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
-CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
-CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
-CREATE INDEX idx_snd_message_deliveries ON snd_message_deliveries(
-  conn_id,
-  snd_queue_id
-);
-CREATE INDEX idx_connections_user ON connections(user_id);
-CREATE INDEX idx_commands_conn_id ON commands(conn_id);
-CREATE INDEX idx_commands_host_port ON commands(host, port);
-CREATE INDEX idx_conn_confirmations_conn_id ON conn_confirmations(conn_id);
-CREATE INDEX idx_conn_invitations_contact_conn_id ON conn_invitations(
-  contact_conn_id
-);
-CREATE INDEX idx_messages_conn_id_internal_snd_id ON messages(
-  conn_id,
-  internal_snd_id
-);
-CREATE INDEX idx_messages_conn_id_internal_rcv_id ON messages(
-  conn_id,
-  internal_rcv_id
-);
-CREATE INDEX idx_messages_conn_id ON messages(conn_id);
-CREATE INDEX idx_ntf_subscriptions_ntf_host_ntf_port ON ntf_subscriptions(
-  ntf_host,
-  ntf_port
-);
-CREATE INDEX idx_ntf_subscriptions_smp_host_smp_port ON ntf_subscriptions(
-  smp_host,
-  smp_port
-);
-CREATE INDEX idx_ntf_tokens_ntf_host_ntf_port ON ntf_tokens(
-  ntf_host,
-  ntf_port
-);
-CREATE INDEX idx_ratchets_conn_id ON ratchets(conn_id);
-CREATE INDEX idx_rcv_messages_conn_id_internal_id ON rcv_messages(
-  conn_id,
-  internal_id
-);
-CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
-CREATE INDEX idx_snd_message_deliveries_conn_id_internal_id ON snd_message_deliveries(
-  conn_id,
-  internal_id
-);
-CREATE INDEX idx_snd_messages_conn_id_internal_id ON snd_messages(
-  conn_id,
-  internal_id
-);
-CREATE INDEX idx_snd_queues_host_port ON snd_queues(host, port);
-CREATE INDEX idx_rcv_files_user_id ON rcv_files(user_id);
-CREATE INDEX idx_rcv_file_chunks_rcv_file_id ON rcv_file_chunks(rcv_file_id);
-CREATE INDEX idx_rcv_file_chunk_replicas_rcv_file_chunk_id ON rcv_file_chunk_replicas(
-  rcv_file_chunk_id
-);
-CREATE INDEX idx_rcv_file_chunk_replicas_xftp_server_id ON rcv_file_chunk_replicas(
-  xftp_server_id
-);
-CREATE INDEX idx_snd_files_user_id ON snd_files(user_id);
-CREATE INDEX idx_snd_file_chunks_snd_file_id ON snd_file_chunks(snd_file_id);
-CREATE INDEX idx_snd_file_chunk_replicas_snd_file_chunk_id ON snd_file_chunk_replicas(
-  snd_file_chunk_id
-);
-CREATE INDEX idx_snd_file_chunk_replicas_xftp_server_id ON snd_file_chunk_replicas(
-  xftp_server_id
-);
-CREATE INDEX idx_snd_file_chunk_replica_recipients_snd_file_chunk_replica_id ON snd_file_chunk_replica_recipients(
-  snd_file_chunk_replica_id
-);
-CREATE INDEX idx_deleted_snd_chunk_replicas_user_id ON deleted_snd_chunk_replicas(
-  user_id
-);
-CREATE INDEX idx_deleted_snd_chunk_replicas_xftp_server_id ON deleted_snd_chunk_replicas(
-  xftp_server_id
-);
-CREATE INDEX idx_rcv_file_chunk_replicas_pending ON rcv_file_chunk_replicas(
-  received,
-  replica_number
-);
-CREATE INDEX idx_snd_file_chunk_replicas_pending ON snd_file_chunk_replicas(
-  replica_status,
-  replica_number
-);
-CREATE INDEX idx_deleted_snd_chunk_replicas_pending ON deleted_snd_chunk_replicas(
-  created_at
-);
-CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hashes(
-  conn_id,
-  hash
-);
-CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
-  conn_id,
-  hash
-);
-CREATE INDEX idx_snd_messages_rcpt_internal_id ON snd_messages(
-  conn_id,
-  rcpt_internal_id
-);
-CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON processed_ratchet_key_hashes(
-  created_at
-);
-CREATE INDEX idx_encrypted_rcv_message_hashes_created_at ON encrypted_rcv_message_hashes(
-  created_at
-);
-CREATE INDEX idx_messages_internal_ts ON messages(internal_ts);
-CREATE INDEX idx_commands_server_commands ON commands(
-  host,
-  port,
-  created_at,
-  command_id
-);
-CREATE INDEX idx_rcv_files_status_created_at ON rcv_files(status, created_at);
-CREATE INDEX idx_snd_files_status_created_at ON snd_files(status, created_at);
-CREATE INDEX idx_snd_files_snd_file_entity_id ON snd_files(snd_file_entity_id);
-CREATE INDEX idx_messages_snd_expired ON messages(
-  conn_id,
-  internal_snd_id,
-  internal_ts
-);
-CREATE INDEX idx_snd_message_deliveries_expired ON snd_message_deliveries(
-  conn_id,
-  snd_queue_id,
-  failed,
-  internal_id
-);
-CREATE INDEX idx_rcv_files_redirect_id on rcv_files(redirect_id);
-|]

src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20250203_msg_bodies.hs

@@ -1,37 +0,0 @@
-{-# 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;
-|]

src/Simplex/Messaging/Agent/Store/Postgres/Options.hs

@@ -1,12 +0,0 @@
-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)

src/Simplex/Messaging/Agent/Store/Postgres/Util.hs

@@ -1,100 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Agent.Store.Postgres.Util
-  ( createDBAndUserIfNotExists,
-    dropSchema,
-    dropAllSchemasExceptSystem,
-    dropDatabaseAndUser,
-  )
-where
-
-import Control.Exception (bracket)
-import Control.Monad (forM_, unless, void, when)
-import Data.String (fromString)
-import Database.PostgreSQL.Simple (ConnectInfo (..), Only (..), defaultConnectInfo)
-import qualified Database.PostgreSQL.Simple as PSQL
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-
-createDBAndUserIfNotExists :: ConnectInfo -> IO ()
-createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = dbName} = do
-  -- connect to the default "postgres" maintenance database
-  bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
-    \postgresDB -> do
-      void $ PSQL.execute_ postgresDB "SET client_min_messages TO WARNING"
-      -- check if the user exists, create if not
-      [Only userExists] <-
-        PSQL.query
-          postgresDB
-          [sql|
-            SELECT EXISTS (
-              SELECT 1 FROM pg_catalog.pg_roles
-              WHERE rolname = ?
-            )
-          |]
-          (Only user)
-      unless userExists $ void $ PSQL.execute_ postgresDB (fromString $ "CREATE USER " <> user)
-      -- check if the database exists, create if not
-      dbExists <- checkDBExists postgresDB dbName
-      unless dbExists $ void $ PSQL.execute_ postgresDB (fromString $ "CREATE DATABASE " <> dbName <> " OWNER " <> user)
-
-checkDBExists :: PSQL.Connection -> String -> IO Bool
-checkDBExists postgresDB dbName = do
-  [Only dbExists] <-
-    PSQL.query
-      postgresDB
-      [sql|
-        SELECT EXISTS (
-          SELECT 1 FROM pg_catalog.pg_database
-          WHERE datname = ?
-        )
-      |]
-      (Only dbName)
-  pure dbExists
-
-dropSchema :: ConnectInfo -> String -> IO ()
-dropSchema connectInfo schema =
-  bracket (PSQL.connect connectInfo) PSQL.close $
-    \db -> do
-      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
-      void $ PSQL.execute_ db (fromString $ "DROP SCHEMA IF EXISTS " <> schema <> " CASCADE")
-
-dropAllSchemasExceptSystem :: ConnectInfo -> IO ()
-dropAllSchemasExceptSystem connectInfo =
-  bracket (PSQL.connect connectInfo) PSQL.close $
-    \db -> do
-      void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
-      schemaNames :: [Only String] <-
-        PSQL.query_
-          db
-          [sql|
-            SELECT schema_name
-            FROM information_schema.schemata
-            WHERE schema_name NOT IN ('public', 'pg_catalog', 'information_schema')
-          |]
-      forM_ schemaNames $ \(Only schema) ->
-        PSQL.execute_ db (fromString $ "DROP SCHEMA " <> schema <> " CASCADE")
-
-dropDatabaseAndUser :: ConnectInfo -> IO ()
-dropDatabaseAndUser ConnectInfo {connectUser = user, connectDatabase = dbName} =
-  bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
-    \postgresDB -> do
-      void $ PSQL.execute_ postgresDB "SET client_min_messages TO WARNING"
-      dbExists <- checkDBExists postgresDB dbName
-      when dbExists $ do
-        void $ PSQL.execute_ postgresDB (fromString $ "ALTER DATABASE " <> dbName <> " WITH ALLOW_CONNECTIONS false")
-        -- terminate all connections to the database
-        _r :: [Only Bool] <-
-          PSQL.query
-            postgresDB
-            [sql|
-              SELECT pg_terminate_backend(pg_stat_activity.pid)
-              FROM pg_stat_activity
-              WHERE datname = ?
-                AND pid <> pg_backend_pid()
-            |]
-            (Only dbName)
-        void $ PSQL.execute_ postgresDB (fromString $ "DROP DATABASE " <> dbName)
-      void $ PSQL.execute_ postgresDB (fromString $ "DROP USER IF EXISTS " <> user)

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

@@ -4,8 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.Common
-  ( DBStore (..),
-    DBOpts (..),
+  ( SQLiteStore (..),
     withConnection,
     withConnection',
     withTransaction,
@@ -31,7 +30,7 @@ import UnliftIO.STM
 storeKey :: ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
 storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
 
-data DBStore = DBStore
+data SQLiteStore = SQLiteStore
   { dbFilePath :: FilePath,
     dbKey :: TVar (Maybe ScrubbedBytes),
     dbSem :: TVar Int,
@@ -40,16 +39,8 @@ 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
+withConnectionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
   | priority = E.bracket_ signal release $ withMVar dbConnection action
   | otherwise = lowPriority
   where
@@ -59,20 +50,20 @@ withConnectionPriority DBStore {dbSem, dbConnection} priority action
     wait = unlessM free $ atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
     free = (0 ==) <$> readTVarIO dbSem
 
-withConnection :: DBStore -> (DB.Connection -> IO a) -> IO a
+withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
 withConnection st = withConnectionPriority st False
 
-withConnection' :: DBStore -> (SQL.Connection -> IO a) -> IO a
+withConnection' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withConnection' st action = withConnection st $ action . DB.conn
 
-withTransaction' :: DBStore -> (SQL.Connection -> IO a) -> IO a
+withTransaction' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withTransaction' st action = withTransaction st $ action . DB.conn
 
-withTransaction :: DBStore -> (DB.Connection -> IO a) -> IO a
+withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
 withTransaction st = withTransactionPriority st False
 {-# INLINE withTransaction #-}
 
-withTransactionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withTransactionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
 withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
   where
     transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db

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

@@ -1,69 +1,45 @@
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.DB
-  ( BoolInt (..),
-    Binary (..),
-    Connection (..),
+  ( Connection (..),
     SlowQueryStats (..),
-    TrackQueries (..),
-    FromField (..),
-    ToField (..),
     open,
     close,
     execute,
     execute_,
+    executeNamed,
     executeMany,
     query,
     query_,
-    blobFieldDecoder,
-    fromTextField_,
+    queryNamed,
   )
 where
 
 import Control.Concurrent.STM
-import Control.Exception
 import Control.Monad (when)
+import Control.Exception
 import qualified Data.Aeson.TH as J
-import Data.ByteString (ByteString)
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
-import qualified Data.Text as T
 import Data.Time (diffUTCTime, getCurrentTime)
-import Data.Typeable (Typeable)
-import Database.SQLite.Simple (FromRow, ResultError (..), Query, SQLData (..), ToRow)
+import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
-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)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffToMicroseconds, tshow)
-
-newtype BoolInt = BI {unBI :: Bool}
-  deriving newtype (FromField, ToField)
-
-newtype Binary = Binary {fromBinary :: ByteString}
-  deriving newtype (FromField, ToField)
+import Simplex.Messaging.Util (diffToMilliseconds, tshow)
 
 data Connection = Connection
   { conn :: SQL.Connection,
-    track :: TrackQueries,
     slow :: TMap Query SlowQueryStats
   }
 
-data TrackQueries = TQAll | TQSlow Int64 | TQOff
-  deriving (Eq)
-
 data SlowQueryStats = SlowQueryStats
   { count :: Int64,
     timeMax :: Int64,
@@ -72,29 +48,21 @@ data SlowQueryStats = SlowQueryStats
   }
   deriving (Show)
 
-timeIt :: Connection -> Query -> IO a -> IO a
-timeIt Connection {slow, track} sql a
-  | track == TQOff = makeQuery
-  | otherwise = do
-      t <- getCurrentTime
-      r <- makeQuery
-      t' <- getCurrentTime
-      let diff = diffToMicroseconds $ diffUTCTime t' t
-      when (trackQuery diff) $ atomically $ TM.alter (updateQueryStats diff) sql slow
-      pure r
+timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
+timeIt slow sql a = do
+  t <- getCurrentTime
+  r <- a `catch` \e -> do
+    atomically $ TM.alter (Just . updateQueryErrors e) sql slow
+    throwIO e
+  t' <- getCurrentTime
+  let diff = diffToMilliseconds $ diffUTCTime t' t
+  when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
+  pure r
   where
-    makeQuery =
-      a `catch` \e -> do
-        atomically $ TM.alter (Just . updateQueryErrors e) sql slow
-        throwIO e
-    trackQuery diff = case track of
-      TQOff -> False
-      TQSlow t -> diff > t
-      TQAll -> True
     updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
     updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
-    updateQueryErrors e (Just st@SlowQueryStats {errs}) =
-      st {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
+    updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
+      stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
     updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
     updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
     updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
@@ -106,49 +74,41 @@ timeIt Connection {slow, track} sql a
             errs
           }
 
-open :: String -> TrackQueries -> IO Connection
-open f track = do
+open :: String -> IO Connection
+open f = do
   conn <- SQL.open f
   slow <- TM.emptyIO
-  pure Connection {conn, slow, track}
+  pure Connection {conn, slow}
 
 close :: Connection -> IO ()
 close = SQL.close . conn
 
 execute :: ToRow q => Connection -> Query -> q -> IO ()
-execute c sql = timeIt c sql . SQL.execute (conn c) sql
+execute Connection {conn, slow} sql = timeIt slow sql . SQL.execute conn sql
 {-# INLINE execute #-}
 
 execute_ :: Connection -> Query -> IO ()
-execute_ c sql = timeIt c sql $ SQL.execute_ (conn c) sql
+execute_ Connection {conn, slow} sql = timeIt slow sql $ SQL.execute_ conn sql
 {-# INLINE execute_ #-}
 
+executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
+executeNamed Connection {conn, slow} sql = timeIt slow sql . SQL.executeNamed conn sql
+{-# INLINE executeNamed #-}
+
 executeMany :: ToRow q => Connection -> Query -> [q] -> IO ()
-executeMany c sql = timeIt c sql . SQL.executeMany (conn c) sql
+executeMany Connection {conn, slow} sql = timeIt slow sql . SQL.executeMany conn sql
 {-# INLINE executeMany #-}
 
 query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r]
-query c sql = timeIt c sql . SQL.query (conn c) sql
+query Connection {conn, slow} sql = timeIt slow sql . SQL.query conn sql
 {-# INLINE query #-}
 
 query_ :: FromRow r => Connection -> Query -> IO [r]
-query_ c sql = timeIt c sql $ SQL.query_ (conn c) sql
+query_ Connection {conn, slow} sql = timeIt slow sql $ SQL.query_ conn 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"
+queryNamed :: FromRow r => Connection -> Query -> [NamedParam] -> IO [r]
+queryNamed Connection {conn, slow} sql = timeIt slow sql . SQL.queryNamed conn sql
+{-# INLINE queryNamed #-}
 
 $(J.deriveJSON defaultJSON ''SlowQueryStats)

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

@@ -5,44 +5,138 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Agent.Store.SQLite.Migrations
-  ( initialize,
+  ( Migration (..),
+    MigrationsToRun (..),
+    MTRError (..),
+    DownMigration (..),
+    app,
+    initialize,
+    get,
     run,
-    getCurrentMigrations,
+    getCurrent,
+    mtrErrorDescription,
+    -- for unit tests
+    migrationsToRun,
+    toDownMigration,
   )
 where
 
 import Control.Monad (forM_, when)
+import qualified Data.Aeson.TH as J
+import Data.List (intercalate, sortOn)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
+import Data.Maybe (isNothing, mapMaybe)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (getCurrentTime)
-import Database.SQLite.Simple (Only (..), Query (..))
-import qualified Database.SQLite.Simple as SQL
+import Database.SQLite.Simple (Connection, Only (..), Query (..))
+import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import qualified Database.SQLite3 as SQLite3
 import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
-import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.SQLite.Common
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
-import Simplex.Messaging.Agent.Store.Shared
+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.Encoding.String
+import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
 
-getCurrentMigrations :: DB.Connection -> IO [Migration]
-getCurrentMigrations DB.Connection {DB.conn} = map toMigration <$> SQL.query_ conn "SELECT name, down FROM migrations ORDER BY name ASC;"
+data Migration = Migration {name :: String, up :: Text, down :: Maybe Text}
+  deriving (Eq, Show)
+
+schemaMigrations :: [(String, Query, Maybe Query)]
+schemaMigrations =
+  [ ("20220101_initial", m20220101_initial, Nothing),
+    ("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
+    ("20220322_notifications", m20220322_notifications, Nothing),
+    ("20220607_v2", m20220608_v2, Nothing),
+    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
+    ("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
+    ("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
+    ("m20220905_commands", m20220905_commands, Nothing),
+    ("m20220915_connection_queues", m20220915_connection_queues, Nothing),
+    ("m20230110_users", m20230110_users, Nothing),
+    ("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
+    ("m20230120_delete_errors", m20230120_delete_errors, Nothing),
+    ("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
+    ("m20230223_files", m20230223_files, Just down_m20230223_files),
+    ("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
+    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
+    ("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
+    ("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
+    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
+    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
+    ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
+    ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
+    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
+    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
+    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
+    ("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
+    ("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
+    ("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
+    ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
+    ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
+    ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
+    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
+    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
+    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats)
+  ]
+
+-- | The list of migrations in ascending order by date
+app :: [Migration]
+app = sortOn name $ map migration schemaMigrations
+  where
+    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
+
+get :: SQLiteStore -> [Migration] -> IO (Either MTRError MigrationsToRun)
+get st migrations = migrationsToRun migrations <$> withTransaction' st getCurrent
+
+getCurrent :: Connection -> IO [Migration]
+getCurrent db = map toMigration <$> DB.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
   where
     toMigration (name, down) = Migration {name, up = "", down}
 
-run :: DBStore -> Bool -> MigrationsToRun -> IO ()
-run st vacuum = \case
+run :: SQLiteStore -> MigrationsToRun -> IO ()
+run st = \case
   MTRUp [] -> pure ()
-  MTRUp ms -> do
-    mapM_ runUp ms
-    when vacuum $ withConnection' st (`execSQL` "VACUUM;")
+  MTRUp ms -> mapM_ runUp ms >> withConnection' st (`execSQL` "VACUUM;")
   MTRDown ms -> mapM_ runDown $ reverse ms
   MTRNone -> pure ()
   where
@@ -50,27 +144,27 @@ run st vacuum = \case
       when (name == "m20220811_onion_hosts") $ updateServers db
       insert db >> execSQL db up'
       where
-        insert db = SQL.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
+        insert db = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
         up'
           | dbNew st && name == "m20230110_users" = fromQuery new_m20230110_users
           | otherwise = up
         updateServers db = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
           let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
-           in SQL.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
+           in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
     runDown DownMigration {downName, downQuery} = withTransaction' st $ \db -> do
       execSQL db downQuery
-      SQL.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
-    execSQL db = SQLite3.exec $ SQL.connectionHandle db
+      DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
+    execSQL db = SQLite3.exec $ DB.connectionHandle db
 
-initialize :: DBStore -> IO ()
+initialize :: SQLiteStore -> IO ()
 initialize st = withTransaction' st $ \db -> do
-  cs :: [Text] <- map fromOnly <$> SQL.query_ db "SELECT name FROM pragma_table_info('migrations')"
+  cs :: [Text] <- map fromOnly <$> DB.query_ db "SELECT name FROM pragma_table_info('migrations')"
   case cs of
     [] -> createMigrations db
-    _ -> when ("down" `notElem` cs) $ SQL.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
+    _ -> when ("down" `notElem` cs) $ DB.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
   where
     createMigrations db =
-      SQL.execute_
+      DB.execute_
         db
         [sql|
           CREATE TABLE IF NOT EXISTS migrations (
@@ -80,3 +174,37 @@ initialize st = withTransaction' st $ \db -> do
             PRIMARY KEY (name)
           );
         |]
+
+data DownMigration = DownMigration {downName :: String, downQuery :: Text}
+  deriving (Eq, Show)
+
+toDownMigration :: Migration -> Maybe DownMigration
+toDownMigration Migration {name, down} = DownMigration name <$> down
+
+data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
+  deriving (Eq, Show)
+
+data MTRError
+  = MTRENoDown {dbMigrations :: [String]}
+  | MTREDifferent {appMigration :: String, dbMigration :: String}
+  deriving (Eq, Show)
+
+mtrErrorDescription :: MTRError -> String
+mtrErrorDescription = \case
+  MTRENoDown ms -> "database version is newer than the app, but no down migration for: " <> intercalate ", " ms
+  MTREDifferent a d -> "different migration in the app/database: " <> a <> " / " <> d
+
+migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
+migrationsToRun [] [] = Right MTRNone
+migrationsToRun appMs [] = Right $ MTRUp appMs
+migrationsToRun [] dbMs
+  | length dms == length dbMs = Right $ MTRDown dms
+  | otherwise = Left $ MTRENoDown $ mapMaybe nameNoDown dbMs
+  where
+    dms = mapMaybe toDownMigration dbMs
+    nameNoDown m = if isNothing (down m) then Just $ name m else Nothing
+migrationsToRun (a : as) (d : ds)
+  | name a == name d = migrationsToRun as ds
+  | otherwise = Left $ MTREDifferent (name a) (name d)
+
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)

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

@@ -1,93 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.App (appMigrations) where
-
-import Data.List (sortOn)
-import Database.SQLite.Simple (Query (..))
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
-import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
-import Simplex.Messaging.Agent.Store.Shared (Migration (..))
-
-schemaMigrations :: [(String, Query, Maybe Query)]
-schemaMigrations =
-  [ ("20220101_initial", m20220101_initial, Nothing),
-    ("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
-    ("20220322_notifications", m20220322_notifications, Nothing),
-    ("20220607_v2", m20220608_v2, Nothing),
-    ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
-    ("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
-    ("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
-    ("m20220905_commands", m20220905_commands, Nothing),
-    ("m20220915_connection_queues", m20220915_connection_queues, Nothing),
-    ("m20230110_users", m20230110_users, Nothing),
-    ("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
-    ("m20230120_delete_errors", m20230120_delete_errors, Nothing),
-    ("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
-    ("m20230223_files", m20230223_files, Just down_m20230223_files),
-    ("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
-    ("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
-    ("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
-    ("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
-    ("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
-    ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
-    ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
-    ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
-    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
-    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
-    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
-    ("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
-    ("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
-    ("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
-    ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
-    ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
-    ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
-    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
-    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
-    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
-    ("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
-    ("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts),
-    ("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params),
-    ("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies)
-  ]
-
--- | The list of migrations in ascending order by date
-appMigrations :: [Migration]
-appMigrations = sortOn name $ map migration schemaMigrations
-  where
-    migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}

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

@@ -1,27 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20240930_ntf_tokens_to_delete :: Query
-m20240930_ntf_tokens_to_delete =
-    [sql|
-CREATE TABLE ntf_tokens_to_delete (
-  ntf_token_to_delete_id INTEGER PRIMARY KEY,
-  ntf_host TEXT NOT NULL,
-  ntf_port TEXT NOT NULL,
-  ntf_key_hash BLOB NOT NULL,
-  tkn_id BLOB NOT NULL, -- token ID assigned by notifications server
-  tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands,
-  del_failed INTEGER DEFAULT 0,
-  created_at TEXT NOT NULL DEFAULT (datetime('now'))
-);
-|]
-
-down_m20240930_ntf_tokens_to_delete :: Query
-down_m20240930_ntf_tokens_to_delete =
-    [sql|
-DROP TABLE ntf_tokens_to_delete;
-|]

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

@@ -1,18 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20241007_rcv_queues_last_broker_ts :: Query
-m20241007_rcv_queues_last_broker_ts =
-    [sql|
-ALTER TABLE rcv_queues ADD COLUMN last_broker_ts TEXT;
-|]
-
-down_m20241007_rcv_queues_last_broker_ts :: Query
-down_m20241007_rcv_queues_last_broker_ts =
-    [sql|
-ALTER TABLE rcv_queues DROP COLUMN last_broker_ts;
-|]

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

@@ -1,18 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20241224_ratchet_e2e_snd_params :: Query
-m20241224_ratchet_e2e_snd_params =
-    [sql|
-ALTER TABLE ratchets ADD COLUMN pq_pub_kem BLOB;
-|]
-
-down_m20241224_ratchet_e2e_snd_params :: Query
-down_m20241224_ratchet_e2e_snd_params =
-    [sql|
-ALTER TABLE ratchets DROP COLUMN pq_pub_kem;
-|]

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

@@ -1,33 +0,0 @@
-{-# 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;
-|]

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

@@ -1 +0,0 @@
-CREATE INDEX 'ratchets_conn_id' ON 'ratchets'('conn_id'); --> connections(conn_id)

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

@@ -56,7 +56,6 @@ CREATE TABLE rcv_queues(
   switch_status TEXT,
   deleted INTEGER NOT NULL DEFAULT 0,
   snd_secure INTEGER NOT NULL DEFAULT 0,
-  last_broker_ts TEXT,
   PRIMARY KEY(host, port, rcv_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE,
@@ -127,9 +126,6 @@ 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
@@ -169,8 +165,7 @@ CREATE TABLE ratchets(
   ,
   x3dh_pub_key_1 BLOB,
   x3dh_pub_key_2 BLOB,
-  pq_priv_kem BLOB,
-  pq_pub_kem BLOB
+  pq_priv_kem BLOB
 ) WITHOUT ROWID;
 CREATE TABLE skipped_messages(
   skipped_message_id INTEGER PRIMARY KEY,
@@ -408,20 +403,6 @@ CREATE TABLE servers_stats(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
-CREATE TABLE ntf_tokens_to_delete(
-  ntf_token_to_delete_id INTEGER PRIMARY KEY,
-  ntf_host TEXT NOT NULL,
-  ntf_port TEXT NOT NULL,
-  ntf_key_hash BLOB NOT NULL,
-  tkn_id BLOB NOT NULL, -- token ID assigned by notifications server
-  tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands,
-del_failed INTEGER DEFAULT 0,
-created_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
-CREATE TABLE snd_message_bodies(
-  snd_message_body_id INTEGER PRIMARY KEY,
-  agent_msg BLOB NOT NULL DEFAULT x''
-);
 CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
 CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
 CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
@@ -548,6 +529,3 @@ 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
-);

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

@@ -1,93 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Simplex.Messaging.Agent.Store.Shared
-  ( Migration (..),
-    MigrationsToRun (..),
-    DownMigration (..),
-    MTRError (..),
-    mtrErrorDescription,
-    MigrationConfirmation (..),
-    MigrationError (..),
-    UpMigration (..),
-    migrationErrorDescription,
-    -- for tests
-    toDownMigration,
-    upMigration,
-  )
-where
-
-import qualified Data.Aeson.TH as J
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.List (intercalate)
-import Data.Maybe (isJust)
-import Data.Text (Text)
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
-
-data Migration = Migration {name :: String, up :: Text, down :: Maybe Text}
-  deriving (Eq, Show)
-
-data DownMigration = DownMigration {downName :: String, downQuery :: Text}
-  deriving (Eq, Show)
-
-toDownMigration :: Migration -> Maybe DownMigration
-toDownMigration Migration {name, down} = DownMigration name <$> down
-
-data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
-  deriving (Eq, Show)
-
-data MTRError
-  = MTRENoDown {dbMigrations :: [String]}
-  | MTREDifferent {appMigration :: String, dbMigration :: String}
-  deriving (Eq, Show)
-
-mtrErrorDescription :: MTRError -> String
-mtrErrorDescription = \case
-  MTRENoDown ms -> "database version is newer than the app, but no down migration for: " <> intercalate ", " ms
-  MTREDifferent a d -> "different migration in the app/database: " <> a <> " / " <> d
-
-data MigrationError
-  = MEUpgrade {upMigrations :: [UpMigration]}
-  | MEDowngrade {downMigrations :: [String]}
-  | MigrationError {mtrError :: MTRError}
-  deriving (Eq, Show)
-
-migrationErrorDescription :: MigrationError -> String
-migrationErrorDescription = \case
-  MEUpgrade ums ->
-    "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map upName ums)
-  MEDowngrade dms ->
-    "Database version is newer than the app.\nConfirm to back up and downgrade using these migrations: " <> intercalate ", " dms
-  MigrationError err -> mtrErrorDescription err
-
-data UpMigration = UpMigration {upName :: String, withDown :: Bool}
-  deriving (Eq, Show)
-
-upMigration :: Migration -> UpMigration
-upMigration Migration {name, down} = UpMigration name $ isJust down
-
-data MigrationConfirmation = MCYesUp | MCYesUpDown | MCConsole | MCError
-  deriving (Eq, Show)
-
-instance StrEncoding MigrationConfirmation where
-  strEncode = \case
-    MCYesUp -> "yesUp"
-    MCYesUpDown -> "yesUpDown"
-    MCConsole -> "console"
-    MCError -> "error"
-  strP =
-    A.takeByteString >>= \case
-      "yesUp" -> pure MCYesUp
-      "yesUpDown" -> pure MCYesUpDown
-      "console" -> pure MCConsole
-      "error" -> pure MCError
-      _ -> fail "invalid MigrationConfirmation"
-
-$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)
-
-$(J.deriveJSON defaultJSON ''UpMigration)
-
-$(J.deriveToJSON (sumTypeJSON $ dropPrefix "ME") ''MigrationError)

src/Simplex/Messaging/Client.hs

@@ -58,18 +58,20 @@ module Simplex.Messaging.Client
     suspendSMPQueue,
     deleteSMPQueue,
     deleteSMPQueues,
+    createSMPDataBlob,
+    deleteSMPDataBlob,
+    getSMPDataBlob,
+    proxyGetSMPDataBlob,
     connectSMPProxiedRelay,
     proxySMPMessage,
     forwardSMPTransmission,
     getSMPQueueInfo,
     sendProtocolCommand,
-    sendProtocolCommands,
 
     -- * Supporting types and client configuration
     ProtocolClientError (..),
     SMPClientError,
     ProxyClientError (..),
-    Response (..),
     unexpectedResponse,
     ProtocolClientConfig (..),
     NetworkConfig (..),
@@ -82,11 +84,10 @@ module Simplex.Messaging.Client
     defaultSMPClientConfig,
     defaultNetworkConfig,
     transportClientConfig,
-    clientSocksCredentials,
     chooseTransportHost,
+    proxyUsername,
     temporaryClientError,
     smpProxyError,
-    textToHostMode,
     ServerTransmissionBatch,
     ServerTransmission (..),
     ClientCommand,
@@ -105,7 +106,7 @@ module Simplex.Messaging.Client
 where
 
 import Control.Applicative ((<|>))
-import Control.Concurrent (ThreadId, forkFinally, forkIO, killThread, mkWeakThreadId)
+import Control.Concurrent (ThreadId, forkFinally, killThread, mkWeakThreadId)
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
@@ -117,22 +118,20 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bitraversable (bimapM)
+import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Base64 as B64
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (catMaybes, fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Network.Socket (ServiceName)
-import Network.Socks5 (SocksCredentials (..))
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -143,9 +142,10 @@ import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultSMPPort, defaultTcpConnectTimeout, runTransportClient)
+import Simplex.Messaging.Transport.Client (SocksProxy, TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient)
 import Simplex.Messaging.Transport.KeepAlive
-import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tryWriteTBQueue, tshow, whenM)
+import Simplex.Messaging.Transport.WebSockets (WS)
+import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
 import Simplex.Messaging.Version
 import System.Mem.Weak (Weak, deRefWeak)
 import System.Timeout (timeout)
@@ -171,7 +171,7 @@ data PClient v err msg = PClient
     timeoutErrorCount :: TVar Int,
     clientCorrId :: TVar ChaChaDRG,
     sentCommands :: TMap CorrId (Request err msg),
-    sndQ :: TBQueue (Maybe (Request err msg), ByteString),
+    sndQ :: TBQueue (Maybe (TVar Bool), ByteString),
     rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)),
     msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
   }
@@ -198,7 +198,6 @@ smpClientStub g sessionId thVersion thAuth = do
               thAuth,
               blockSize = smpBlockSize,
               implySessId = thVersion >= authCmdsSMPVersion,
-              encryptBlock = Nothing,
               batch = True
             },
         sessionTs = ts,
@@ -243,12 +242,6 @@ data HostMode
     HMPublic
   deriving (Eq, Show)
 
-textToHostMode :: Text -> Either String HostMode
-textToHostMode = \case
-  "public" -> Right HMPublic
-  "onion" -> Right HMOnionViaSocks
-  s -> Left $ T.unpack $ "Invalid host_mode: " <> s
-
 data SocksMode
   = -- | always use SOCKS proxy when enabled
     SMAlways
@@ -270,7 +263,7 @@ instance StrEncoding SocksMode where
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
   { -- | use SOCKS5 proxy
-    socksProxy :: Maybe SocksProxyWithAuth,
+    socksProxy :: Maybe SocksProxy,
     -- | when to use SOCKS proxy
     socksMode :: SocksMode,
     -- | determines critera which host is chosen from the list
@@ -283,8 +276,6 @@ data NetworkConfig = NetworkConfig
     smpProxyMode :: SMPProxyMode,
     -- | Fallback to direct connection when destination SMP relay does not support SMP proxy protocol extensions
     smpProxyFallback :: SMPProxyFallback,
-    -- | use web port 443 for SMP protocol
-    smpWebPort :: Bool,
     -- | timeout for the initial client TCP/TLS connection (microseconds)
     tcpConnectTimeout :: Int,
     -- | timeout of protocol commands (microseconds)
@@ -303,7 +294,7 @@ data NetworkConfig = NetworkConfig
   }
   deriving (Eq, Show)
 
-data TransportSessionMode = TSMUser | TSMSession | TSMServer | TSMEntity
+data TransportSessionMode = TSMUser | TSMEntity
   deriving (Eq, Show)
 
 -- SMP proxy mode for sending messages
@@ -353,10 +344,9 @@ defaultNetworkConfig =
       socksMode = SMAlways,
       hostMode = HMOnionViaSocks,
       requiredHostMode = False,
-      sessionMode = TSMSession,
+      sessionMode = TSMUser,
       smpProxyMode = SPMNever,
       smpProxyFallback = SPFAllow,
-      smpWebPort = False,
       tcpConnectTimeout = defaultTcpConnectTimeout,
       tcpTimeout = 15_000_000,
       tcpTimeoutPerKb = 5_000,
@@ -367,31 +357,15 @@ defaultNetworkConfig =
       logTLSErrors = False
     }
 
-transportClientConfig :: NetworkConfig -> TransportHost -> Bool -> TransportClientConfig
-transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host useSNI =
-  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing, useSNI}
+transportClientConfig :: NetworkConfig -> TransportHost -> TransportClientConfig
+transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host =
+  TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing}
   where
-    socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy
-    useSocksProxy SMAlways = socksProxy'
+    useSocksProxy SMAlways = socksProxy
     useSocksProxy SMOnion = case host of
-      THOnionHost _ -> socksProxy'
+      THOnionHost _ -> socksProxy
       _ -> Nothing
-
-clientSocksCredentials :: ProtocolTypeI (ProtoType msg) => NetworkConfig -> UTCTime -> TransportSession msg -> Maybe SocksCredentials
-clientSocksCredentials NetworkConfig {socksProxy, sessionMode} proxySessTs (userId, srv, entityId_) = case socksProxy of
-  Just (SocksProxyWithAuth auth _) -> case auth of
-    SocksAuthUsername {username, password} -> Just $ SocksCredentials username password
-    SocksAuthNull -> Nothing
-    SocksIsolateByAuth -> Just $ SocksCredentials sessionUsername ""
-  Nothing -> Nothing
-  where
-    sessionUsername =
-      B64.encode $ C.sha256Hash $
-        bshow userId <> case sessionMode of
-          TSMUser -> ""
-          TSMSession -> ":" <> bshow proxySessTs
-          TSMServer -> ":" <> bshow proxySessTs <> "@" <> strEncode srv
-          TSMEntity -> ":" <> bshow proxySessTs <> "@" <> strEncode srv <> maybe "" ("/" <>) entityId_
+{-# INLINE transportClientConfig #-}
 
 -- | protocol client configuration.
 data ProtocolClientConfig v = ProtocolClientConfig
@@ -405,34 +379,24 @@ data ProtocolClientConfig v = ProtocolClientConfig
     -- | client-server protocol version range
     serverVRange :: VersionRange v,
     -- | agree shared session secret (used in SMP proxy for additional encryption layer)
-    agreeSecret :: Bool,
-    -- | Whether connecting client is a proxy server. See comment in ClientHandshake
-    proxyServer :: Bool,
-    -- | send SNI to server, False for SMP
-    useSNI :: Bool
+    agreeSecret :: Bool
   }
 
 -- | Default protocol client configuration.
-defaultClientConfig :: Maybe [ALPN] -> Bool -> VersionRange v -> ProtocolClientConfig v
-defaultClientConfig clientALPN useSNI serverVRange =
+defaultClientConfig :: Maybe [ALPN] -> VersionRange v -> ProtocolClientConfig v
+defaultClientConfig clientALPN serverVRange =
   ProtocolClientConfig
     { qSize = 64,
       defaultTransport = ("443", transport @TLS),
       networkConfig = defaultNetworkConfig,
       clientALPN,
       serverVRange,
-      agreeSecret = False,
-      proxyServer = False,
-      useSNI
+      agreeSecret = False
     }
 {-# INLINE defaultClientConfig #-}
 
 defaultSMPClientConfig :: ProtocolClientConfig SMPVersion
-defaultSMPClientConfig =
-  (defaultClientConfig (Just supportedSMPHandshakes) False supportedClientSMPRelayVRange)
-    { defaultTransport = (show defaultSMPPort, transport @TLS),
-      agreeSecret = True
-    }
+defaultSMPClientConfig = defaultClientConfig (Just supportedSMPHandshakes) supportedClientSMPRelayVRange
 {-# INLINE defaultSMPClientConfig #-}
 
 data Request err msg = Request
@@ -491,15 +455,15 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret, proxyServer, useSNI} msgQ proxySessTs disconnected = do
+getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
+getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
       (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
         `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
     Left e -> pure $ Left e
   where
-    NetworkConfig {smpWebPort, tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
+    NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
     mkProtocolClient :: TransportHost -> UTCTime -> IO (PClient v err msg)
     mkProtocolClient transportHost ts = do
       connected <- newTVarIO False
@@ -530,10 +494,10 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     runClient :: (ServiceName, ATransport) -> TransportHost -> PClient v err msg -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
     runClient (port', ATransport t) useHost c = do
       cVar <- newEmptyTMVarIO
-      let tcConfig = (transportClientConfig networkConfig useHost useSNI) {alpn = clientALPN}
-          socksCreds = clientSocksCredentials networkConfig proxySessTs transportSession
+      let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
+          username = proxyUsername transportSession
       tId <-
-        runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar)
+        runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
           `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
       c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
       case c_ of
@@ -543,15 +507,14 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
 
     useTransport :: (ServiceName, ATransport)
     useTransport = case port srv of
-      "" -> case protocolTypeI @(ProtoType msg) of
-        SPSMP | smpWebPort -> ("443", transport @TLS)
-        _ -> defaultTransport cfg
+      "" -> defaultTransport cfg
+      "80" -> ("80", transport @WS)
       p -> (p, transport @TLS)
 
     client :: forall c. Transport c => TProxy c -> PClient v err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient v err msg)) -> c -> IO ()
     client _ c cVar h = do
       ks <- if agreeSecret then Just <$> atomically (C.generateKeyPair g) else pure Nothing
-      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer) >>= \case
+      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange) >>= \case
         Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
         Right th@THandle {params} -> do
           sessionTs <- getCurrentTime
@@ -566,12 +529,9 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     send :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
     send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= sendPending
       where
-        sendPending (r, s) = case r of
-          Nothing -> void $ tPutLog h s
-          Just Request {pending, responseVar} ->
-            whenM (readTVarIO pending) $ tPutLog h s >>= either responseErr pure
-            where
-              responseErr = atomically . putTMVar responseVar . Left . PCETransportError
+        sendPending (Nothing, s) = send_ s
+        sendPending (Just pending, s) = whenM (readTVarIO pending) $ send_ s
+        send_ = void . tPutLog h
 
     receive :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
     receive ProtocolClient {client_ = PClient {rcvQ, lastReceived, timeoutErrorCount}} h = forever $ do
@@ -643,6 +603,10 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
 unexpectedResponse :: Show r => r -> ProtocolClientError err
 unexpectedResponse = PCEUnexpectedResponse . B.pack . take 32 . show
 
+proxyUsername :: TransportSession msg -> ByteString
+proxyUsername (userId, _, entityId_) = C.sha256Hash $ bshow userId <> maybe "" (":" <>) entityId_
+{-# INLINE proxyUsername #-}
+
 -- | Disconnects client from the server and terminates client threads.
 closeProtocolClient :: ProtocolClient v err msg -> IO ()
 closeProtocolClient = mapM_ (deRefWeak >=> mapM_ killThread) . action
@@ -721,8 +685,8 @@ createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue
 subscribeSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> ExceptT SMPClientError IO ()
-subscribeSMPQueue c rpKey rId = do
-  liftIO $ enablePings c
+subscribeSMPQueue c@ProtocolClient {client_ = PClient {sendPings}} rpKey rId = do
+  liftIO . atomically $ writeTVar sendPings True
   sendSMPCommand c (Just rpKey) rId SUB >>= \case
     OK -> pure ()
     cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
@@ -730,8 +694,8 @@ subscribeSMPQueue c rpKey rId = do
 
 -- | Subscribe to multiple SMP queues batching commands if supported.
 subscribeSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO (NonEmpty (Either SMPClientError ()))
-subscribeSMPQueues c qs = do
-  liftIO $ enablePings c
+subscribeSMPQueues c@ProtocolClient {client_ = PClient {sendPings}} qs = do
+  atomically $ writeTVar sendPings True
   sendProtocolCommands c cs >>= mapM (processSUBResponse c)
   where
     cs = L.map (\(rpKey, rId) -> (Just rpKey, rId, Cmd SRecipient SUB)) qs
@@ -770,22 +734,14 @@ getSMPMessage c rpKey rId =
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications
 subscribeSMPQueueNotifications :: SMPClient -> NtfPrivateAuthKey -> NotifierId -> ExceptT SMPClientError IO ()
-subscribeSMPQueueNotifications c npKey nId = do
-  liftIO $ enablePings c
-  okSMPCommand NSUB c npKey nId
+subscribeSMPQueueNotifications = okSMPCommand NSUB
 {-# INLINE subscribeSMPQueueNotifications #-}
 
 -- | Subscribe to multiple SMP queues notifications batching commands if supported.
 subscribeSMPQueuesNtfs :: SMPClient -> NonEmpty (NtfPrivateAuthKey, NotifierId) -> IO (NonEmpty (Either SMPClientError ()))
-subscribeSMPQueuesNtfs c qs = do
-  liftIO $ enablePings c
-  okSMPCommands NSUB c qs
+subscribeSMPQueuesNtfs = okSMPCommands NSUB
 {-# INLINE subscribeSMPQueuesNtfs #-}
 
-enablePings :: SMPClient -> IO ()
-enablePings ProtocolClient {client_ = PClient {sendPings}} = atomically $ writeTVar sendPings True
-{-# INLINE enablePings #-}
-
 -- | Secure the SMP queue by adding a sender public key.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command
@@ -799,9 +755,14 @@ secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey
 {-# INLINE secureSndSMPQueue #-}
 
 proxySecureSndSMPQueue :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey)
+proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey) okResult
 {-# INLINE proxySecureSndSMPQueue #-}
 
+okResult :: BrokerMsg -> Maybe ()
+okResult = \case
+  OK -> Just ()
+  _ -> Nothing
+
 -- | Enable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
@@ -843,7 +804,7 @@ sendSMPMessage c spKey sId flags msg =
     r -> throwE $ unexpectedResponse r
 
 proxySMPMessage :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg)
+proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg) okResult
 
 -- | Acknowledge message delivery (server deletes the message).
 --
@@ -875,6 +836,43 @@ deleteSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}
 
+createSMPDataBlob :: SMPClient -> C.AAuthKeyPair -> BlobId -> DataBlob -> ExceptT SMPClientError IO ()
+createSMPDataBlob c (dKey, dpKey) dId blob = okSMPCommand (WRT dKey blob) c dpKey dId
+{-# INLINE createSMPDataBlob #-}
+
+deleteSMPDataBlob :: SMPClient -> DataPrivateAuthKey -> BlobId -> ExceptT SMPClientError IO ()
+deleteSMPDataBlob = okSMPCommand CLR
+{-# INLINE deleteSMPDataBlob #-}
+
+-- pk is the private key passed to the client out of band.
+-- Associated public key is used as ID to retrieve data blob
+getSMPDataBlob :: SMPClient -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO DataBlob
+getSMPDataBlob c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} pk = do
+  serverKey <- case thAuth thParams of
+    Nothing -> throwE $ PCETransportError TENoServerAuth
+    Just THAuthClient {serverPeerPubKey = k} -> pure k
+  nonce <- liftIO . atomically $ C.randomCbNonce g
+  let dId = EntityId $ BA.convert $ C.pubKeyBytes $ C.publicKey pk
+  sendProtocolCommand_ c (Just nonce) Nothing Nothing dId (Cmd SSender READ) >>= \case
+    DATA encBlob -> decryptDataBlob serverKey pk nonce encBlob
+    r -> throwE $ unexpectedResponse r
+
+proxyGetSMPDataBlob :: SMPClient -> ProxiedRelay -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO (Either ProxyClientError DataBlob)
+proxyGetSMPDataBlob c@ProtocolClient {client_ = PClient {clientCorrId = g}} proxiedRelay@ProxiedRelay {prServerKey} pk = do
+  nonce <- liftIO . atomically $ C.randomCbNonce g
+  let dId = EntityId $ BA.convert $ C.pubKeyBytes $ C.publicKey pk
+  encBlob_ <-
+    proxySMPCommand_ c (Just nonce) proxiedRelay Nothing dId READ $ \case
+      DATA encBlob -> Just encBlob
+      _ -> Nothing
+  bimapM pure (decryptDataBlob prServerKey pk nonce) encBlob_
+
+decryptDataBlob :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> ExceptT (ProtocolClientError ErrorType) IO DataBlob
+decryptDataBlob serverKey pk nonce encBlob = do
+  let ss = C.dh' serverKey pk
+  blobStr <- liftEitherWith PCECryptoError $ C.cbDecrypt ss nonce encBlob
+  liftEitherWith (const $ PCEResponseError BLOCK) $ smpDecode blobStr
+
 -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender
 -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg
 connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
@@ -928,6 +926,9 @@ instance StrEncoding ProxyClientError where
       "SYNTAX" -> ProxyResponseError <$> _strP
       _ -> fail "bad ProxyClientError"
 
+proxySMPCommand :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> (BrokerMsg -> Maybe r) -> ExceptT SMPClientError IO (Either ProxyClientError r)
+proxySMPCommand c = proxySMPCommand_ c Nothing
+
 -- consider how to process slow responses - is it handled somehow locally or delegated to the caller
 -- this method is used in the client
 -- sends PFWD :: C.PublicKeyX25519 -> EncTransmission -> Command Sender
@@ -955,22 +956,25 @@ instance StrEncoding ProxyClientError where
 -- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
 
 -- This function proxies Sender commands that return OK or ERR
-proxySMPCommand ::
+proxySMPCommand_ ::
   SMPClient ->
+  -- optional correlation ID/nonce for the sending client
+  Maybe C.CbNonce ->
   -- proxy session from PKEY
   ProxiedRelay ->
-  -- message to deliver
+  -- command to deliver
   Maybe SndPrivateAuthKey ->
   SenderId ->
   Command 'Sender ->
-  ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v _ serverKey) spKey sId command = do
+  (BrokerMsg -> Maybe r) ->
+  ExceptT SMPClientError IO (Either ProxyClientError r)
+proxySMPCommand_ c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} nonce_ (ProxiedRelay sessionId v _ serverKey) spKey sId command toResult = do
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
   (cmdPubKey, cmdPrivKey) <- liftIO . atomically $ C.generateKeyPair @'C.X25519 g
   let cmdSecret = C.dh' serverKey cmdPrivKey
-  nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
+  nonce@(C.CbNonce corrId) <- liftIO $ maybe (atomically $ C.randomCbNonce g) pure nonce_
   -- encode
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command)
   auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
@@ -990,9 +994,11 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
         case tParse serverThParams t' of
           t'' :| [] -> case tDecodeParseValidate serverThParams t'' of
             (_auth, _signed, (_c, _e, cmd)) -> case cmd of
-              Right OK -> pure $ Right ()
-              Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
-              Right r' -> throwE $ unexpectedResponse r'
+              Right r' -> case toResult r' of
+                Just r'' -> pure $ Right r''
+                Nothing -> case r' of
+                  ERR e -> throwE $ PCEProtocolError e -- this is the error from the destination relay
+                  _ -> throwE $ unexpectedResponse r'
               Left e -> throwE $ PCEResponseError e
           _ -> throwE $ PCETransportError TEBadBlock
       ERR e -> pure . Left $ ProxyProtocolError e -- this will not happen, this error is returned via Left
@@ -1086,11 +1092,11 @@ sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
       pure [Response entityId $ Left $ PCETransportError e]
     TBTransmissions s n rs
       | n > 0 -> do
-          nonBlockingWriteTBQueue sndQ (Nothing, s) -- do not expire batched responses
+          atomically $ writeTBQueue sndQ (Nothing, s) -- do not expire batched responses
           mapConcurrently (getResponse c Nothing) rs
       | otherwise -> pure []
     TBTransmission s r -> do
-      nonBlockingWriteTBQueue sndQ (Nothing, s)
+      atomically $ writeTBQueue sndQ (Nothing, s)
       (: []) <$> getResponse c Nothing r
 
 -- | Send Protocol command
@@ -1107,23 +1113,18 @@ sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THan
   where
     -- two separate "atomically" needed to avoid blocking
     sendRecv :: Either TransportError SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg)
-    sendRecv t_ r = case t_ of
+    sendRecv t_ r@Request {pending} = case t_ of
       Left e -> pure . Left $ PCETransportError e
       Right t
         | B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg
         | otherwise -> do
-            nonBlockingWriteTBQueue sndQ (Just r, s)
+            atomically $ writeTBQueue sndQ (Just pending, s)
             response <$> getResponse c tOut r
         where
           s
             | batch = tEncodeBatch1 t
             | otherwise = tEncode t
 
-nonBlockingWriteTBQueue :: TBQueue a -> a -> IO ()
-nonBlockingWriteTBQueue q x = do
-  sent <- atomically $ tryWriteTBQueue q x
-  unless sent $ void $ forkIO $ atomically $ writeTBQueue q x
-
 getResponse :: ProtocolClient v err msg -> Maybe Int -> Request err msg -> IO (Response err msg)
 getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} tOut Request {entityId, pending, responseVar} = do
   r <- fromMaybe tcpTimeout tOut `timeout` atomically (takeTMVar responseVar)

src/Simplex/Messaging/Client/Agent.hs

@@ -76,7 +76,7 @@ data SMPClientAgentConfig = SMPClientAgentConfig
 defaultSMPClientAgentConfig :: SMPClientAgentConfig
 defaultSMPClientAgentConfig =
   SMPClientAgentConfig
-    { smpCfg = defaultSMPClientConfig,
+    { smpCfg = defaultSMPClientConfig {defaultTransport = ("5223", transport @TLS)},
       reconnectInterval =
         RetryInterval
           { initialInterval = second,
@@ -84,8 +84,8 @@ defaultSMPClientAgentConfig =
             maxInterval = 10 * second
           },
       persistErrorInterval = 30, -- seconds
-      msgQSize = 2048,
-      agentQSize = 2048,
+      msgQSize = 1024,
+      agentQSize = 1024,
       agentSubsBatchSize = 1360,
       ownServerDomains = []
     }
@@ -95,7 +95,6 @@ defaultSMPClientAgentConfig =
 data SMPClientAgent = SMPClientAgent
   { agentCfg :: SMPClientAgentConfig,
     active :: TVar Bool,
-    startedAt :: UTCTime,
     msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
     agentQ :: TBQueue SMPClientAgentEvent,
     randomDrg :: TVar ChaChaDRG,
@@ -112,7 +111,6 @@ type OwnServer = Bool
 newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
   active <- newTVarIO True
-  startedAt <- getCurrentTime
   msgQ <- newTBQueueIO msgQSize
   agentQ <- newTBQueueIO agentQSize
   smpClients <- TM.emptyIO
@@ -125,7 +123,6 @@ newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg
     SMPClientAgent
       { agentCfg,
         active,
-        startedAt,
         msgQ,
         agentQ,
         randomDrg,
@@ -197,8 +194,8 @@ isOwnServer SMPClientAgent {agentCfg} ProtocolServer {host} =
 
 -- | Run an SMP client for SMPClientVar
 connectClient :: SMPClientAgent -> 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
+connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, randomDrg} srv v =
+  getProtocolClient randomDrg (1, srv, Nothing) (smpCfg agentCfg) (Just msgQ) clientDisconnected
   where
     clientDisconnected :: SMPClient -> IO ()
     clientDisconnected smp = do

src/Simplex/Messaging/Crypto.hs

@@ -1,14 +1,11 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -155,12 +152,6 @@ module Simplex.Messaging.Crypto
     unsafeSbKey,
     randomSbKey,
 
-    -- * secret_box chains
-    SbChainKey,
-    SbKeyNonce,
-    sbcInit,
-    sbcHkdf,
-
     -- * pseudo-random bytes
     randomBytes,
 
@@ -169,7 +160,6 @@ module Simplex.Messaging.Crypto
     sha512Hash,
 
     -- * Message padding / un-padding
-    canPad,
     pad,
     unPad,
 
@@ -208,7 +198,6 @@ 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 qualified Crypto.KDF.HKDF as H
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
@@ -237,12 +226,13 @@ import Data.Typeable (Proxy (Proxy), Typeable)
 import Data.Word (Word32)
 import Data.X509
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (parseAll, parseString)
+import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
 
 -- | Cryptographic algorithms.
@@ -724,23 +714,23 @@ generateKeyPair_ = case sAlgorithm @a of
       let k = X448.toPublic pk
        in pure (PublicKeyX448 k, PrivateKeyX448 pk k)
 
-instance ToField APrivateSignKey where toField = toField . Binary . encodePrivKey
+instance ToField APrivateSignKey where toField = toField . encodePrivKey
 
-instance ToField APublicVerifyKey where toField = toField . Binary . encodePubKey
+instance ToField APublicVerifyKey where toField = toField . encodePubKey
 
-instance ToField APrivateAuthKey where toField = toField . Binary . encodePrivKey
+instance ToField APrivateAuthKey where toField = toField . encodePrivKey
 
-instance ToField APublicAuthKey where toField = toField . Binary . encodePubKey
+instance ToField APublicAuthKey where toField = toField . encodePubKey
 
-instance ToField APrivateDhKey where toField = toField . Binary . encodePrivKey
+instance ToField APrivateDhKey where toField = toField . encodePrivKey
 
-instance ToField APublicDhKey where toField = toField . Binary . encodePubKey
+instance ToField APublicDhKey where toField = toField . encodePubKey
 
-instance AlgorithmI a => ToField (PrivateKey a) where toField = toField . Binary . encodePrivKey
+instance AlgorithmI a => ToField (PrivateKey a) where toField = toField . encodePrivKey
 
-instance AlgorithmI a => ToField (PublicKey a) where toField = toField . Binary . encodePubKey
+instance AlgorithmI a => ToField (PublicKey a) where toField = toField . encodePubKey
 
-instance ToField (DhSecret a) where toField = toField . Binary . dhBytes'
+instance ToField (DhSecret a) where toField = toField . dhBytes'
 
 instance FromField APrivateSignKey where fromField = blobFieldDecoder decodePrivKey
 
@@ -891,9 +881,10 @@ validSignatureSize n =
 -- | AES key newtype.
 newtype Key = Key {unKey :: ByteString}
   deriving (Eq, Ord, Show)
-  deriving newtype (FromField)
 
-instance ToField Key where toField (Key s) = toField $ Binary s
+instance ToField Key where toField = toField . unKey
+
+instance FromField Key where fromField f = Key <$> fromField f
 
 instance ToJSON Key where
   toJSON = strToJSON . unKey
@@ -954,7 +945,7 @@ instance FromJSON KeyHash where
 instance IsString KeyHash where
   fromString = parseString $ parseAll strP
 
-instance ToField KeyHash where toField = toField . Binary . strEncode
+instance ToField KeyHash where toField = toField . strEncode
 
 instance FromField KeyHash where fromField = blobFieldDecoder $ parseAll strP
 
@@ -1011,11 +1002,6 @@ 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 '#'
@@ -1169,14 +1155,10 @@ instance SignatureAlgorithmX509 pk => SignatureAlgorithmX509 (a, pk) where
 newtype SignedObject a = SignedObject {getSignedExact :: SignedExact a}
 
 instance (Typeable a, Eq a, Show a, ASN1Object a) => FromField (SignedObject a) where
-#if defined(dbPostgres)
-  fromField f dat = SignedObject <$> blobFieldDecoder decodeSignedObject f dat
-#else
   fromField = fmap SignedObject . blobFieldDecoder decodeSignedObject
-#endif
 
 instance (Eq a, Show a, ASN1Object a) => ToField (SignedObject a) where
-  toField (SignedObject s) = toField . Binary $ encodeSignedObject s
+  toField (SignedObject s) = toField $ encodeSignedObject s
 
 instance (Eq a, Show a, ASN1Object a) => Encoding (SignedObject a) where
   smpEncode (SignedObject exact) = smpEncode . Large $ encodeSignedObject exact
@@ -1276,9 +1258,6 @@ cbVerify k pk nonce (CbAuthenticator s) authorized = cbDecryptNoPad (dh' k pk) n
 
 newtype CbNonce = CryptoBoxNonce {unCbNonce :: ByteString}
   deriving (Eq, Show)
-  deriving newtype (FromField)
-
-instance ToField CbNonce where toField (CryptoBoxNonce s) = toField $ Binary s
 
 pattern CbNonce :: ByteString -> CbNonce
 pattern CbNonce s <- CryptoBoxNonce s
@@ -1296,6 +1275,10 @@ instance ToJSON CbNonce where
 instance FromJSON CbNonce where
   parseJSON = strParseJSON "CbNonce"
 
+instance FromField CbNonce where fromField f = CryptoBoxNonce <$> fromField f
+
+instance ToField CbNonce where toField (CryptoBoxNonce s) = toField s
+
 cbNonce :: ByteString -> CbNonce
 cbNonce s
   | len == 24 = CryptoBoxNonce s
@@ -1319,9 +1302,6 @@ instance Encoding CbNonce where
 
 newtype SbKey = SecretBoxKey {unSbKey :: ByteString}
   deriving (Eq, Show)
-  deriving newtype (FromField)
-
-instance ToField SbKey where toField (SecretBoxKey s) = toField $ Binary s
 
 pattern SbKey :: ByteString -> SbKey
 pattern SbKey s <- SecretBoxKey s
@@ -1339,6 +1319,10 @@ instance ToJSON SbKey where
 instance FromJSON SbKey where
   parseJSON = strParseJSON "SbKey"
 
+instance FromField SbKey where fromField f = SecretBoxKey <$> fromField f
+
+instance ToField SbKey where toField (SecretBoxKey s) = toField s
+
 sbKey :: ByteString -> Either String SbKey
 sbKey s
   | B.length s == 32 = Right $ SecretBoxKey s
@@ -1350,26 +1334,6 @@ unsafeSbKey s = either error id $ sbKey s
 randomSbKey :: TVar ChaChaDRG -> STM SbKey
 randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar
 
-newtype SbChainKey = SecretBoxChainKey {unSbChainKey :: ByteString}
-  deriving (Eq, Show)
-
-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
-
-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)
-    (ck', rest) = B.splitAt 32 out
-    (sk, nonce) = B.splitAt 32 rest
-
 xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
 xSalsa20 secret nonce msg = (rs, msg')
   where

src/Simplex/Messaging/Crypto/Lazy.hs

@@ -17,8 +17,6 @@ module Simplex.Messaging.Crypto.Lazy
     kcbEncryptTailTag,
     sbDecryptTailTag,
     kcbDecryptTailTag,
-    sbEncryptTailTagNoPad,
-    sbDecryptTailTagNoPad,
     fastReplicate,
     secretBox,
     secretBoxTailTag,
@@ -51,7 +49,7 @@ import Data.Composition ((.:.))
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Foreign (sizeOf)
-import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, SbKeyNonce, pattern CbNonce, pattern SbKey)
+import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, pattern CbNonce, pattern SbKey)
 import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret (..))
 import Simplex.Messaging.Encoding
 
@@ -144,10 +142,6 @@ sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString ->
 sbEncryptTailTag_ key (CbNonce nonce) msg len paddedLen =
   LB.fromChunks <$> (secretBoxTailTag sbEncryptChunk key nonce =<< pad msg len paddedLen)
 
-sbEncryptTailTagNoPad :: SbKeyNonce -> LazyByteString -> Either CryptoError LazyByteString
-sbEncryptTailTagNoPad (SbKey key, CbNonce nonce) msg =
-  LB.fromChunks <$> secretBoxTailTag sbEncryptChunk key nonce msg
-
 -- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
 -- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
 sbDecryptTailTag :: SbKey -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
@@ -171,15 +165,6 @@ sbDecryptTailTag_ key (CbNonce nonce) paddedLen packet =
   where
     (c, tag') = LB.splitAt paddedLen packet
 
-sbDecryptTailTagNoPad :: SbKeyNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
-sbDecryptTailTagNoPad (SbKey key, CbNonce nonce) paddedLen packet =
-  result <$> secretBox sbDecryptChunk key nonce c
-  where
-    result (tag :| cs) =
-      let valid = LB.length tag' == 16 && BA.constEq (LB.toStrict tag') tag
-       in (valid, LB.fromChunks cs)
-    (c, tag') = LB.splitAt paddedLen packet
-
 secretBoxTailTag :: ByteArrayAccess key => (SbState -> ByteString -> (ByteString, SbState)) -> key -> ByteString -> LazyByteString -> Either CryptoError [ByteString]
 secretBoxTailTag sbProcess secret nonce msg = run <$> sbInit_ secret nonce
   where

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -21,8 +20,6 @@
 module Simplex.Messaging.Crypto.Ratchet
   ( Ratchet (..),
     RatchetX448,
-    MsgEncryptKey (..),
-    MsgEncryptKeyX448,
     SkippedMsgDiff (..),
     SkippedMsgKeys,
     InitialKeys (..),
@@ -66,9 +63,7 @@ module Simplex.Messaging.Crypto.Ratchet
     pqX3dhRcv,
     initSndRatchet,
     initRcvRatchet,
-    rcCheckCanPad,
-    rcEncryptHeader,
-    rcEncryptMsg,
+    rcEncrypt,
     rcDecrypt,
     -- used in tests
     MsgHeader (..),
@@ -89,7 +84,6 @@ 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
@@ -115,13 +109,14 @@ import Data.Maybe (fromMaybe, isJust)
 import Data.Type.Equality
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word32)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.QueryString
-import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..), FromField (..), ToField (..), blobFieldDecoder)
 import Simplex.Messaging.Crypto
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (defaultJSON, parseE, parseE')
+import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
 import Simplex.Messaging.Util (($>>=), (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
@@ -211,10 +206,6 @@ instance Encoding ARKEMParams where
       'A' -> ARKP SRKSAccepted .: RKParamsAccepted <$> smpP <*> smpP
       _ -> fail "bad ratchet KEM params"
 
-instance ToField ARKEMParams where toField = toField . Binary . smpEncode
-
-instance FromField ARKEMParams where fromField = blobFieldDecoder smpDecode
-
 data E2ERatchetParams (s :: RatchetKEMState) (a :: Algorithm)
   = E2ERatchetParams VersionE2E (PublicKey a) (PublicKey a) (Maybe (RKEMParams s))
   deriving (Show)
@@ -368,7 +359,7 @@ instance Encoding APrivRKEMParams where
       'A' -> APRKP SRKSAccepted .:. PrivateRKParamsAccepted <$> smpP <*> smpP <*> smpP
       _ -> fail "bad APrivRKEMParams"
 
-instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toField . Binary . smpEncode
+instance RatchetKEMStateI s => ToField (PrivRKEMParams s) where toField = toField . smpEncode
 
 instance (Typeable s, RatchetKEMStateI s) => FromField (PrivRKEMParams s) where fromField = blobFieldDecoder smpDecode
 
@@ -569,7 +560,6 @@ 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)
@@ -586,7 +576,7 @@ instance ToJSON RatchetKey where
 instance FromJSON RatchetKey where
   parseJSON = fmap RatchetKey . strParseJSON "Key"
 
-instance ToField MessageKey where toField = toField . Binary . smpEncode
+instance ToField MessageKey where toField = toField . smpEncode
 
 instance FromField MessageKey where fromField = blobFieldDecoder smpDecode
 
@@ -851,13 +841,9 @@ connPQEncryption = \case
   IKUsePQ -> PQSupportOn
   IKNoPQ pq -> pq -- default for creating connection is IKNoPQ PQEncOn
 
-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
+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
   -- state.CKs, mk = KDF_CK(state.CKs)
   let (ck', mk, iv, ehIV) = chainKdf rcCKs
       v = current rcVersion
@@ -872,15 +858,11 @@ rcEncryptHeader rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, r
       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
+  -- return enc_header, ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
   let emHeader = smpEncode EncMessageHeader {ehVersion = v, ehBody, ehAuthTag, ehIV}
-      msgEncryptKey =
-        MsgEncryptKey
-          { msgRcVersion = v,
-            msgKey = MessageKey mk iv,
-            msgRcAD = rcAD,
-            msgEncHeader = emHeader
-          }
+  (emAuthTag, emBody) <- encryptAEAD mk iv paddedMsgLen (rcAD <> emHeader) msg
+  let msg' = encodeEncRatchetMessage v EncRatchetMessage {emHeader, emBody, emAuthTag}
+      -- state.Ns += 1
       rc' =
         rc
           { rcSnd = Just sr {rcCKs = ck'},
@@ -890,7 +872,7 @@ rcEncryptHeader rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, r
             rcVersion = rcVersion',
             rcKEM = if pqEnc_ == Just PQEncOff then (\rck -> rck {rcKEMs = Nothing}) <$> rcKEM else rcKEM
           }
-  pure (msgEncryptKey, rc')
+  pure (msg', rc')
   where
     -- header = HEADER_PQ2(
     --   dh = state.DHRs.public,
@@ -913,23 +895,6 @@ rcEncryptHeader rc@Ratchet {rcSnd = Just sr@SndRatchet {rcCKs, rcHKs}, rcDHRs, r
       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)
@@ -1155,35 +1120,14 @@ instance AlgorithmI a => ToJSON (Ratchet a) where
 instance AlgorithmI a => FromJSON (Ratchet a) where
   parseJSON = $(JQ.mkParseJSON defaultJSON ''Ratchet)
 
-instance AlgorithmI a => ToField (Ratchet a) where toField = toField . Binary . LB.toStrict . J.encode
+instance AlgorithmI a => ToField (Ratchet a) where toField = toField . LB.toStrict . J.encode
 
 instance (AlgorithmI a, Typeable a) => FromField (Ratchet a) where fromField = blobFieldDecoder J.eitherDecodeStrict'
 
-instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField (BI pqEnc)
+instance ToField PQEncryption where toField (PQEncryption pqEnc) = toField pqEnc
 
-instance FromField PQEncryption where 
-#if defined(dbPostgres)
-  fromField f dat = PQEncryption . unBI <$> fromField f dat
-#else
-  fromField f = PQEncryption . unBI <$> fromField f
-#endif
+instance FromField PQEncryption where fromField f = PQEncryption <$> fromField f
 
-instance ToField PQSupport where toField (PQSupport pqEnc) = toField (BI pqEnc)
+instance ToField PQSupport where toField (PQSupport pqEnc) = toField pqEnc
 
-instance FromField PQSupport where
-#if defined(dbPostgres)
-  fromField f dat = PQSupport . unBI <$> fromField f dat
-#else
-  fromField f = PQSupport . unBI <$> fromField f
-#endif
-
-instance Encoding (MsgEncryptKey a) where
-  smpEncode MsgEncryptKey {msgRcVersion = v, msgKey, msgRcAD, msgEncHeader} =
-    smpEncode (v, msgRcAD, msgKey, Large msgEncHeader)
-  smpP = do
-    (v, msgRcAD, msgKey, Large msgEncHeader) <- smpP
-    pure MsgEncryptKey {msgRcVersion = v, msgRcAD, msgKey, msgEncHeader}
-
-instance AlgorithmI a => ToField (MsgEncryptKey a) where toField = toField . Binary . smpEncode
-
-instance (AlgorithmI a, Typeable a) => FromField (MsgEncryptKey a) where fromField = blobFieldDecoder smpDecode
+instance FromField PQSupport where fromField f = PQSupport <$> fromField f

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings where
@@ -10,8 +9,9 @@ import Data.Bifunctor (bimap)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
+import Database.SQLite.Simple.FromField
+import Database.SQLite.Simple.ToField
 import Foreign (nullPtr)
-import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
@@ -121,11 +121,7 @@ instance ToField KEMSharedKey where
   toField (KEMSharedKey k) = toField (BA.convert k :: ByteString)
 
 instance FromField KEMSharedKey where
-#if defined(dbPostgres)
-  fromField f dat = KEMSharedKey . BA.convert @ByteString <$> fromField f dat
-#else
   fromField f = KEMSharedKey . BA.convert @ByteString <$> fromField f
-#endif
 
 instance ToJSON KEMSharedKey where
   toJSON = strToJSON

src/Simplex/Messaging/Notifications/Client.hs

@@ -2,31 +2,24 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Notifications.Client where
 
 import Control.Monad.Except
 import Control.Monad.Trans.Except
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 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.Protocol (ErrorType, pattern NoEntity)
-import Simplex.Messaging.Transport (TLS, Transport (..))
 
 type NtfClient = ProtocolClient NTFVersion ErrorType NtfResponse
 
 type NtfClientError = ProtocolClientError ErrorType
 
 defaultNTFClientConfig :: ProtocolClientConfig NTFVersion
-defaultNTFClientConfig =
-  (defaultClientConfig (Just supportedNTFHandshakes) False supportedClientNTFVRange)
-    {defaultTransport = ("443", transport @TLS)}
-{-# INLINE defaultNTFClientConfig #-}
+defaultNTFClientConfig = defaultClientConfig (Just supportedNTFHandshakes) supportedClientNTFVRange
 
 ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> ExceptT NtfClientError IO (NtfTokenId, C.PublicKeyX25519)
 ntfRegisterToken c pKey newTkn =
@@ -58,30 +51,12 @@ ntfCreateSubscription c pKey newSub =
     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
-  where
-    cs = L.map (\newSub -> (Just pKey, NoEntity, NtfCmd SSubscription $ SNEW newSub)) newSubs
-    process (Response _ r) = case r of
-      Right (NRSubId subId) -> Right subId
-      Right r' -> Left $ unexpectedResponse r'
-      Left e -> Left e
-
 ntfCheckSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO NtfSubStatus
 ntfCheckSubscription c pKey subId =
   sendNtfCommand c (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
-  where
-    cs = L.map (\subId -> (Just pKey, subId, 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
 

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -11,7 +11,7 @@
 
 module Simplex.Messaging.Notifications.Protocol where
 
-import Control.Applicative (optional, (<|>))
+import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
@@ -20,19 +20,18 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Kind
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 import Data.Maybe (isNothing)
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
-import Data.Time.Clock.System
 import Data.Type.Equality
 import Data.Word (Word16)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
-import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake)
+import Simplex.Messaging.Notifications.Transport (NTFVersion, ntfClientHandshake)
+import Simplex.Messaging.Parsers (fromTextField_)
 import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..))
 import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
 
@@ -295,18 +294,12 @@ 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')
-      where
-        stat'
-          | v >= invalidReasonNTFVersion = stat
-          | otherwise = case stat of
-              NTInvalid _ -> NTInvalid Nothing
-              _ -> stat
+    NRTkn stat -> e (NRTkn_, ' ', stat)
     NRSub stat -> e (NRSub_, ' ', stat)
     NRPong -> e NRPong_
     where
@@ -433,30 +426,6 @@ instance FromJSON DeviceToken where
     t <- encodeUtf8 <$> o .: "token"
     pure $ DeviceToken pp t
 
--- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
--- because strEncode of NonEmpty list uses comma for separator,
--- and encoding of PNMessageData's smpQueue has comma in list of hosts
-encodePNMessages :: NonEmpty PNMessageData -> ByteString
-encodePNMessages = B.intercalate ";" . map strEncode . L.toList
-
-pnMessagesP :: A.Parser (NonEmpty PNMessageData)
-pnMessagesP = L.fromList <$> strP `A.sepBy1` A.char ';'
-
-data PNMessageData = PNMessageData
-  { smpQueue :: SMPQueueNtf,
-    ntfTs :: SystemTime,
-    nmsgNonce :: C.CbNonce,
-    encNMsgMeta :: EncNMsgMeta
-  }
-  deriving (Show)
-
-instance StrEncoding PNMessageData where
-  strEncode PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} =
-    strEncode (smpQueue, ntfTs, nmsgNonce, encNMsgMeta)
-  strP = do
-    (smpQueue, ntfTs, nmsgNonce, encNMsgMeta) <- strP
-    pure PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
-
 type NtfEntityId = EntityId
 
 type NtfSubscriptionId = NtfEntityId
@@ -474,8 +443,6 @@ data NtfSubStatus
     NSInactive
   | -- | END received
     NSEnd
-  | -- | DELD received (connection was deleted)
-    NSDeleted
   | -- | SMP AUTH error
     NSAuth
   | -- | SMP error other than AUTH
@@ -489,7 +456,6 @@ ntfShouldSubscribe = \case
   NSActive -> True
   NSInactive -> True
   NSEnd -> False
-  NSDeleted -> False
   NSAuth -> False
   NSErr _ -> False
 
@@ -500,7 +466,6 @@ instance Encoding NtfSubStatus where
     NSActive -> "ACTIVE"
     NSInactive -> "INACTIVE"
     NSEnd -> "END"
-    NSDeleted -> "DELETED"
     NSAuth -> "AUTH"
     NSErr err -> "ERR " <> err
   smpP =
@@ -510,7 +475,6 @@ instance Encoding NtfSubStatus where
       "ACTIVE" -> pure NSActive
       "INACTIVE" -> pure NSInactive
       "END" -> pure NSEnd
-      "DELETED" -> pure NSDeleted
       "AUTH" -> pure NSAuth
       "ERR" -> NSErr <$> (A.space *> A.takeByteString)
       _ -> fail "bad NtfSubStatus"
@@ -525,7 +489,7 @@ data NtfTknStatus
   | -- | state after registration (TNEW)
     NTRegistered
   | -- | if initial notification failed (push provider error) or verification failed
-    NTInvalid (Maybe NTInvalidReason)
+    NTInvalid
   | -- | Token confirmed via notification (accepted by push provider or verification code received by client)
     NTConfirmed
   | -- | after successful verification (TVFY)
@@ -538,7 +502,7 @@ instance Encoding NtfTknStatus where
   smpEncode = \case
     NTNew -> "NEW"
     NTRegistered -> "REGISTERED"
-    NTInvalid r_ -> "INVALID" <> maybe "" (\r -> ',' `B.cons` strEncode r) r_
+    NTInvalid -> "INVALID"
     NTConfirmed -> "CONFIRMED"
     NTActive -> "ACTIVE"
     NTExpired -> "EXPIRED"
@@ -546,33 +510,12 @@ instance Encoding NtfTknStatus where
     A.takeTill (== ' ') >>= \case
       "NEW" -> pure NTNew
       "REGISTERED" -> pure NTRegistered
-      "INVALID" -> NTInvalid <$> optional (A.char ',' *> strP)
+      "INVALID" -> pure NTInvalid
       "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

src/Simplex/Messaging/Notifications/Server.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -19,17 +17,12 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
-import Data.Bifunctor (first)
-import qualified Data.ByteString.Builder as BLD
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Either (partitionEithers)
 import Data.Functor (($>))
 import Data.IORef
 import Data.Int (Int64)
-import qualified Data.IntSet as IS
-import Data.List (intercalate, partition, sort)
+import Data.List (intercalate, sort)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
@@ -40,43 +33,34 @@ import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import GHC.IORef (atomicSwapIORef)
-import GHC.Stats (getRTSStats)
-import Network.Socket (ServiceName, Socket, socketToHandle)
+import Network.Socket (ServiceName)
 import Simplex.Messaging.Client (ProtocolClientError (..), SMPClientError, ServerTransmission (..))
 import Simplex.Messaging.Client.Agent
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
-import Simplex.Messaging.Notifications.Server.Control
 import Simplex.Messaging.Notifications.Server.Env
-import Simplex.Messaging.Notifications.Server.Push.APNS (PushNotification (..), PushProviderError (..))
+import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..), PushNotification (..), PushProviderError (..))
 import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport
-import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, pattern NoEntity, pattern SMPServer, encodeTransmission, tGet, tPut)
+import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), ProtocolServer (host), SMPServer, SignedTransmission, Transmission, pattern NoEntity, encodeTransmission, tGet, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
-import Simplex.Messaging.Server.Control (CPClientRole (..))
-import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getSystemDate)
-import Simplex.Messaging.Server.Stats (PeriodStats (..), PeriodStatCounts (..), periodStatCounts, updatePeriodStats)
-import Simplex.Messaging.TMap (TMap)
+import Simplex.Messaging.Server.Stats
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..), defaultSupportedParams)
-import Simplex.Messaging.Transport.Buffer (trimCR)
-import Simplex.Messaging.Transport.Server (AddHTTP, runTransportServer, runLocalTCPServer)
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..))
+import Simplex.Messaging.Transport.Server (runTransportServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
-import System.IO (BufferMode (..), hClose, hPrint, hPutStrLn, hSetBuffering, hSetNewlineMode, universalNewlineMode)
+import System.IO (BufferMode (..), hPutStrLn, hSetBuffering)
 import System.Mem.Weak (deRefWeak)
-import UnliftIO (IOMode (..), UnliftIO, askUnliftIO, async, uninterruptibleCancel, unliftIO, withFile)
+import UnliftIO (IOMode (..), async, uninterruptibleCancel, withFile)
 import UnliftIO.Concurrent (forkIO, killThread, mkWeakThreadId)
 import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
 import UnliftIO.STM
-#if MIN_VERSION_base(4,18,0)
-import GHC.Conc (listThreads)
-#endif
 
 runNtfServer :: NtfServerConfig -> IO ()
 runNtfServer cfg = do
@@ -90,19 +74,18 @@ type M a = ReaderT NtfEnv IO a
 
 ntfServer :: NtfServerConfig -> TMVar Bool -> M ()
 ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
-  restoreServerLastNtfs
   restoreServerStats
   s <- asks subscriber
   ps <- asks pushServer
   resubscribe s
-  raceAny_ (ntfSubscriber s : ntfPush ps : map runServer transports <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
+  raceAny_ (ntfSubscriber s : ntfPush ps : map runServer transports <> serverStatsThread_ cfg) `finally` stopServer
   where
-    runServer :: (ServiceName, ATransport, AddHTTP) -> M ()
-    runServer (tcpPort, ATransport t, _addHTTP) = do
-      srvCreds <- asks tlsServerCreds
-      serverSignKey <- either fail pure $ fromTLSCredentials srvCreds
+    runServer :: (ServiceName, ATransport) -> M ()
+    runServer (tcpPort, ATransport t) = do
+      serverParams <- asks tlsServerParams
+      serverSignKey <- either fail pure . fromTLSCredentials $ tlsServerCredentials serverParams
       env <- ask
-      liftIO $ runTransportServer started tcpPort defaultSupportedParams srvCreds (Just supportedNTFHandshakes) tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
+      liftIO $ runTransportServer started tcpPort serverParams tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
     fromTLSCredentials (_, pk) = C.x509ToPrivate (pk, []) >>= C.privKey
 
     runClient :: Transport c => C.APrivateSignKey -> TProxy c -> c -> M ()
@@ -116,15 +99,11 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
 
     stopServer :: M ()
     stopServer = do
-      logInfo "Saving server state..."
-      saveServer
+      withNtfLog closeStoreLog
+      saveServerStats
       NtfSubscriber {smpSubscribers, smpAgent} <- asks subscriber
       liftIO $ readTVarIO smpSubscribers >>= mapM_ (\SMPSubscriber {subThreadId} -> readTVarIO subThreadId >>= mapM_ (deRefWeak >=> mapM_ killThread))
       liftIO $ closeSMPClientAgent smpAgent
-      logInfo "Server stopped"
-
-    saveServer :: M ()
-    saveServer = withNtfLog closeStoreLog >> saveServerLastNtfs >> saveServerStats
 
     serverStatsThread_ :: NtfServerConfig -> [M ()]
     serverStatsThread_ NtfServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
@@ -136,8 +115,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       logInfo $ "server stats log enabled: " <> T.pack statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, tknReplaced, subCreated, subDeleted, ntfReceived, ntfDelivered, ntfFailed, ntfCronDelivered, ntfCronFailed, ntfVrfQueued, ntfVrfDelivered, ntfVrfFailed, ntfVrfInvalidTkn, activeTokens, activeSubs} <-
-        asks serverStats
+      NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs} <- asks serverStats
       let interval = 1000000 * logInterval
       forever $ do
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -147,18 +125,10 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
           tknCreated' <- atomicSwapIORef tknCreated 0
           tknVerified' <- atomicSwapIORef tknVerified 0
           tknDeleted' <- atomicSwapIORef tknDeleted 0
-          tknReplaced' <- atomicSwapIORef tknReplaced 0
           subCreated' <- atomicSwapIORef subCreated 0
           subDeleted' <- atomicSwapIORef subDeleted 0
           ntfReceived' <- atomicSwapIORef ntfReceived 0
           ntfDelivered' <- atomicSwapIORef ntfDelivered 0
-          ntfFailed' <- atomicSwapIORef ntfFailed 0
-          ntfCronDelivered' <- atomicSwapIORef ntfCronDelivered 0
-          ntfCronFailed' <- atomicSwapIORef ntfCronFailed 0
-          ntfVrfQueued' <- atomicSwapIORef ntfVrfQueued 0
-          ntfVrfDelivered' <- atomicSwapIORef ntfVrfDelivered 0
-          ntfVrfFailed' <- atomicSwapIORef ntfVrfFailed 0
-          ntfVrfInvalidTkn' <- atomicSwapIORef ntfVrfInvalidTkn 0
           tkn <- liftIO $ periodStatCounts activeTokens ts
           sub <- liftIO $ periodStatCounts activeSubs ts
           hPutStrLn h $
@@ -177,156 +147,10 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
                 monthCount tkn,
                 dayCount sub,
                 weekCount sub,
-                monthCount sub,
-                show tknReplaced',
-                show ntfFailed',
-                show ntfCronDelivered',
-                show ntfCronFailed',
-                show ntfVrfQueued',
-                show ntfVrfDelivered',
-                show ntfVrfFailed',
-                show ntfVrfInvalidTkn'
+                monthCount sub
               ]
         liftIO $ threadDelay' interval
 
-    controlPortThread_ :: NtfServerConfig -> [M ()]
-    controlPortThread_ NtfServerConfig {controlPort = Just port} = [runCPServer port]
-    controlPortThread_ _ = []
-
-    runCPServer :: ServiceName -> M ()
-    runCPServer port = do
-      cpStarted <- newEmptyTMVarIO
-      u <- askUnliftIO
-      liftIO $ do
-        labelMyThread "control port server"
-        runLocalTCPServer cpStarted port $ runCPClient u
-      where
-        runCPClient :: UnliftIO (ReaderT NtfEnv IO) -> Socket -> IO ()
-        runCPClient u sock = do
-          labelMyThread "control port client"
-          h <- socketToHandle sock ReadWriteMode
-          hSetBuffering h LineBuffering
-          hSetNewlineMode h universalNewlineMode
-          hPutStrLn h "Ntf server control port\n'help' for supported commands"
-          role <- newTVarIO CPRNone
-          cpLoop h role
-          where
-            cpLoop h role = do
-              s <- trimCR <$> B.hGetLine h
-              case strDecode s of
-                Right CPQuit -> hClose h
-                Right cmd -> logCmd s cmd >> processCP h role cmd >> cpLoop h role
-                Left err -> hPutStrLn h ("error: " <> err) >> cpLoop h role
-            logCmd s cmd = when shouldLog $ logWarn $ "ControlPort: " <> tshow s
-              where
-                shouldLog = case cmd of
-                  CPAuth _ -> False
-                  CPHelp -> False
-                  CPQuit -> False
-                  CPSkip -> False
-                  _ -> True
-            processCP h role = \case
-              CPAuth auth -> atomically $ writeTVar role $! newRole cfg
-                where
-                  newRole NtfServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
-                    | Just auth == admin = CPRAdmin
-                    | Just auth == user = CPRUser
-                    | otherwise = CPRNone
-              CPStats -> withUserRole $ do
-                ss <- unliftIO u $ asks serverStats
-                let getStat :: (NtfServerStats -> IORef a) -> IO a
-                    getStat var = readIORef (var ss)
-                    putStat :: Show a => String -> (NtfServerStats -> IORef a) -> IO ()
-                    putStat label var = getStat var >>= \v -> hPutStrLn h $ label <> ": " <> show v
-                putStat "fromTime" fromTime
-                putStat "tknCreated" tknCreated
-                putStat "tknVerified" tknVerified
-                putStat "tknDeleted" tknDeleted
-                putStat "tknReplaced" tknReplaced
-                putStat "subCreated" subCreated
-                putStat "subDeleted" subDeleted
-                putStat "ntfReceived" ntfReceived
-                putStat "ntfDelivered" ntfDelivered
-                putStat "ntfFailed" ntfFailed
-                putStat "ntfCronDelivered" ntfCronDelivered
-                putStat "ntfCronFailed" ntfCronFailed
-                putStat "ntfVrfQueued" ntfVrfQueued
-                putStat "ntfVrfDelivered" ntfVrfDelivered
-                putStat "ntfVrfFailed" ntfVrfFailed
-                putStat "ntfVrfInvalidTkn" ntfVrfInvalidTkn
-                getStat (day . activeTokens) >>= \v -> hPutStrLn h $ "daily active tokens: " <> show (IS.size v)
-                getStat (day . activeSubs) >>= \v -> hPutStrLn h $ "daily active subscriptions: " <> show (IS.size v)
-              CPStatsRTS -> tryAny getRTSStats >>= either (hPrint h) (hPrint h)
-              CPServerInfo -> readTVarIO role >>= \case
-                CPRNone -> do
-                  logError "Unauthorized control port command"
-                  hPutStrLn h "AUTH"
-                r -> do
-#if MIN_VERSION_base(4,18,0)
-                  threads <- liftIO listThreads
-                  hPutStrLn h $ "Threads: " <> show (length threads)
-#else
-                  hPutStrLn h "Threads: not available on GHC 8.10"
-#endif
-                  NtfEnv {subscriber, pushServer} <-  unliftIO u ask
-                  let NtfSubscriber {smpSubscribers, smpAgent = a} = subscriber
-                      NtfPushServer {pushQ} = pushServer
-                      SMPClientAgent {smpClients, smpSessions, srvSubs, pendingSrvSubs, smpSubWorkers} = a
-                  putSMPWorkers a "SMP subcscribers" smpSubscribers
-                  putSMPWorkers a "SMP clients" smpClients
-                  putSMPWorkers a "SMP subscription workers" smpSubWorkers
-                  sessions <- readTVarIO smpSessions
-                  hPutStrLn h $ "SMP sessions count: " <> show (M.size sessions)
-                  putSMPSubs a "SMP subscriptions" srvSubs
-                  putSMPSubs a "Pending SMP subscriptions" pendingSrvSubs
-                  sz <- atomically $ lengthTBQueue pushQ
-                  hPutStrLn h $ "Push notifications queue length: " <> show sz
-                  where
-                    putSMPSubs :: SMPClientAgent -> String -> TMap SMPServer (TMap SMPSub a) -> IO ()
-                    putSMPSubs a name v = do
-                      subs <- readTVarIO v
-                      (totalCnt, ownCount, otherCnt, servers, ownByServer) <- foldM countSubs (0, 0, 0, [], M.empty) $ M.assocs subs
-                      showServers a name servers
-                      hPutStrLn h $ name <> " total: " <> show totalCnt
-                      hPutStrLn h $ name <> " on own servers: " <> show ownCount
-                      when (r == CPRAdmin && not (null ownByServer)) $
-                        forM_ (M.assocs ownByServer) $ \(SMPServer (host :| _) _ _, cnt) ->
-                          hPutStrLn h $ name <> " on " <> B.unpack (strEncode host) <> ": " <> show cnt
-                      hPutStrLn h $ name <> " on other servers: " <> show otherCnt
-                      where
-                        countSubs :: (Int, Int, Int, [SMPServer], M.Map SMPServer Int) -> (SMPServer, TMap SMPSub a) -> IO (Int, Int, Int, [SMPServer], M.Map SMPServer Int)
-                        countSubs (!totalCnt, !ownCount, !otherCnt, !servers, !ownByServer) (srv, srvSubs) = do
-                          cnt <- M.size <$> readTVarIO srvSubs
-                          let totalCnt' = totalCnt + cnt
-                              ownServer = isOwnServer a srv
-                              (ownCount', otherCnt')
-                                | ownServer = (ownCount + cnt, otherCnt)
-                                | otherwise = (ownCount, otherCnt + cnt)
-                              servers' = if cnt > 0 then srv : servers else servers
-                              ownByServer'
-                                | r == CPRAdmin && ownServer && cnt > 0 = M.alter (Just . maybe cnt (+ cnt)) srv ownByServer
-                                | otherwise = ownByServer
-                          pure (totalCnt', ownCount', otherCnt', servers', ownByServer')
-                    putSMPWorkers :: SMPClientAgent -> String -> TMap SMPServer a -> IO ()
-                    putSMPWorkers a name v = readTVarIO v >>= showServers a name . M.keys
-                    showServers :: SMPClientAgent -> String -> [SMPServer] -> IO ()
-                    showServers a name srvs = do
-                      let (ownSrvs, otherSrvs) = partition (isOwnServer a) srvs
-                      hPutStrLn h $ name <> " own servers count: " <> show (length ownSrvs)
-                      when (r == CPRAdmin) $ hPutStrLn h $ name <> " own servers: " <> intercalate "," (sort $ map (\(SMPServer (host :| _) _ _) -> B.unpack $ strEncode host) ownSrvs)
-                      hPutStrLn h $ name <> " other servers count: " <> show (length otherSrvs)
-              CPHelp -> hPutStrLn h "commands: stats, stats-rts, server-info, help, quit"
-              CPQuit -> pure ()
-              CPSkip -> pure ()
-              where
-                withUserRole action =
-                  readTVarIO role >>= \case
-                    CPRAdmin -> action
-                    CPRUser -> action
-                    _ -> do
-                      logError "Unauthorized control port command"
-                      hPutStrLn h "AUTH"
-
 resubscribe :: NtfSubscriber -> M ()
 resubscribe NtfSubscriber {newSubQ} = do
   logInfo "Preparing SMP resubscriptions..."
@@ -395,16 +219,13 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
               NtfPushServer {pushQ} <- asks pushServer
               stats <- asks serverStats
               liftIO $ updatePeriodStats (activeSubs stats) ntfId
-              tkn_ <- atomically (findNtfSubscriptionToken st smpQueue)
-              forM_ tkn_ $ \tkn -> do
-                let newNtf = PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
-                lastNtfs <- liftIO $ addTokenLastNtf st (ntfTknId tkn) newNtf
-                atomically (writeTBQueue pushQ (tkn, PNMessage lastNtfs))
+              atomically $
+                findNtfSubscriptionToken st smpQueue
+                  >>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage (PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} :| [])))
               incNtfStat ntfReceived
             Right SMP.END ->
               whenM (atomically $ activeClientSession' ca sessionId srv) $
                 updateSubStatus smpQueue NSEnd
-            Right SMP.DELD -> updateSubStatus smpQueue NSDeleted
             Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
             Right _ -> logError "SMP server unexpected response"
             Left e -> logError $ "SMP client error: " <> tshow e
@@ -462,35 +283,35 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
 
 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
-  (tkn@NtfTknData {ntfTknId, token = t@(DeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  (tkn@NtfTknData {ntfTknId, token = DeviceToken pp _, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
   liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
   status <- readTVarIO tknStatus
   case ntf of
-    PNVerification _ ->
-      deliverNotification pp tkn ntf >>= \case
-        Right _ -> do
-          status_ <- atomically $ stateTVar tknStatus $ \case
-            NTActive -> (Nothing, NTActive)
-            NTConfirmed -> (Nothing, NTConfirmed)
-            _ -> (Just NTConfirmed, NTConfirmed)
-          forM_ status_ $ \status' -> withNtfLog $ \sl -> logTokenStatus sl ntfTknId status'
-          incNtfStatT t ntfVrfDelivered
-        Left _ -> incNtfStatT t ntfVrfFailed
+    PNVerification _
+      | status /= NTInvalid && status /= NTExpired ->
+          deliverNotification pp tkn ntf >>= \case
+            Right _ -> do
+              status_ <- atomically $ stateTVar tknStatus $ \case
+                NTActive -> (Nothing, NTActive)
+                NTConfirmed -> (Nothing, NTConfirmed)
+                _ -> (Just NTConfirmed, NTConfirmed)
+              forM_ status_ $ \status' -> withNtfLog $ \sl -> logTokenStatus sl ntfTknId status'
+            _ -> pure ()
+      | otherwise -> logError "bad notification token status"
     PNCheckMessages -> checkActiveTkn status $ do
-      deliverNotification pp tkn ntf
-        >>= incNtfStatT t . (\case Left _ -> ntfCronFailed; Right () -> ntfCronDelivered)
+      void $ deliverNotification pp tkn ntf
     PNMessage {} -> checkActiveTkn status $ do
       stats <- asks serverStats
       liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
-      deliverNotification pp tkn ntf
-        >>= incNtfStatT t . (\case Left _ -> ntfFailed; Right () -> ntfDelivered)
+      void $ deliverNotification pp tkn ntf
+      incNtfStat ntfDelivered
   where
     checkActiveTkn :: NtfTknStatus -> M () -> M ()
     checkActiveTkn status action
       | status == NTActive = action
       | otherwise = liftIO $ logError "bad notification token status"
     deliverNotification :: PushProvider -> NtfTknData -> PushNotification -> M (Either PushProviderError ())
-    deliverNotification pp tkn@NtfTknData {ntfTknId} ntf = do
+    deliverNotification pp tkn ntf = do
       deliver <- liftIO $ getPushClient s pp
       liftIO (runExceptT $ deliver tkn ntf) >>= \case
         Right _ -> pure $ Right ()
@@ -498,19 +319,15 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
           PPConnection _ -> retryDeliver
           PPRetryLater -> retryDeliver
           PPCryptoError _ -> err e
-          PPResponseError {} -> err e
-          PPTokenInvalid r -> updateTknStatus tkn (NTInvalid $ Just r) >> err e
+          PPResponseError _ _ -> err e
+          PPTokenInvalid -> updateTknStatus tkn NTInvalid >> err e
           PPPermanentError -> err e
       where
         retryDeliver :: M (Either PushProviderError ())
         retryDeliver = do
           deliver <- liftIO $ newPushClient s pp
-          liftIO (runExceptT $ deliver tkn ntf) >>= \case
-            Right _ -> pure $ Right ()
-            Left e -> case e of
-              PPTokenInvalid r -> updateTknStatus tkn (NTInvalid $ Just r) >> err e
-              _ -> err e
-        err e = logError ("Push provider error (" <> tshow pp <> ", " <> tshow ntfTknId <> "): " <> tshow e) $> Left e
+          liftIO (runExceptT $ deliver tkn ntf) >>= either err (pure . Right)
+        err e = logError (T.pack $ "Push provider error (" <> show pp <> "): " <> show e) $> Left e
 
 updateTknStatus :: NtfTknData -> NtfTknStatus -> M ()
 updateTknStatus NtfTknData {ntfTknId, tknStatus} status = do
@@ -536,34 +353,29 @@ clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connecte
 
 receive :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> M ()
 receive th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
-  ts <- L.toList <$> liftIO (tGet th)
-  atomically . (writeTVar rcvActiveAt $!) =<< liftIO getSystemTime
-  (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
-  write sndQ errs
-  write rcvQ cmds
+  ts <- liftIO $ tGet th
+  forM_ ts $ \t@(_, _, (corrId, entId, cmdOrError)) -> do
+    atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
+    logDebug "received transmission"
+    case cmdOrError of
+      Left e -> write sndQ (corrId, entId, NRErr e)
+      Right cmd ->
+        verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd >>= \case
+          VRVerified req -> write rcvQ req
+          VRFailed -> write sndQ (corrId, entId, NRErr AUTH)
   where
-    cmdAction t@(_, _, (corrId, entId, cmdOrError)) =
-      case cmdOrError of
-        Left e -> do
-          logError $ "invalid client request: " <> tshow e
-          pure $ Left (corrId, entId, NRErr e)
-        Right cmd ->
-          verified =<< verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd
-          where
-            verified = \case
-              VRVerified req -> pure $ Right req
-              VRFailed -> do
-                logError "unauthorized client request"
-                pure $ Left (corrId, entId, NRErr AUTH)
-    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
+    write q t = atomically $ writeTBQueue q t
 
 send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
 send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
-  ts <- atomically $ readTBQueue sndQ
-  void . liftIO $ tPut h $ L.map (\t -> Right (Nothing, encodeTransmission params t)) ts
+  t <- atomically $ readTBQueue sndQ
+  void . liftIO $ tPut h [Right (Nothing, encodeTransmission params t)]
   atomically . (writeTVar sndActiveAt $!) =<< liftIO getSystemTime
 
-data VerificationResult = VRVerified (Maybe NtfTknData, NtfRequest) | VRFailed
+-- instance Show a => Show (TVar a) where
+--   show x = unsafePerformIO $ show <$> readTVarIO x
+
+data VerificationResult = VRVerified NtfRequest | VRFailed
 
 verifyNtfTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
 verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
@@ -577,34 +389,34 @@ verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
             Just t@NtfTknData {tknVerifyKey}
               | k == tknVerifyKey -> verifiedTknCmd t c
               | otherwise -> VRFailed
-            Nothing -> VRVerified (Nothing, NtfReqNew corrId (ANE SToken tkn))
+            _ -> VRVerified (NtfReqNew corrId (ANE SToken tkn))
           else VRFailed
     NtfCmd SToken c -> do
-      t_ <- liftIO $ getNtfTokenIO st entId
+      t_ <- atomically $ getNtfToken st entId
       verifyToken t_ (`verifiedTknCmd` c)
     NtfCmd SSubscription c@(SNEW sub@(NewNtfSub tknId smpQueue _)) -> do
       s_ <- atomically $ findNtfSubscription st smpQueue
       case s_ of
         Nothing -> do
           t_ <- atomically $ getActiveNtfToken st tknId
-          verifyToken' t_ $ VRVerified (t_, NtfReqNew corrId (ANE SSubscription sub))
+          verifyToken' t_ $ VRVerified (NtfReqNew corrId (ANE SSubscription sub))
         Just s@NtfSubData {tokenId = subTknId} ->
           if subTknId == tknId
             then do
               t_ <- atomically $ getActiveNtfToken st subTknId
-              verifyToken' t_ $ verifiedSubCmd t_ s c
+              verifyToken' t_ $ verifiedSubCmd s c
             else pure $ maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
-    NtfCmd SSubscription PING -> pure $ VRVerified (Nothing, NtfReqPing corrId entId)
+    NtfCmd SSubscription PING -> pure $ VRVerified $ NtfReqPing corrId entId
     NtfCmd SSubscription c -> do
-      s_ <- liftIO $ getNtfSubscriptionIO st entId
+      s_ <- atomically $ getNtfSubscription st entId
       case s_ of
         Just s@NtfSubData {tokenId = subTknId} -> do
           t_ <- atomically $ getActiveNtfToken st subTknId
-          verifyToken' t_ $ verifiedSubCmd t_ s c
+          verifyToken' t_ $ verifiedSubCmd s c
         _ -> pure $ maybe False (dummyVerifyCmd auth_ authorized) tAuth `seq` VRFailed
   where
-    verifiedTknCmd t c = VRVerified (Just t, NtfReqCmd SToken (NtfTkn t) (corrId, entId, c))
-    verifiedSubCmd t_ s c = VRVerified (t_, NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c))
+    verifiedTknCmd t c = VRVerified (NtfReqCmd SToken (NtfTkn t) (corrId, entId, c))
+    verifiedSubCmd s c = VRVerified (NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c))
     verifyToken :: Maybe NtfTknData -> (NtfTknData -> VerificationResult) -> M VerificationResult
     verifyToken t_ positiveVerificationResult =
       pure $ case t_ of
@@ -618,17 +430,11 @@ verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
 
 client :: NtfServerClient -> NtfSubscriber -> NtfPushServer -> M ()
 client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPushServer {pushQ, intervalNotifiers} =
-  forever $ do
-    ts <- liftIO getSystemDate
+  forever $
     atomically (readTBQueue rcvQ)
-      >>= mapM (\(tkn_, req) -> updateTokenDate ts tkn_ >> processCommand req)
+      >>= processCommand
       >>= atomically . writeTBQueue sndQ
   where
-    updateTokenDate :: RoundedSystemTime -> Maybe NtfTknData -> M ()
-    updateTokenDate ts' = mapM_ $ \NtfTknData {ntfTknId, tknUpdatedAt} -> do
-      let t' = Just ts'
-      t <- atomically $ swapTVar tknUpdatedAt t'
-      unless (t' == t) $ withNtfLog $ \s -> logUpdateTokenTime s ntfTknId ts'
     processCommand :: NtfRequest -> M (Transmission NtfResponse)
     processCommand = \case
       NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn token _ dhPubKey)) -> do
@@ -638,11 +444,9 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
         let dhSecret = C.dh' dhPubKey srvDhPrivKey
         tknId <- getId
         regCode <- getRegCode
-        ts <- liftIO $ getSystemDate
-        tkn <- liftIO $ mkNtfTknData tknId newTkn ks dhSecret regCode ts
+        tkn <- atomically $ mkNtfTknData tknId newTkn ks dhSecret regCode
         atomically $ addNtfToken st tknId tkn
         atomically $ writeTBQueue pushQ (tkn, PNVerification regCode)
-        incNtfStatT token ntfVrfQueued
         withNtfLog (`logCreateToken` tkn)
         incNtfStatT token tknCreated
         pure (corrId, NoEntity, NRTknId tknId srvDhPubKey)
@@ -656,7 +460,6 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
             if tknDhSecret == dhSecret
               then do
                 atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode)
-                incNtfStatT token ntfVrfQueued
                 pure $ NRTknId ntfTknId srvDhPubKey
               else pure $ NRErr AUTH
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
@@ -684,9 +487,9 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
               let tkn' = tkn {token = token', tknRegCode = regCode}
               addNtfToken st tknId tkn'
               writeTBQueue pushQ (tkn', PNVerification regCode)
-            incNtfStatT token ntfVrfQueued
             withNtfLog $ \s -> logUpdateToken s tknId token' regCode
-            incNtfStatT token tknReplaced
+            incNtfStatT token tknDeleted
+            incNtfStatT token tknCreated
             pure NROk
           TDEL -> do
             logDebug "TDEL"
@@ -784,44 +587,6 @@ incNtfStat statSel = do
   stats <- asks serverStats
   liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
 
-saveServerLastNtfs :: M ()
-saveServerLastNtfs = asks (storeLastNtfsFile . config) >>= mapM_ saveLastNtfs
-  where
-    saveLastNtfs f = do
-      logInfo $ "saving last notifications to file " <> T.pack f
-      NtfStore {tokenLastNtfs} <- asks store
-      liftIO . withFile f WriteMode $ \h ->
-        readTVarIO tokenLastNtfs >>= mapM_ (saveTokenLastNtfs h) . M.assocs
-      logInfo "notifications saved"
-      where
-        -- reverse on save, to save notifications in order, will become reversed again when restoring.
-        saveTokenLastNtfs h (tknId, v) = BLD.hPutBuilder h . encodeLastNtfs tknId . L.reverse =<< readTVarIO v
-        encodeLastNtfs tknId = mconcat . L.toList . L.map (\ntf -> BLD.byteString (strEncode $ TNMRv1 tknId ntf) <> BLD.char8 '\n')
-
-restoreServerLastNtfs :: M ()
-restoreServerLastNtfs =
-  asks (storeLastNtfsFile . config) >>= mapM_ restoreLastNtfs
-  where
-    restoreLastNtfs f =
-      whenM (doesFileExist f) $ do
-        logInfo $ "restoring last notifications from file " <> T.pack f
-        st <- asks store
-        runExceptT (liftIO (LB.readFile f) >>= mapM (restoreNtf st) . LB.lines) >>= \case
-          Left e -> do
-            logError . T.pack $ "error restoring last notifications: " <> e
-            liftIO exitFailure
-          Right _ -> do
-            renameFile f $ f <> ".bak"
-            logInfo "last notifications restored"
-      where
-        restoreNtf st s' = do
-          TNMRv1 tknId ntf <- liftEither . first (ntfErr "parsing") $ strDecode s
-          liftIO $ storeTokenLastNtf st tknId ntf
-          where
-            s = LB.toStrict s'
-            ntfErr :: Show e => String -> e -> String
-            ntfErr op e = op <> " error (" <> show e <> "): " <> B.unpack (B.take 100 s)
-
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)

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

@@ -1,37 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.Messaging.Notifications.Server.Control where
-
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BasicAuth)
-
-data ControlProtocol
-  = CPAuth BasicAuth
-  | CPStats
-  | CPStatsRTS
-  | CPServerInfo
-  | CPHelp
-  | CPQuit
-  | CPSkip
-
-instance StrEncoding ControlProtocol where
-  strEncode = \case
-    CPAuth tok -> "auth " <> strEncode tok
-    CPStats -> "stats"
-    CPStatsRTS -> "stats-rts"
-    CPServerInfo -> "server-info"
-    CPHelp -> "help"
-    CPQuit -> "quit"
-    CPSkip -> ""
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "auth" -> CPAuth <$> _strP
-      "stats" -> pure CPStats
-      "stats-rts" -> pure CPStatsRTS
-      "server-info" -> pure CPServerInfo
-      "help" -> pure CPHelp
-      "quit" -> pure CPQuit
-      "" -> pure CPSkip
-      _ -> fail "bad ControlProtocol command"

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

@@ -28,21 +28,18 @@ import Simplex.Messaging.Notifications.Server.Stats
 import Simplex.Messaging.Notifications.Server.Store
 import Simplex.Messaging.Notifications.Server.StoreLog
 import Simplex.Messaging.Notifications.Transport (NTFVersion, VersionRangeNTF)
-import Simplex.Messaging.Protocol (BasicAuth, CorrId, SMPServer, Transmission)
+import Simplex.Messaging.Protocol (CorrId, SMPServer, Transmission)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport, THandleParams, TransportPeer (..))
-import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, TransportServerConfig, loadFingerprint, loadServerCredential)
+import Simplex.Messaging.Transport.Server (TransportServerConfig, alpn, loadFingerprint, loadTLSServerParams)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
 
 data NtfServerConfig = NtfServerConfig
-  { transports :: [(ServiceName, ATransport, AddHTTP)],
-    controlPort :: Maybe ServiceName,
-    controlPortUserAuth :: Maybe BasicAuth,
-    controlPortAdminAuth :: Maybe BasicAuth,
+  { transports :: [(ServiceName, ATransport)],
     subIdBytes :: Int,
     regCodeBytes :: Int,
     clientQSize :: Natural,
@@ -53,8 +50,10 @@ data NtfServerConfig = NtfServerConfig
     subsBatchSize :: Int,
     inactiveClientExpiration :: Maybe ExpirationConfig,
     storeLogFile :: Maybe FilePath,
-    storeLastNtfsFile :: Maybe FilePath,
-    ntfCredentials :: ServerCredentials,
+    -- CA certificate private key is not needed for initialization
+    caCertificateFile :: FilePath,
+    privateKeyFile :: FilePath,
+    certificateFile :: FilePath,
     -- stats config - see SMP server config
     logStatsInterval :: Maybe Int64,
     logStatsStartTime :: Int64,
@@ -78,13 +77,13 @@ data NtfEnv = NtfEnv
     store :: NtfStore,
     storeLog :: Maybe (StoreLog 'WriteMode),
     random :: TVar ChaChaDRG,
-    tlsServerCreds :: T.Credential,
+    tlsServerParams :: T.ServerParams,
     serverIdentity :: C.KeyHash,
     serverStats :: NtfServerStats
   }
 
 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
-newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, ntfCredentials} = do
+newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
   random <- C.newRandom
   store <- newNtfStore
   logInfo "restoring subscriptions..."
@@ -92,10 +91,10 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo
   logInfo "restored subscriptions"
   subscriber <- newNtfSubscriber subQSize smpAgentCfg random
   pushServer <- newNtfPushServer pushQSize apnsConfig
-  tlsServerCreds <- loadServerCredential ntfCredentials
-  Fingerprint fp <- loadFingerprint ntfCredentials
+  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- loadFingerprint caCertificateFile
   serverStats <- newNtfServerStats =<< getCurrentTime
-  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
+  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
 
 data NtfSubscriber = NtfSubscriber
   { smpSubscribers :: TMap SMPServer SMPSubscriber,
@@ -159,8 +158,8 @@ data NtfRequest
   | NtfReqPing CorrId NtfEntityId
 
 data NtfServerClient = NtfServerClient
-  { rcvQ :: TBQueue (NonEmpty (Maybe NtfTknData, NtfRequest)),
-    sndQ :: TBQueue (NonEmpty (Transmission NtfResponse)),
+  { rcvQ :: TBQueue NtfRequest,
+    sndQ :: TBQueue (Transmission NtfResponse),
     ntfThParams :: THandleParams NTFVersion 'TServer,
     connected :: TVar Bool,
     rcvActiveAt :: TVar SystemTime,

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

@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Notifications.Server.Main where
 
@@ -14,23 +13,22 @@ import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.IO as T
 import Network.Socket (HostName)
 import Options.Applicative
-import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
+import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Server (runNtfServer)
 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.Transport (supportedNTFHandshakes, supportedServerNTFVRange)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 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.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import Simplex.Messaging.Util (tshow)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath (combine)
@@ -53,9 +51,7 @@ ntfServerCLI cfgPath logPath =
         True -> readIniFile iniFile >>= either exitError runServer
         _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
     Delete -> do
-      confirmOrExit
-        "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
-        "Server NOT deleted"
+      confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
@@ -87,38 +83,21 @@ 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")
             <> "log_stats: off\n\n\
-               \[AUTH]\n\
-               \# control_port_admin_password:\n\
-               \# control_port_user_password:\n\
-               \\n\
                \[TRANSPORT]\n\
-               \# Host is only used to print server address on start.\n\
-               \# You can specify multiple server ports.\n"
+               \# host is only used to print server address on start\n"
             <> ("host: " <> T.pack host <> "\n")
             <> ("port: " <> T.pack defaultServerPort <> "\n")
-            <> "log_tls_errors: off\n\n\
-               \# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
-               \websockets: off\n\n\
-               \# control_port: 5227\n\
-               \\n\
+            <> "log_tls_errors: off\n"
+            <> "websockets: off\n\n\
                \[SUBSCRIBER]\n\
                \# Network configuration for notification server client.\n\
-               \# `host_mode` can be 'public' (default) or 'onion'.\n\
-               \# It defines prefferred hostname for destination servers with multiple hostnames.\n\
-               \# host_mode: public\n\
-               \# required_host_mode: off\n\n\
                \# SOCKS proxy port for subscribing to SMP servers.\n\
                \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
                \# socks_proxy: localhost:9050\n\n\
                \# `socks_mode` can be 'onion' for SOCKS proxy to be used for .onion destination hosts only (default)\n\
                \# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
                \# 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\
                \[INACTIVE_CLIENTS]\n\
                \# TTL and interval to check inactive clients\n\
                \disconnect: off\n"
@@ -139,22 +118,14 @@ ntfServerCLI cfgPath logPath =
         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
         serverConfig =
           NtfServerConfig
             { transports = iniTransports ini,
-              controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini,
-              controlPortAdminAuth = either error id <$!> strDecodeIni "AUTH" "control_port_admin_password" ini,
-              controlPortUserAuth = either error id <$!> strDecodeIni "AUTH" "control_port_user_password" ini,
               subIdBytes = 24,
               regCodeBytes = 32,
               clientQSize = 64,
               subQSize = 512,
-              pushQSize = 16384,
+              pushQSize = 1048,
               smpAgentCfg =
                 defaultSMPClientAgentConfig
                   { smpCfg =
@@ -163,12 +134,9 @@ ntfServerCLI cfgPath logPath =
                             defaultNetworkConfig
                               { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
                                 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,
-                                smpPingInterval = 60_000_000 -- 1 minute
+                                smpPingInterval = 60_000_000 -- 1 minutes
                               }
                         },
-                    ownServerDomains = either (const []) (map encodeUtf8 . T.words) $ lookupValue "SUBSCRIBER" "own_server_domains" ini,
                     persistErrorInterval = 0 -- seconds
                   },
               apnsConfig = defaultAPNSPushClientConfig,
@@ -180,13 +148,9 @@ ntfServerCLI cfgPath logPath =
                       checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
                     },
               storeLogFile = enableStoreLog $> storeLogFilePath,
-              storeLastNtfsFile = restoreLastNtfsFile $ combine logPath "ntf-server-last-notifications.log",
-              ntfCredentials =
-                ServerCredentials
-                  { caCertificateFile = Just $ c caCrtFile,
-                    privateKeyFile = c serverKeyFile,
-                    certificateFile = c serverCrtFile
-                  },
+              caCertificateFile = c caCrtFile,
+              privateKeyFile = c serverKeyFile,
+              certificateFile = c serverCrtFile,
               logStatsInterval = logStats $> 86400, -- seconds
               logStatsStartTime = 0, -- seconds from 00:00 UTC
               serverStatsLogFile = combine logPath "ntf-server-stats.daily.log",
@@ -194,7 +158,8 @@ ntfServerCLI cfgPath logPath =
               ntfServerVRange = supportedServerNTFVRange,
               transportConfig =
                 defaultTransportServerConfig
-                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
+                  { logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini,
+                    alpn = Just supportedNTFHandshakes
                   }
             }
 

src/Simplex/Messaging/Notifications/Server/Push/APNS.hs

@@ -28,13 +28,16 @@ import Data.Aeson (ToJSON, (.=))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
 import Data.Text (Text)
@@ -48,10 +51,12 @@ import Network.HTTP2.Client (Request)
 import qualified Network.HTTP2.Client as H
 import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Server.Store (NtfTknData (..))
 import Simplex.Messaging.Parsers (defaultJSON)
+import Simplex.Messaging.Protocol (EncNMsgMeta)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import Simplex.Messaging.Transport.HTTP2.Client
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
@@ -107,6 +112,30 @@ data PushNotification
     PNCheckMessages
   deriving (Show)
 
+-- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
+-- because strEncode of NonEmpty list uses comma for separator,
+-- and encoding of PNMessageData's smpQueue has comma in list of hosts
+encodePNMessages :: NonEmpty PNMessageData -> ByteString
+encodePNMessages = B.intercalate ";" . map strEncode . L.toList
+
+pnMessagesP :: A.Parser (NonEmpty PNMessageData)
+pnMessagesP = L.fromList <$> strP `A.sepBy1` A.char ';'
+
+data PNMessageData = PNMessageData
+  { smpQueue :: SMPQueueNtf,
+    ntfTs :: SystemTime,
+    nmsgNonce :: C.CbNonce,
+    encNMsgMeta :: EncNMsgMeta
+  }
+  deriving (Show)
+
+instance StrEncoding PNMessageData where
+  strEncode PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta} =
+    strEncode (smpQueue, ntfTs, nmsgNonce, encNMsgMeta)
+  strP = do
+    (smpQueue, ntfTs, nmsgNonce, encNMsgMeta) <- strP
+    pure PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}
+
 data APNSNotification = APNSNotification {aps :: APNSNotificationBody, notificationData :: Maybe J.Value}
   deriving (Show)
 
@@ -192,7 +221,7 @@ defaultAPNSPushClientConfig =
       authKeyFileEnv = "APNS_KEY_FILE", -- the environment variables APNS_KEY_FILE and APNS_KEY_ID must be set, or the server would fail to start
       authKeyAlg = "ES256",
       authKeyIdEnv = "APNS_KEY_ID",
-      paddedNtfLength = 3072,
+      paddedNtfLength = 512,
       appName = "chat.simplex.app",
       appTeamId = "5NN7GUYB6T",
       apnsPort = "443",
@@ -308,7 +337,7 @@ data PushProviderError
   = PPConnection HTTP2ClientError
   | PPCryptoError C.CryptoError
   | PPResponseError (Maybe Status) Text
-  | PPTokenInvalid NTInvalidReason
+  | PPTokenInvalid
   | PPRetryLater
   | PPPermanentError
   deriving (Show, Exception)
@@ -337,20 +366,19 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
     result status reason'
       | status == Just N.ok200 = pure ()
       | status == Just N.badRequest400 =
-          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
+          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
       | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwE PPRetryLater
       -- Just tooManyRequests429 -> TooManyRequests - too many requests for the same token
-      | otherwise = throwE $ PPResponseError status reason'
+      | otherwise = err status reason'
+    err :: Maybe Status -> Text -> ExceptT PushProviderError IO ()
+    err s r = throwE $ PPResponseError s r
     liftHTTPS2 a = ExceptT $ first PPConnection <$> a

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

@@ -4,7 +4,7 @@
 
 module Simplex.Messaging.Notifications.Server.Stats where
 
-import Control.Applicative (optional, (<|>))
+import Control.Applicative (optional)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.IORef
@@ -17,18 +17,10 @@ data NtfServerStats = NtfServerStats
     tknCreated :: IORef Int,
     tknVerified :: IORef Int,
     tknDeleted :: IORef Int,
-    tknReplaced :: IORef Int,
     subCreated :: IORef Int,
     subDeleted :: IORef Int,
     ntfReceived :: IORef Int,
     ntfDelivered :: IORef Int,
-    ntfFailed :: IORef Int,
-    ntfCronDelivered :: IORef Int,
-    ntfCronFailed :: IORef Int,
-    ntfVrfQueued :: IORef Int,
-    ntfVrfDelivered :: IORef Int,
-    ntfVrfFailed :: IORef Int,
-    ntfVrfInvalidTkn :: IORef Int,
     activeTokens :: PeriodStats,
     activeSubs :: PeriodStats
   }
@@ -38,18 +30,10 @@ data NtfServerStatsData = NtfServerStatsData
     _tknCreated :: Int,
     _tknVerified :: Int,
     _tknDeleted :: Int,
-    _tknReplaced :: Int,
     _subCreated :: Int,
     _subDeleted :: Int,
     _ntfReceived :: Int,
     _ntfDelivered :: Int,
-    _ntfFailed :: Int,
-    _ntfCronDelivered :: Int,
-    _ntfCronFailed :: Int,
-    _ntfVrfQueued :: Int,
-    _ntfVrfDelivered :: Int,
-    _ntfVrfFailed :: Int,
-    _ntfVrfInvalidTkn :: Int,
     _activeTokens :: PeriodStatsData,
     _activeSubs :: PeriodStatsData
   }
@@ -60,41 +44,13 @@ newNtfServerStats ts = do
   tknCreated <- newIORef 0
   tknVerified <- newIORef 0
   tknDeleted <- newIORef 0
-  tknReplaced <- newIORef 0
   subCreated <- newIORef 0
   subDeleted <- newIORef 0
   ntfReceived <- newIORef 0
   ntfDelivered <- newIORef 0
-  ntfFailed <- newIORef 0
-  ntfCronDelivered <- newIORef 0
-  ntfCronFailed <- newIORef 0
-  ntfVrfQueued <- newIORef 0
-  ntfVrfDelivered <- newIORef 0
-  ntfVrfFailed <- newIORef 0
-  ntfVrfInvalidTkn <- newIORef 0
   activeTokens <- newPeriodStats
   activeSubs <- newPeriodStats
-  pure
-    NtfServerStats
-      { fromTime,
-        tknCreated,
-        tknVerified,
-        tknDeleted,
-        tknReplaced,
-        subCreated,
-        subDeleted,
-        ntfReceived,
-        ntfDelivered,
-        ntfFailed,
-        ntfCronDelivered,
-        ntfCronFailed,
-        ntfVrfQueued,
-        ntfVrfDelivered,
-        ntfVrfFailed,
-        ntfVrfInvalidTkn,
-        activeTokens,
-        activeSubs
-      }
+  pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
 
 getNtfServerStatsData :: NtfServerStats -> IO NtfServerStatsData
 getNtfServerStatsData s@NtfServerStats {fromTime} = do
@@ -102,41 +58,13 @@ getNtfServerStatsData s@NtfServerStats {fromTime} = do
   _tknCreated <- readIORef $ tknCreated s
   _tknVerified <- readIORef $ tknVerified s
   _tknDeleted <- readIORef $ tknDeleted s
-  _tknReplaced <- readIORef $ tknReplaced s
   _subCreated <- readIORef $ subCreated s
   _subDeleted <- readIORef $ subDeleted s
   _ntfReceived <- readIORef $ ntfReceived s
   _ntfDelivered <- readIORef $ ntfDelivered s
-  _ntfFailed <- readIORef $ ntfFailed s
-  _ntfCronDelivered <- readIORef $ ntfCronDelivered s
-  _ntfCronFailed <- readIORef $ ntfCronFailed s
-  _ntfVrfQueued <- readIORef $ ntfVrfQueued s
-  _ntfVrfDelivered <- readIORef $ ntfVrfDelivered s
-  _ntfVrfFailed <- readIORef $ ntfVrfFailed s
-  _ntfVrfInvalidTkn <- readIORef $ ntfVrfInvalidTkn s
   _activeTokens <- getPeriodStatsData $ activeTokens s
   _activeSubs <- getPeriodStatsData $ activeSubs s
-  pure
-    NtfServerStatsData
-      { _fromTime,
-        _tknCreated,
-        _tknVerified,
-        _tknDeleted,
-        _tknReplaced,
-        _subCreated,
-        _subDeleted,
-        _ntfReceived,
-        _ntfDelivered,
-        _ntfFailed,
-        _ntfCronDelivered,
-        _ntfCronFailed,
-        _ntfVrfQueued,
-        _ntfVrfDelivered,
-        _ntfVrfFailed,
-        _ntfVrfInvalidTkn,
-        _activeTokens,
-        _activeSubs
-      }
+  pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
 
 -- this function is not thread safe, it is used on server start only
 setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> IO ()
@@ -145,60 +73,24 @@ setNtfServerStats s@NtfServerStats {fromTime} d@NtfServerStatsData {_fromTime} =
   writeIORef (tknCreated s) $! _tknCreated d
   writeIORef (tknVerified s) $! _tknVerified d
   writeIORef (tknDeleted s) $! _tknDeleted d
-  writeIORef (tknReplaced s) $! _tknReplaced d
   writeIORef (subCreated s) $! _subCreated d
   writeIORef (subDeleted s) $! _subDeleted d
   writeIORef (ntfReceived s) $! _ntfReceived d
   writeIORef (ntfDelivered s) $! _ntfDelivered d
-  writeIORef (ntfFailed s) $! _ntfFailed d
-  writeIORef (ntfCronDelivered s) $! _ntfCronDelivered d
-  writeIORef (ntfCronFailed s) $! _ntfCronFailed d
-  writeIORef (ntfVrfQueued s) $! _ntfVrfQueued d
-  writeIORef (ntfVrfDelivered s) $! _ntfVrfDelivered d
-  writeIORef (ntfVrfFailed s) $! _ntfVrfFailed d
-  writeIORef (ntfVrfInvalidTkn s) $! _ntfVrfInvalidTkn d
   setPeriodStats (activeTokens s) (_activeTokens d)
   setPeriodStats (activeSubs s) (_activeSubs d)
 
 instance StrEncoding NtfServerStatsData where
-  strEncode
-    NtfServerStatsData
-      { _fromTime,
-        _tknCreated,
-        _tknVerified,
-        _tknDeleted,
-        _tknReplaced,
-        _subCreated,
-        _subDeleted,
-        _ntfReceived,
-        _ntfDelivered,
-        _ntfFailed,
-        _ntfCronDelivered,
-        _ntfCronFailed,
-        _ntfVrfQueued,
-        _ntfVrfDelivered,
-        _ntfVrfFailed,
-        _ntfVrfInvalidTkn,
-        _activeTokens,
-        _activeSubs
-      } =
+  strEncode NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs} =
     B.unlines
       [ "fromTime=" <> strEncode _fromTime,
         "tknCreated=" <> strEncode _tknCreated,
         "tknVerified=" <> strEncode _tknVerified,
         "tknDeleted=" <> strEncode _tknDeleted,
-        "tknReplaced=" <> strEncode _tknReplaced,
         "subCreated=" <> strEncode _subCreated,
         "subDeleted=" <> strEncode _subDeleted,
         "ntfReceived=" <> strEncode _ntfReceived,
         "ntfDelivered=" <> strEncode _ntfDelivered,
-        "ntfFailed=" <> strEncode _ntfFailed,
-        "ntfCronDelivered=" <> strEncode _ntfCronDelivered,
-        "ntfCronFailed=" <> strEncode _ntfCronFailed,
-        "ntfVrfQueued=" <> strEncode _ntfVrfQueued,
-        "ntfVrfDelivered=" <> strEncode _ntfVrfDelivered,
-        "ntfVrfFailed=" <> strEncode _ntfVrfFailed,
-        "ntfVrfInvalidTkn=" <> strEncode _ntfVrfInvalidTkn,
         "activeTokens:",
         strEncode _activeTokens,
         "activeSubs:",
@@ -209,42 +101,12 @@ instance StrEncoding NtfServerStatsData where
     _tknCreated <- "tknCreated=" *> strP <* A.endOfLine
     _tknVerified <- "tknVerified=" *> strP <* A.endOfLine
     _tknDeleted <- "tknDeleted=" *> strP <* A.endOfLine
-    _tknReplaced <- opt "tknReplaced="
     _subCreated <- "subCreated=" *> strP <* A.endOfLine
     _subDeleted <- "subDeleted=" *> strP <* A.endOfLine
     _ntfReceived <- "ntfReceived=" *> strP <* A.endOfLine
     _ntfDelivered <- "ntfDelivered=" *> strP <* A.endOfLine
-    _ntfFailed <- opt "ntfFailed="
-    _ntfCronDelivered <- opt "ntfCronDelivered="
-    _ntfCronFailed <- opt "ntfCronFailed="
-    _ntfVrfQueued <- opt "ntfVrfQueued="
-    _ntfVrfDelivered <- opt "ntfVrfDelivered="
-    _ntfVrfFailed <- opt "ntfVrfFailed="
-    _ntfVrfInvalidTkn <- opt "ntfVrfInvalidTkn="
     _ <- "activeTokens:" <* A.endOfLine
     _activeTokens <- strP <* A.endOfLine
     _ <- "activeSubs:" <* A.endOfLine
     _activeSubs <- strP <* optional A.endOfLine
-    pure
-      NtfServerStatsData
-        { _fromTime,
-          _tknCreated,
-          _tknVerified,
-          _tknDeleted,
-          _tknReplaced,
-          _subCreated,
-          _subDeleted,
-          _ntfReceived,
-          _ntfDelivered,
-          _ntfFailed,
-          _ntfCronDelivered,
-          _ntfCronFailed,
-          _ntfVrfQueued,
-          _ntfVrfDelivered,
-          _ntfVrfFailed,
-          _ntfVrfInvalidTkn,
-          _activeTokens,
-          _activeSubs
-        }
-    where
-      opt s = A.string s *> strP <* A.endOfLine <|> pure 0
+    pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}