WIP: move to cryptonite cbits instead of openssl and haskell-funptrs

remove sha512 wrapper and use openssl directly
add "ssl" library dep
2026-09-01 13:48:24 +00:00 · 2023-10-30 16:01:37 +02:00 · 2023-10-30 14:00:24 +02:00 · 2023-10-29 22:04:09 +02:00 · 2023-10-29 16:44:17 +00:00 · 2023-10-29 16:21:09 +02:00
117 changed files with 3343 additions and 5644 deletions
@@ -11,7 +11,7 @@ on:

 jobs:
  build:
-    name: build-${{ matrix.os }}-${{ matrix.ghc }}
+    name: build-${{ matrix.os }}
    runs-on: ${{ matrix.os }}
    strategy:
      fail-fast: false
@@ -19,13 +19,8 @@ jobs:
        include:
          - os: ubuntu-20.04
            platform_name: 20_04-x86-64
-            ghc: "8.10.7"
-          - os: ubuntu-20.04
-            platform_name: 20_04-x86-64
-            ghc: "9.6.3"
          - os: ubuntu-22.04
            platform_name: 22_04-x86-64
-            ghc: "9.6.3"
    steps:
      - name: Clone project
        uses: actions/checkout@v3
@@ -33,7 +28,7 @@ jobs:
      - name: Setup Haskell
        uses: haskell-actions/setup@v2
        with:
-          ghc-version: ${{ matrix.ghc }}
+          ghc-version: "9.6.2"
          cabal-version: "3.10.1.0"

      - name: Cache dependencies
@@ -75,7 +70,7 @@ jobs:
          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

      - name: Create release
-        if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'ubuntu-20.04' && matrix.ghc == '9.6.3'
+        if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'ubuntu-20.04'
        uses: softprops/action-gh-release@v1
        with:
          body: |
@@ -1,43 +1,8 @@
-# 5.4.0
-
-Migrate to GHC 9.6.3
-
-Agent:
- database improvements:
-  - track slow queries.
-  - better performance.
-  - "busy" error handling.
-  - create parent folder when needed.
-  - support closing and re-opening database.
- SMP agent improvements
-  - streaming for batched SMP commands.
-  - fix asynchronous JOINing connection.
-  - handle repeating JOINs without failure.
-  - api to get subscribed connections.
-  - return simplex:/ links as invitations.
-  - fix memory leak.
- XFTP improvements:
-  - suspend when agent is suspended.
-  - support locally encrypted files.
-  - fixes - create empty file, prevent permanent error treated as temporary.
-  - upgrade HTTP2 library (fixes error handling and flow control).
- Remote control protocol (XRCP)
-
-SMP server:
- control port commands for GHC threads introspection.
- allow creating new queues without subscriptions (required for iOS).
-
-XFTP server:
- allow 64kb file chunks.
-
-NTF server:
- faster startup.
-
 # 5.3.0

 Agent:
 - improve performance, track slow database queries.
- support delivery receipts.
+- support delievery receipts.

 SMP server:
 - control port
@@ -116,7 +81,7 @@ SMP agent:
 - batch connection deletion
 - improve asynchronous connection deletion – it may now be completed after the client is restarted as well.
 - improve subscription logic to retry if initial attempt fails.
- end SMP client connection after a number of failed PINGs (default is 3).
+- end SMP client connection after a number of failed PINGs (defalt is 3).

 # 4.3.0

@@ -149,7 +114,7 @@ SMP agent:

 Notification server (v1.3.0):

- check token status when sending verification notification.
+- check token status when sending verification notificaiton.

 # 4.1.0

@@ -168,15 +133,15 @@ SMP agent:
 SMP server:

 - Basic authentication. The server address can now include an optional password that is required to create messaging queues, so the contacts who message you will not be able to receive messages via your server, unless you share with them the address with the password. It is recommended to enable basic authentication on all private servers by adding `create_password` parameter into AUTH section of server INI file (the previously deployed servers do not have this section, you need to add it).
- Disable creating new queues completely with `new_queues: off` parameter in AUTH section of INI file - it can be used to simplify migrating the existing connections to another server.
+- Disable creating new queues completely with `new_queues: off` parameter in AUTH section of INI file - it can be used to simplify migrating the exising connections to another server.
 - Updated server CLI with changed defaults:
-  - interactive server initialization, use -y flag to initialize the server non-interactively.
+  - interactive server initialization, use -y flag to initalize the server non-interactively.
  - store log is now enabled by default, so messaging queues and messages are restored when the server is restarted (to restore undelivered messages the server needs to be stopped with SIGINT signal).
  - a random password is now generated by default during the server initialization.

 SMP agent:

- API to test SMP servers. It connects to the server, creates and deletes a messaging queue. The new SimpleX Chat client uses this API to allow you to test that you have the correct server address, with the valid certificate fingerprint and password, before enabling the new server.
+- API to test SMP servers. It connects to the server, creates and deletes a messaging queue. The new SimpleX Chat client uses this API to allow you to test that you have the correct server address, with the valid certificate fingerprint and pasword, before enabling the new server.

 # 3.4.0

@@ -222,9 +187,9 @@ SMP server and agent:

 SMP server:

- restore undelivered messages when the server is restarted.
+- restore undeliverd messages when the server is restarted.
 - SMP protocol v3 to support push notification:
-  - updated SEND and MSG to add message flags (for notification flag that confirm whether the notification is sent and for any future extensions) and to move message meta-data sent to the recipient into the encrypted envelope.
+  - updated SEND and MSG to add message flags (for notification flag that contros whether the notification is sent and for any future extensions) and to move message meta-data sent to the recipient into the encrypted envelope.
  - update NKEY and NID to add e2e encryption keys (for the notification meta-data encryption between SMP server and the client), and update NMSG to include this meta-data.
  - update ACK command to include message ID (to avoid acknowledging unprocessed message).
  - add NDEL commands to remove notification subscription credentials from SMP queue.
@@ -235,7 +200,7 @@ SMP agent:
 - new protocol for duplex connection handshake reducing traffic and connection time.
 - support for SMP notifications server and managing device token.
 - remove redundant FQDN validation from TLS handshake to prepare for access via Tor.
- support for fully stopping agent and for temporary suspending agent operations.
+- support for fully stopping agent and for termporary suspending agent operations.
 - improve management of duplicate message delivery.

 SMP notifications server v1.0:
@@ -5,10 +5,10 @@ FROM ubuntu:${TAG} AS build
 ### Build stage

 # Install curl and git and simplexmq dependencies
-RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev libssl-dev
+RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev

 # Specify bootstrap Haskell versions
-ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
+ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.2
 ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0

 # Install ghcup
@@ -5,7 +5,6 @@
 module Main where

 import Control.Logger.Simple
-import Data.ByteArray (ScrubbedBytes)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Simplex.Messaging.Agent.Env.SQLite
@@ -20,7 +19,7 @@ cfg = defaultAgentConfig
 agentDbFile :: String
 agentDbFile = "smp-agent.db"

-agentDbKey :: ScrubbedBytes
+agentDbKey :: String
 agentDbKey = ""

 servers :: InitialAgentServers
@@ -35,10 +34,9 @@ servers =
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

-- Warning: this SMP agent server is experimental - it does not work correctly with multiple connected TCP clients in some cases.
 main :: IO ()
 main = do
  putStrLn $ "SMP agent listening on port " ++ tcpPort (cfg :: AgentConfig)
  setLogLevel LogInfo -- LogError
-  Right st <- createAgentStore agentDbFile agentDbKey False MCConsole
+  Right st <- createAgentStore agentDbFile agentDbKey MCConsole
  withGlobalLogging logCfg $ runSMPAgent (transport @TLS) cfg servers st
@@ -4,10 +4,7 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport

-index-state: 2023-12-12T00:00:00Z
-
-package cryptostore
-    flags: +use_crypton
+with-compiler: ghc-9.6.2

 source-repository-package
    type: git
@@ -19,6 +16,11 @@ source-repository-package
    location: https://github.com/simplex-chat/hs-socks.git
    tag: a30cc7a79a08d8108316094f8f2f82a0c5e1ac51

+source-repository-package
+    type: git
+    location: https://github.com/kazu-yamamoto/http2.git
+    tag: 804fa283f067bd3fd89b8c5f8d25b3047813a517
+
 source-repository-package
    type: git
    location: https://github.com/simplex-chat/direct-sqlcipher.git
@@ -28,3 +30,8 @@ source-repository-package
    type: git
    location: https://github.com/simplex-chat/sqlcipher-simple.git
    tag: a46bd361a19376c5211f1058908fc0ae6bf42446
+
+source-repository-package
+    type: git
+    location: https://github.com/simplex-chat/network-transport.git
+    tag: 0013798272a683e35ca38d2fdaf480942311fba8
@@ -1,3 +0,0 @@
-# Streamlined NTRU Prime: sntrup761
-
-The implementation of sntrup761 is the _exact_ copy from this [Internet draft](https://www.ietf.org/archive/id/draft-josefsson-ntruprime-streamlined-00.html).
@@ -0,0 +1,140 @@
+#ifndef CRYPTONITE_ALIGN_H
+#define CRYPTONITE_ALIGN_H
+
+#include "cryptonite_bitfn.h"
+
+#if (defined(__i386__))
+# define UNALIGNED_ACCESS_OK
+#elif defined(__x86_64__)
+# define UNALIGNED_ACCESS_OK
+#else
+# define UNALIGNED_ACCESS_FAULT
+#endif
+
+/* n need to be power of 2.
+ * IS_ALIGNED(p,8) */
+#define IS_ALIGNED(p,alignment) (((uintptr_t) (p)) & ((alignment)-1))
+
+#ifdef WITH_ASSERT_ALIGNMENT
+#include <stdio.h>
+#include <stdlib.h>
+#include <inttypes.h>
+# define ASSERT_ALIGNMENT(up, alignment) \
+	do { if (IS_ALIGNED(up, alignment)) \
+	{ printf("ALIGNMENT-ASSERT-FAILURE: %s:%d: ptr=%p alignment=%d\n", __FILE__, __LINE__, (void *) up, (alignment)); \
+	  exit(99); \
+	}; } while (0)
+#else
+# define ASSERT_ALIGNMENT(p, n) do {} while (0)
+#endif
+
+#ifdef UNALIGNED_ACCESS_OK
+#define need_alignment(p,n) (0)
+#else
+#define need_alignment(p,n) IS_ALIGNED(p,n)
+#endif
+
+static inline uint32_t load_le32_aligned(const uint8_t *p)
+{
+	return le32_to_cpu(*((uint32_t *) p));		
+}
+
+static inline void store_le32_aligned(uint8_t *dst, const uint32_t v)
+{
+	*((uint32_t *) dst) = cpu_to_le32(v);
+}
+
+static inline void xor_le32_aligned(uint8_t *dst, const uint32_t v)
+{
+	*((uint32_t *) dst) ^= cpu_to_le32(v);
+}
+
+static inline void store_be32_aligned(uint8_t *dst, const uint32_t v)
+{
+	*((uint32_t *) dst) = cpu_to_be32(v);
+}
+
+static inline void xor_be32_aligned(uint8_t *dst, const uint32_t v)
+{
+	*((uint32_t *) dst) ^= cpu_to_be32(v);
+}
+
+static inline void store_le64_aligned(uint8_t *dst, const uint64_t v)
+{
+	*((uint64_t *) dst) = cpu_to_le64(v);
+}
+
+static inline void store_be64_aligned(uint8_t *dst, const uint64_t v)
+{
+	*((uint64_t *) dst) = cpu_to_be64(v);
+}
+
+static inline void xor_be64_aligned(uint8_t *dst, const uint64_t v)
+{
+	*((uint64_t *) dst) ^= cpu_to_be64(v);
+}
+
+#ifdef UNALIGNED_ACCESS_OK
+#define load_le32(a) load_le32_aligned(a)
+#else
+static inline uint32_t load_le32(const uint8_t *p)
+{
+	return ((uint32_t)p[0]) | ((uint32_t)p[1] <<  8) | ((uint32_t)p[2] << 16) | ((uint32_t)p[3] << 24);
+}
+#endif
+
+#ifdef UNALIGNED_ACCESS_OK
+#define store_le32(a, b) store_le32_aligned(a, b)
+#define xor_le32(a, b) xor_le32_aligned(a, b)
+#else
+static inline void store_le32(uint8_t *dst, const uint32_t v)
+{
+	dst[0] = v; dst[1] = v >> 8; dst[2] = v >> 16; dst[3] = v >> 24;
+}
+static inline void xor_le32(uint8_t *dst, const uint32_t v)
+{
+	dst[0] ^= v; dst[1] ^= v >> 8; dst[2] ^= v >> 16; dst[3] ^= v >> 24;
+}
+#endif
+
+#ifdef UNALIGNED_ACCESS_OK
+#define store_be32(a, b) store_be32_aligned(a, b)
+#define xor_be32(a, b) xor_be32_aligned(a, b)
+#else
+static inline void store_be32(uint8_t *dst, const uint32_t v)
+{
+	dst[3] = v; dst[2] = v >> 8; dst[1] = v >> 16; dst[0] = v >> 24;
+}
+static inline void xor_be32(uint8_t *dst, const uint32_t v)
+{
+	dst[3] ^= v; dst[2] ^= v >> 8; dst[1] ^= v >> 16; dst[0] ^= v >> 24;
+}
+#endif
+
+#ifdef UNALIGNED_ACCESS_OK
+#define store_le64(a, b) store_le64_aligned(a, b)
+#else
+static inline void store_le64(uint8_t *dst, const uint64_t v)
+{
+	dst[0] = v      ; dst[1] = v >> 8 ; dst[2] = v >> 16; dst[3] = v >> 24;
+	dst[4] = v >> 32; dst[5] = v >> 40; dst[6] = v >> 48; dst[7] = v >> 56;
+}
+#endif
+
+#ifdef UNALIGNED_ACCESS_OK
+#define store_be64(a, b) store_be64_aligned(a, b)
+#define xor_be64(a, b) xor_be64_aligned(a, b)
+#else
+static inline void store_be64(uint8_t *dst, const uint64_t v)
+{
+	dst[7] = v      ; dst[6] = v >> 8 ; dst[5] = v >> 16; dst[4] = v >> 24;
+	dst[3] = v >> 32; dst[2] = v >> 40; dst[1] = v >> 48; dst[0] = v >> 56;
+}
+static inline void xor_be64(uint8_t *dst, const uint64_t v)
+{
+	dst[7] ^= v      ; dst[6] ^= v >> 8 ; dst[5] ^= v >> 16; dst[4] ^= v >> 24;
+	dst[3] ^= v >> 32; dst[2] ^= v >> 40; dst[1] ^= v >> 48; dst[0] ^= v >> 56;
+}
+#endif
+
+#endif
@@ -0,0 +1,253 @@
+/*
+ * Copyright (C) 2006-2014 Vincent Hanquez <vincent@snarc.org>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef BITFN_H
+#define BITFN_H
+#include <stdint.h>
+
+#ifndef NO_INLINE_ASM
+/**********************************************************/
+# if (defined(__i386__))
+#  define ARCH_HAS_SWAP32
+static inline uint32_t bitfn_swap32(uint32_t a)
+{
+	asm ("bswap %0" : "=r" (a) : "0" (a));
+	return a;
+}
+/**********************************************************/
+# elif (defined(__arm__))
+#  define ARCH_HAS_SWAP32
+static inline uint32_t bitfn_swap32(uint32_t a)
+{
+	uint32_t tmp = a;
+	asm volatile ("eor %1, %0, %0, ror #16\n"
+	              "bic %1, %1, #0xff0000\n"
+	              "mov %0, %0, ror #8\n"
+	              "eor %0, %0, %1, lsr #8\n"
+	             : "=r" (a), "=r" (tmp) : "0" (a), "1" (tmp));
+	return a;
+}
+/**********************************************************/
+# elif defined(__x86_64__)
+#  define ARCH_HAS_SWAP32
+#  define ARCH_HAS_SWAP64
+static inline uint32_t bitfn_swap32(uint32_t a)
+{
+	asm ("bswap %0" : "=r" (a) : "0" (a));
+	return a;
+}
+
+static inline uint64_t bitfn_swap64(uint64_t a)
+{
+	asm ("bswap %0" : "=r" (a) : "0" (a));
+	return a;
+}
+
+# endif
+#endif /* NO_INLINE_ASM */
+/**********************************************************/
+
+#ifndef ARCH_HAS_ROL32
+static inline uint32_t rol32(uint32_t word, uint32_t shift)
+{
+	return (word << shift) | (word >> (32 - shift));
+}
+#endif
+
+#ifndef ARCH_HAS_ROR32
+static inline uint32_t ror32(uint32_t word, uint32_t shift)
+{
+	return (word >> shift) | (word << (32 - shift));
+}
+#endif
+
+#ifndef ARCH_HAS_ROL64
+static inline uint64_t rol64(uint64_t word, uint32_t shift)
+{
+	return (word << shift) | (word >> (64 - shift));
+}
+#endif
+
+#ifndef ARCH_HAS_ROR64
+static inline uint64_t ror64(uint64_t word, uint32_t shift)
+{
+	return (word >> shift) | (word << (64 - shift));
+}
+#endif
+
+#ifndef ARCH_HAS_SWAP32
+static inline uint32_t bitfn_swap32(uint32_t a)
+{
+	return (a << 24) | ((a & 0xff00) << 8) | ((a >> 8) & 0xff00) | (a >> 24);
+}
+#endif
+
+#ifndef ARCH_HAS_ARRAY_SWAP32
+static inline void array_swap32(uint32_t *d, uint32_t *s, uint32_t nb)
+{
+	while (nb--)
+		*d++ = bitfn_swap32(*s++);
+}
+#endif
+
+#ifndef ARCH_HAS_SWAP64
+static inline uint64_t bitfn_swap64(uint64_t a)
+{
+	return ((uint64_t) bitfn_swap32((uint32_t) (a >> 32))) |
+	       (((uint64_t) bitfn_swap32((uint32_t) a)) << 32);
+}
+#endif
+
+#ifndef ARCH_HAS_ARRAY_SWAP64
+static inline void array_swap64(uint64_t *d, uint64_t *s, uint32_t nb)
+{
+	while (nb--)
+		*d++ = bitfn_swap64(*s++);
+}
+#endif
+
+#ifndef ARCH_HAS_MEMORY_ZERO
+static inline void memory_zero(void *ptr, uint32_t len)
+{
+	uint32_t *ptr32 = ptr;
+	uint8_t *ptr8;
+	int i;
+
+	for (i = 0; i < len / 4; i++)
+		*ptr32++ = 0;
+	if (len % 4) {
+		ptr8 = (uint8_t *) ptr32;
+		for (i = len % 4; i >= 0; i--)
+			ptr8[i] = 0;
+	}
+}
+#endif
+
+#ifndef ARCH_HAS_ARRAY_COPY32
+static inline void array_copy32(uint32_t *d, uint32_t *s, uint32_t nb)
+{
+	while (nb--) *d++ = *s++;
+}
+#endif
+
+#ifndef ARCH_HAS_ARRAY_XOR32
+static inline void array_xor32(uint32_t *d, uint32_t *s, uint32_t nb)
+{
+	while (nb--) *d++ ^= *s++;
+}
+#endif
+
+#ifndef ARCH_HAS_ARRAY_COPY64
+static inline void array_copy64(uint64_t *d, uint64_t *s, uint32_t nb)
+{
+	while (nb--) *d++ = *s++;
+}
+#endif
+
+#ifdef __GNUC__
+#define bitfn_ntz(n) __builtin_ctz(n)
+#else
+#error "define ntz for your platform"
+#endif
+
+#ifdef __MINGW32__
+  # define LITTLE_ENDIAN 1234
+  # define BYTE_ORDER    LITTLE_ENDIAN
+#elif defined(__FreeBSD__) || defined(__DragonFly__) || defined(__NetBSD__)
+  # include <sys/endian.h>
+#elif defined(__OpenBSD__) || defined(__SVR4)
+  # include <sys/types.h>
+#elif defined(__APPLE__)
+  # include <machine/endian.h>
+#elif defined( BSD ) && ( BSD >= 199103 )
+  # include <machine/endian.h>
+#elif defined( __QNXNTO__ ) && defined( __LITTLEENDIAN__ )
+  # define LITTLE_ENDIAN 1234
+  # define BYTE_ORDER    LITTLE_ENDIAN
+#elif defined( __QNXNTO__ ) && defined( __BIGENDIAN__ )
+  # define BIG_ENDIAN 1234
+  # define BYTE_ORDER    BIG_ENDIAN
+#elif defined( _AIX )
+  # include <sys/machine.h>
+#else
+  # include <endian.h>
+#endif
+/* big endian to cpu */
+#if LITTLE_ENDIAN == BYTE_ORDER
+
+# define be32_to_cpu(a) bitfn_swap32(a)
+# define cpu_to_be32(a) bitfn_swap32(a)
+# define le32_to_cpu(a) (a)
+# define cpu_to_le32(a) (a)
+# define be64_to_cpu(a) bitfn_swap64(a)
+# define cpu_to_be64(a) bitfn_swap64(a)
+# define le64_to_cpu(a) (a)
+# define cpu_to_le64(a) (a)
+
+# define cpu_to_le32_array(d, s, l) array_copy32(d, s, l)
+# define le32_to_cpu_array(d, s, l) array_copy32(d, s, l)
+# define cpu_to_be32_array(d, s, l) array_swap32(d, s, l)
+# define be32_to_cpu_array(d, s, l) array_swap32(d, s, l)
+
+# define cpu_to_le64_array(d, s, l) array_copy64(d, s, l)
+# define le64_to_cpu_array(d, s, l) array_copy64(d, s, l)
+# define cpu_to_be64_array(d, s, l) array_swap64(d, s, l)
+# define be64_to_cpu_array(d, s, l) array_swap64(d, s, l)
+
+# define ror32_be(a, s) rol32(a, s)
+# define rol32_be(a, s) ror32(a, s)
+
+# define ARCH_IS_LITTLE_ENDIAN
+
+#elif BIG_ENDIAN == BYTE_ORDER
+
+# define be32_to_cpu(a) (a)
+# define cpu_to_be32(a) (a)
+# define be64_to_cpu(a) (a)
+# define cpu_to_be64(a) (a)
+# define le64_to_cpu(a) bitfn_swap64(a)
+# define cpu_to_le64(a) bitfn_swap64(a)
+# define le32_to_cpu(a) bitfn_swap32(a)
+# define cpu_to_le32(a) bitfn_swap32(a)
+
+# define cpu_to_le32_array(d, s, l) array_swap32(d, s, l)
+# define le32_to_cpu_array(d, s, l) array_swap32(d, s, l)
+# define cpu_to_be32_array(d, s, l) array_copy32(d, s, l)
+# define be32_to_cpu_array(d, s, l) array_copy32(d, s, l)
+
+# define cpu_to_le64_array(d, s, l) array_swap64(d, s, l)
+# define le64_to_cpu_array(d, s, l) array_swap64(d, s, l)
+# define cpu_to_be64_array(d, s, l) array_copy64(d, s, l)
+# define be64_to_cpu_array(d, s, l) array_copy64(d, s, l)
+
+# define ror32_be(a, s) ror32(a, s)
+# define rol32_be(a, s) rol32(a, s)
+
+# define ARCH_IS_BIG_ENDIAN
+
+#else
+# error "endian not supported"
+#endif
+
+#endif /* !BITFN_H */
@@ -0,0 +1,288 @@
+/*
+ * Copyright (c) 2014-2015 Vincent Hanquez <vincent@snarc.org>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of the author nor the names of his contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <stdint.h>
+#include <string.h>
+#include "cryptonite_chacha.h"
+#include "cryptonite_bitfn.h"
+#include "cryptonite_align.h"
+#include <stdio.h>
+
+#define QR(a,b,c,d) \
+	a += b; d = rol32(d ^ a,16); \
+	c += d; b = rol32(b ^ c,12); \
+	a += b; d = rol32(d ^ a, 8); \
+	c += d; b = rol32(b ^ c, 7);
+
+#define ALIGNED64(PTR) \
+	(((uintptr_t)(const void *)(PTR)) % 8 == 0)
+
+static const uint8_t sigma[16] = "expand 32-byte k";
+static const uint8_t tau[16] = "expand 16-byte k";
+
+static void chacha_core(int rounds, block *out, const cryptonite_chacha_state *in)
+{
+	uint32_t x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15;
+	int i;
+
+	x0 = in->d[0]; x1 = in->d[1]; x2 = in->d[2]; x3 = in->d[3];
+	x4 = in->d[4]; x5 = in->d[5]; x6 = in->d[6]; x7 = in->d[7];
+	x8 = in->d[8]; x9 = in->d[9]; x10 = in->d[10]; x11 = in->d[11];
+	x12 = in->d[12]; x13 = in->d[13]; x14 = in->d[14]; x15 = in->d[15];
+
+	for (i = rounds; i > 0; i -= 2) {
+		QR(x0, x4, x8, x12);
+		QR(x1, x5, x9, x13);
+		QR(x2, x6, x10, x14);
+		QR(x3, x7, x11, x15);
+
+		QR(x0, x5, x10, x15);
+		QR(x1, x6, x11, x12);
+		QR(x2, x7, x8, x13);
+		QR(x3, x4, x9, x14);
+	}
+
+	x0 += in->d[0]; x1 += in->d[1]; x2 += in->d[2]; x3 += in->d[3];
+	x4 += in->d[4]; x5 += in->d[5]; x6 += in->d[6]; x7 += in->d[7];
+	x8 += in->d[8]; x9 += in->d[9]; x10 += in->d[10]; x11 += in->d[11];
+	x12 += in->d[12]; x13 += in->d[13]; x14 += in->d[14]; x15 += in->d[15];
+
+	out->d[0] = cpu_to_le32(x0);
+	out->d[1] = cpu_to_le32(x1);
+	out->d[2] = cpu_to_le32(x2);
+	out->d[3] = cpu_to_le32(x3);
+	out->d[4] = cpu_to_le32(x4);
+	out->d[5] = cpu_to_le32(x5);
+	out->d[6] = cpu_to_le32(x6);
+	out->d[7] = cpu_to_le32(x7);
+	out->d[8] = cpu_to_le32(x8);
+	out->d[9] = cpu_to_le32(x9);
+	out->d[10] = cpu_to_le32(x10);
+	out->d[11] = cpu_to_le32(x11);
+	out->d[12] = cpu_to_le32(x12);
+	out->d[13] = cpu_to_le32(x13);
+	out->d[14] = cpu_to_le32(x14);
+	out->d[15] = cpu_to_le32(x15);
+}
+
+/* only 2 valids values are 256 (32) and 128 (16) */
+void cryptonite_chacha_init_core(cryptonite_chacha_state *st,
+                                 uint32_t keylen, const uint8_t *key,
+                                 uint32_t ivlen, const uint8_t *iv)
+{
+	const uint8_t *constants = (keylen == 32) ? sigma : tau;
+
+	ASSERT_ALIGNMENT(constants, 4);
+
+	st->d[0] = load_le32_aligned(constants + 0);
+	st->d[1] = load_le32_aligned(constants + 4);
+	st->d[2] = load_le32_aligned(constants + 8);
+	st->d[3] = load_le32_aligned(constants + 12);
+
+	st->d[4] = load_le32(key + 0);
+	st->d[5] = load_le32(key + 4);
+	st->d[6] = load_le32(key + 8);
+	st->d[7] = load_le32(key + 12);
+	/* we repeat the key on 128 bits */
+	if (keylen == 32)
+		key += 16;
+	st->d[8] = load_le32(key + 0);
+	st->d[9] = load_le32(key + 4);
+	st->d[10] = load_le32(key + 8);
+	st->d[11] = load_le32(key + 12);
+	st->d[12] = 0;
+	switch (ivlen) {
+	case 8:
+		st->d[13] = 0;
+		st->d[14] = load_le32(iv + 0);
+		st->d[15] = load_le32(iv + 4);
+		break;
+	case 12:
+		st->d[13] = load_le32(iv + 0);
+		st->d[14] = load_le32(iv + 4);
+		st->d[15] = load_le32(iv + 8);
+	default:
+		return;
+	}
+}
+
+void cryptonite_chacha_init(cryptonite_chacha_context *ctx, uint8_t nb_rounds,
+                            uint32_t keylen, const uint8_t *key,
+                            uint32_t ivlen, const uint8_t *iv)
+{
+	memset(ctx, 0, sizeof(*ctx));
+	ctx->nb_rounds = nb_rounds;
+	cryptonite_chacha_init_core(&ctx->st, keylen, key, ivlen, iv);
+}
+
+void cryptonite_chacha_combine(uint8_t *dst, cryptonite_chacha_context *ctx, const uint8_t *src, uint32_t bytes)
+{
+	block out;
+	cryptonite_chacha_state *st;
+	int i;
+
+	if (!bytes)
+		return;
+
+	/* xor the previous buffer first (if any) */
+	if (ctx->prev_len > 0) {
+		int to_copy = (ctx->prev_len < bytes) ? ctx->prev_len : bytes;
+		for (i = 0; i < to_copy; i++)
+			dst[i] = src[i] ^ ctx->prev[ctx->prev_ofs+i];
+		memset(ctx->prev + ctx->prev_ofs, 0, to_copy);
+		ctx->prev_len -= to_copy;
+		ctx->prev_ofs += to_copy;
+		src += to_copy;
+		dst += to_copy;
+		bytes -= to_copy;
+	}
+
+	if (bytes == 0)
+		return;
+
+	st = &ctx->st;
+
+	/* xor new 64-bytes chunks and store the left over if any */
+	for (; bytes >= 64; bytes -= 64, src += 64, dst += 64) {
+		/* generate new chunk and update state */
+		chacha_core(ctx->nb_rounds, &out, st);
+		st->d[12] += 1;
+		if (st->d[12] == 0)
+			st->d[13] += 1;
+
+		for (i = 0; i < 64; ++i)
+			dst[i] = src[i] ^ out.b[i];
+	}
+
+	if (bytes > 0) {
+		/* generate new chunk and update state */
+		chacha_core(ctx->nb_rounds, &out, st);
+		st->d[12] += 1;
+		if (st->d[12] == 0)
+			st->d[13] += 1;
+
+		/* xor as much as needed */
+		for (i = 0; i < bytes; i++)
+			dst[i] = src[i] ^ out.b[i];
+		
+		/* copy the left over in the buffer */
+		ctx->prev_len = 64 - bytes;
+		ctx->prev_ofs = i;
+		for (; i < 64; i++) {
+			ctx->prev[i] = out.b[i];
+		}
+	}
+}
+
+void cryptonite_chacha_generate(uint8_t *dst, cryptonite_chacha_context *ctx, uint32_t bytes)
+{
+	cryptonite_chacha_state *st;
+	block out;
+	int i;
+
+	if (!bytes)
+		return;
+
+	/* xor the previous buffer first (if any) */
+	if (ctx->prev_len > 0) {
+		int to_copy = (ctx->prev_len < bytes) ? ctx->prev_len : bytes;
+		for (i = 0; i < to_copy; i++)
+			dst[i] = ctx->prev[ctx->prev_ofs+i];
+		memset(ctx->prev + ctx->prev_ofs, 0, to_copy);
+		ctx->prev_len -= to_copy;
+		ctx->prev_ofs += to_copy;
+		dst += to_copy;
+		bytes -= to_copy;
+	}
+
+	if (bytes == 0)
+		return;
+
+	st = &ctx->st;
+
+	if (ALIGNED64(dst)) {
+		/* xor new 64-bytes chunks and store the left over if any */
+		for (; bytes >= 64; bytes -= 64, dst += 64) {
+			/* generate new chunk and update state */
+			chacha_core(ctx->nb_rounds, (block *) dst, st);
+			st->d[12] += 1;
+			if (st->d[12] == 0)
+				st->d[13] += 1;
+		}
+	} else {
+		/* xor new 64-bytes chunks and store the left over if any */
+		for (; bytes >= 64; bytes -= 64, dst += 64) {
+			/* generate new chunk and update state */
+			chacha_core(ctx->nb_rounds, &out, st);
+			st->d[12] += 1;
+			if (st->d[12] == 0)
+				st->d[13] += 1;
+
+			for (i = 0; i < 64; ++i)
+				dst[i] = out.b[i];
+		}
+	}
+
+	if (bytes > 0) {
+		/* generate new chunk and update state */
+		chacha_core(ctx->nb_rounds, &out, st);
+		st->d[12] += 1;
+		if (st->d[12] == 0)
+			st->d[13] += 1;
+
+		/* xor as much as needed */
+		for (i = 0; i < bytes; i++)
+			dst[i] = out.b[i];
+		
+		/* copy the left over in the buffer */
+		ctx->prev_len = 64 - bytes;
+		ctx->prev_ofs = i;
+		for (; i < 64; i++)
+			ctx->prev[i] = out.b[i];
+	}
+}
+
+void cryptonite_chacha_random(uint32_t rounds, uint8_t *dst, cryptonite_chacha_state *st, uint32_t bytes)
+{
+	block out;
+
+	if (!bytes)
+		return;
+	for (; bytes >= 16; bytes -= 16, dst += 16) {
+		chacha_core(rounds, &out, st);
+		memcpy(dst, out.b + 40, 16);
+		cryptonite_chacha_init_core(st, 32, out.b, 8, out.b + 32);
+	}
+	if (bytes) {
+		chacha_core(rounds, &out, st);
+		memcpy(dst, out.b + 40, bytes);
+		cryptonite_chacha_init_core(st, 32, out.b, 8, out.b + 32);
+	}
+}
@@ -0,0 +1,54 @@
+/*
+ * Copyright (c) 2014 Vincent Hanquez <vincent@snarc.org>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of the author nor the names of his contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+#ifndef CRYPTONITE_CHACHA
+#define CRYPTONITE_CHACHA
+
+typedef union {
+	uint64_t q[8];
+	uint32_t d[16];
+	uint8_t  b[64];
+} block;
+
+typedef block cryptonite_chacha_state;
+
+typedef struct {
+	cryptonite_chacha_state st;
+	uint8_t prev[64];
+	uint8_t prev_ofs;
+	uint8_t prev_len;
+	uint8_t nb_rounds;
+} cryptonite_chacha_context;
+
+void cryptonite_chacha_init_core(cryptonite_chacha_state *st, uint32_t keylen, const uint8_t *key, uint32_t ivlen, const uint8_t *iv);
+void cryptonite_chacha_init(cryptonite_chacha_context *ctx, uint8_t nb_rounds, uint32_t keylen, const uint8_t *key, uint32_t ivlen, const uint8_t *iv);
+void cryptonite_chacha_combine(uint8_t *dst, cryptonite_chacha_context *st, const uint8_t *src, uint32_t bytes);
+void cryptonite_chacha_generate(uint8_t *dst, cryptonite_chacha_context *st, uint32_t bytes);
+
+#endif
@@ -0,0 +1,90 @@
+/*
+ * Copyright (C) 2020 Olivier Chéron <olivier.cheron@gmail.com>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <cryptonite_hash_prefix.h>
+
+void CRYPTONITE_HASHED(finalize_prefix)(struct HASHED_LOWER(ctx) *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out)
+{
+	uint64_t bits[HASHED(BITS_ELEMS)];
+	uint8_t *p = (uint8_t *) &bits;
+	uint32_t index, padidx, padlen, pos, out_mask;
+	static const uint32_t cut_off = HASHED(BLOCK_SIZE) - sizeof(bits);
+
+	/* Make sure n <= len */
+	n += (len - n) & constant_time_lt(len, n);
+
+	/* Initial index, based on current context state */
+	index = CRYPTONITE_HASHED(get_index)(ctx);
+
+	/* Final size after n bytes */
+	CRYPTONITE_HASHED(incr_sz)(ctx, bits, n);
+
+	/* Padding index and length */
+	padidx = CRYPTONITE_HASHED(get_index)(ctx);
+	padlen = HASHED(BLOCK_SIZE) + cut_off - padidx;
+	padlen -= HASHED(BLOCK_SIZE) & constant_time_lt(padidx, cut_off);
+
+	/* Initialize buffers because we will XOR into them */
+	memset(ctx->buf + index, 0, HASHED(BLOCK_SIZE) - index);
+	memset(out, 0, HASHED(DIGEST_SIZE));
+	pos = 0;
+
+	/* Iterate based on the full buffer length, regardless of n, and include
+	 * the maximum overhead with padding and size bytes
+	 */
+	while (pos < len + HASHED(BLOCK_SIZE) + sizeof(bits)) {
+		uint8_t b;
+
+		/* Take as many bytes from the input buffer as possible */
+		if (pos < len)
+			b = *(data++) & (uint8_t) constant_time_lt(pos, n);
+		else
+			b = 0;
+
+		/* First padding byte */
+		b |= 0x80 & (uint8_t) constant_time_eq(pos, n);
+
+		/* Size bytes are always at the end of a block */
+		if (index >= cut_off)
+			b |= p[index - cut_off] & (uint8_t) constant_time_ge(pos, n + padlen);
+
+		/* Store this byte into the buffer */
+		ctx->buf[index++] ^= b;
+		pos++;
+
+		/* Process a full block, at a boundary which is independent from n */
+		if (index >= HASHED(BLOCK_SIZE)) {
+			index = 0;
+			HASHED_LOWER(do_chunk)(ctx, (void *) ctx->buf);
+			memset(ctx->buf, 0, HASHED(BLOCK_SIZE));
+
+			/* Try to store the result: this is a no-op except when we reach the
+			 * actual size based on n, more iterations may continue after that
+			 * when len is really larger
+			 */
+			out_mask = constant_time_eq(pos, n + padlen + sizeof(bits));
+			CRYPTONITE_HASHED(select_digest)(ctx, out, out_mask);
+		}
+	}
+}
@@ -0,0 +1,65 @@
+/*
+ * Copyright (C) 2020 Olivier Chéron <olivier.cheron@gmail.com>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *	notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *	notice, this list of conditions and the following disclaimer in the
+ *	documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef CRYPTONITE_HASH_PREFIX_H
+#define CRYPTONITE_HASH_PREFIX_H
+
+#include <stdint.h>
+
+static inline uint32_t constant_time_msb(uint32_t a)
+{
+	return 0 - (a >> 31);
+}
+
+static inline uint32_t constant_time_lt(uint32_t a, uint32_t b)
+{
+	return constant_time_msb(a ^ ((a ^ b) | ((a - b) ^ b)));
+}
+
+static inline uint32_t constant_time_ge(uint32_t a, uint32_t b)
+{
+	return ~constant_time_lt(a, b);
+}
+
+static inline uint32_t constant_time_is_zero(uint32_t a)
+{
+	return constant_time_msb(~a & (a - 1));
+}
+
+static inline uint32_t constant_time_eq(uint32_t a, uint32_t b)
+{
+	return constant_time_is_zero(a ^ b);
+}
+
+static inline uint64_t constant_time_msb_64(uint64_t a)
+{
+	return 0 - (a >> 63);
+}
+
+static inline uint64_t constant_time_lt_64(uint64_t a, uint64_t b)
+{
+	return constant_time_msb_64(a ^ ((a ^ b) | ((a - b) ^ b)));
+}
+
+#endif
@@ -0,0 +1,209 @@
+/*
+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <string.h>
+#include "cryptonite_bitfn.h"
+#include "cryptonite_align.h"
+#include "cryptonite_sha512.h"
+
+void sxc_cryptonite_sha512_init(struct sha512_ctx *ctx)
+{
+	memset(ctx, 0, sizeof(*ctx));
+
+	ctx->h[0] = 0x6a09e667f3bcc908ULL;
+	ctx->h[1] = 0xbb67ae8584caa73bULL;
+	ctx->h[2] = 0x3c6ef372fe94f82bULL;
+	ctx->h[3] = 0xa54ff53a5f1d36f1ULL;
+	ctx->h[4] = 0x510e527fade682d1ULL;
+	ctx->h[5] = 0x9b05688c2b3e6c1fULL;
+	ctx->h[6] = 0x1f83d9abfb41bd6bULL;
+	ctx->h[7] = 0x5be0cd19137e2179ULL;
+}
+
+/* 232 times the cube root of the first 64 primes 2..311 */
+static const uint64_t k[] = {
+	0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL,
+	0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL,
+	0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 0xd807aa98a3030242ULL,
+	0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL,
+	0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL,
+	0xc19bf174cf692694ULL, 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL,
+	0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 0x2de92c6f592b0275ULL,
+	0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL,
+	0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL,
+	0xbf597fc7beef0ee4ULL, 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL,
+	0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 0x27b70a8546d22ffcULL,
+	0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL,
+	0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL,
+	0x92722c851482353bULL, 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL,
+	0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 0xd192e819d6ef5218ULL,
+	0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL,
+	0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL,
+	0x34b0bcb5e19b48a8ULL, 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL,
+	0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 0x748f82ee5defb2fcULL,
+	0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL,
+	0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL,
+	0xc67178f2e372532bULL, 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL,
+	0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 0x06f067aa72176fbaULL,
+	0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL,
+	0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL,
+	0x431d67c49c100d4cULL, 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL,
+	0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL,
+};
+
+#define e0(x)       (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39))
+#define e1(x)       (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41))
+#define s0(x)       (ror64(x, 1) ^ ror64(x, 8) ^ (x >> 7))
+#define s1(x)       (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6))
+
+static void sha512_do_chunk(struct sha512_ctx *ctx, uint64_t *buf)
+{
+	uint64_t a, b, c, d, e, f, g, h, t1, t2;
+	int i;
+	uint64_t w[80];
+
+	cpu_to_be64_array(w, buf, 16);
+
+	for (i = 16; i < 80; i++)
+		w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16];
+
+	a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3];
+	e = ctx->h[4]; f = ctx->h[5]; g = ctx->h[6]; h = ctx->h[7];
+
+#define R(a, b, c, d, e, f, g, h, k, w)			\
+	t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w;	\
+	t2 = e0(a) + ((a & b) | (c & (a | b)));		\
+	d += t1;					\
+	h = t1 + t2
+
+	for (i = 0; i < 80; i += 8) {
+		R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]);
+		R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]);
+		R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]);
+		R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]);
+		R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]);
+		R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]);
+		R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]);
+		R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]);
+	}
+
+#undef R
+
+	ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d;
+	ctx->h[4] += e; ctx->h[5] += f; ctx->h[6] += g; ctx->h[7] += h;
+}
+
+void sxc_cryptonite_sha512_update(struct sha512_ctx *ctx, const uint8_t *data, uint32_t len)
+{
+	unsigned int index, to_fill;
+
+	/* check for partial buffer */
+	index = (unsigned int) (ctx->sz[0] & 0x7f);
+	to_fill = 128 - index;
+
+	ctx->sz[0] += len;
+	if (ctx->sz[0] < len)
+		ctx->sz[1]++;
+
+	/* process partial buffer if there's enough data to make a block */
+	if (index && len >= to_fill) {
+		memcpy(ctx->buf + index, data, to_fill);
+		sha512_do_chunk(ctx, (uint64_t *) ctx->buf);
+		len -= to_fill;
+		data += to_fill;
+		index = 0;
+	}
+
+	if (need_alignment(data, 8)) {
+		uint64_t tramp[16];
+		ASSERT_ALIGNMENT(tramp, 8);
+		for (; len >= 128; len -= 128, data += 128) {
+			memcpy(tramp, data, 128);
+			sha512_do_chunk(ctx, tramp);
+		}
+	} else {
+		/* process as much 128-block as possible */
+		for (; len >= 128; len -= 128, data += 128)
+			sha512_do_chunk(ctx, (uint64_t *) data);
+	}
+
+	/* append data into buf */
+	if (len)
+		memcpy(ctx->buf + index, data, len);
+}
+
+void sxc_cryptonite_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out)
+{
+	static uint8_t padding[128] = { 0x80, };
+	uint32_t i, index, padlen;
+	uint64_t bits[2];
+
+	/* cpu -> big endian */
+	bits[0] = cpu_to_be64((ctx->sz[1] << 3 | ctx->sz[0] >> 61));
+	bits[1] = cpu_to_be64((ctx->sz[0] << 3));
+
+	/* pad out to 56 */
+	index = (unsigned int) (ctx->sz[0] & 0x7f);
+	padlen = (index < 112) ? (112 - index) : ((128 + 112) - index);
+	cryptonite_sha512_update(ctx, padding, padlen);
+
+	/* append length */
+	cryptonite_sha512_update(ctx, (uint8_t *) bits, sizeof(bits));
+
+	/* store to digest */
+	for (i = 0; i < 8; i++)
+		store_be64(out+8*i, ctx->h[i]);
+}
+
+#define HASHED(m) SHA512_##m
+#define HASHED_LOWER(m) sha512_##m
+#define CRYPTONITE_HASHED(m) sxc_cryptonite_sha512_##m
+#define SHA512_BLOCK_SIZE 128
+#define SHA512_BITS_ELEMS 2
+
+#include <cryptonite_hash_prefix.h>
+
+static inline uint32_t sxc_cryptonite_sha512_get_index(const struct sha512_ctx *ctx)
+{
+	return (uint32_t) (ctx->sz[0] & 0x7f);
+}
+
+static inline void sxc_cryptonite_sha512_incr_sz(struct sha512_ctx *ctx, uint64_t *bits, uint32_t n)
+{
+	ctx->sz[0] += n;
+	ctx->sz[1] += 1 & constant_time_lt_64(ctx->sz[0], n);
+	bits[0] = cpu_to_be64((ctx->sz[1] << 3 | ctx->sz[0] >> 61));
+	bits[1] = cpu_to_be64((ctx->sz[0] << 3));
+}
+
+static inline void sxc_cryptonite_sha512_select_digest(const struct sha512_ctx *ctx, uint8_t *out, uint32_t out_mask)
+{
+	uint32_t i;
+	uint64_t out_mask_64 = out_mask;
+	out_mask_64 |= out_mask_64 << 32;
+	for (i = 0; i < 8; i++)
+		xor_be64(out+8*i, ctx->h[i] & out_mask_64);
+}
+
+#include <cryptonite_hash_prefix.c>
@@ -0,0 +1,61 @@
+/*
+ * Copyright (C) 2006-2009 Vincent Hanquez <vincent@snarc.org>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef CRYPTOHASH_SHA512_H
+#define CRYPTOHASH_SHA512_H
+
+#include <stdint.h>
+
+# define SHA512_BLOCK_SIZE 128
+
+struct sha512_ctx
+{
+	uint64_t sz[2];
+	uint8_t  buf[SHA512_BLOCK_SIZE];
+	uint64_t h[8];
+};
+
+#define sha384_ctx sha512_ctx
+
+#define SHA384_DIGEST_SIZE	48
+#define SHA384_CTX_SIZE		sizeof(struct sha384_ctx)
+
+#define SHA512_DIGEST_SIZE	64
+#define SHA512_CTX_SIZE		sizeof(struct sha512_ctx)
+
+void cryptonite_sha384_init(struct sha384_ctx *ctx);
+void cryptonite_sha384_update(struct sha384_ctx *ctx, const uint8_t *data, uint32_t len);
+void cryptonite_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out);
+void cryptonite_sha384_finalize_prefix(struct sha384_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out);
+
+void cryptonite_sha512_init(struct sha512_ctx *ctx);
+void cryptonite_sha512_update(struct sha512_ctx *ctx, const uint8_t *data, uint32_t len);
+void cryptonite_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out);
+void cryptonite_sha512_finalize_prefix(struct sha512_ctx *ctx, const uint8_t *data, uint32_t len, uint32_t n, uint8_t *out);
+
+/* only multiples of 8 are supported as valid t values */
+void cryptonite_sha512t_init(struct sha512_ctx *ctx, uint32_t hashlen);
+void cryptonite_sha512t_update(struct sha512_ctx *ctx, const uint8_t *data, uint32_t len);
+void cryptonite_sha512t_finalize(struct sha512_ctx *ctx, uint32_t hashlen, uint8_t *out);
+
+#endif
@@ -1,9 +0,0 @@
-#include <openssl/sha.h>
-#include "sha512.h"
-
-void crypto_hash_sha512 (unsigned char *out,
-                         const unsigned char *in,
-                         unsigned long long inlen)
-{
-  SHA512(in, inlen, out);
-}
@@ -6,9 +6,10 @@
 * - Christine van Vredendaal
 */

+// #include <openssl/sha.h>
 #include "sntrup761.h"
-
-#include "sha512.h"
+#include "sntrup_sha512.h"
+#include "sntrup_random.h"

 /* from supercop-20201130/crypto_sort/int32/portable4/int32_minmax.inc */
 #define int32_MINMAX(a,b) \
@@ -684,7 +685,7 @@ Hash_prefix (unsigned char *out, int b, const unsigned char *in, int inlen)
 /* ----- higher-level randomness */

 static uint32_t
-urandom32 (void *random_ctx, sntrup761_random_func * random)
+urandom32 (void *random_ctx, random_func * random)
 {
  unsigned char c[4];
  uint32_t out[4];
@@ -698,7 +699,7 @@ urandom32 (void *random_ctx, sntrup761_random_func * random)
 }

 static void
-Short_random (small * out, void *random_ctx, sntrup761_random_func * random)
+Short_random (small * out, void *random_ctx, random_func * random)
 {
  uint32_t L[p];
  int i;
@@ -709,7 +710,7 @@ Short_random (small * out, void *random_ctx, sntrup761_random_func * random)
 }

 static void
-Small_random (small * out, void *random_ctx, sntrup761_random_func * random)
+Small_random (small * out, void *random_ctx, random_func * random)
 {
  int i;

@@ -722,7 +723,7 @@ Small_random (small * out, void *random_ctx, sntrup761_random_func * random)
 /* h,(f,ginv) = KeyGen() */
 static void
 KeyGen (Fq * h, small * f, small * ginv, void *random_ctx,
-        sntrup761_random_func * random)
+        random_func * random)
 {
  small g[p];
  Fq finv[p];
@@ -886,7 +887,7 @@ typedef small Inputs[p];        /* passed by reference */
 /* pk,sk = ZKeyGen() */
 static void
 ZKeyGen (unsigned char *pk, unsigned char *sk, void *random_ctx,
-         sntrup761_random_func * random)
+         random_func * random)
 {
  Fq h[p];
  small f[p], v[p];
@@ -962,7 +963,7 @@ HashSession (unsigned char *k, int b, const unsigned char *y,
 /* pk,sk = KEM_KeyGen() */
 void
 sntrup761_keypair (unsigned char *pk, unsigned char *sk, void *random_ctx,
-                   sntrup761_random_func * random)
+                   random_func * random)
 {
  int i;

@@ -989,7 +990,7 @@ Hide (unsigned char *c, unsigned char *r_enc, const Inputs r,
 /* c,k = Encap(pk) */
 void
 sntrup761_enc (unsigned char *c, unsigned char *k, const unsigned char *pk,
-               void *random_ctx, sntrup761_random_func * random)
+               void *random_ctx, random_func * random)
 {
  Inputs r;
  unsigned char r_enc[Inputs_bytes];
@@ -11,23 +11,22 @@

 #include <string.h>
 #include <stdint.h>
+#include "sntrup_random.h"

 #define SNTRUP761_SECRETKEY_SIZE 1763
 #define SNTRUP761_PUBLICKEY_SIZE 1158
 #define SNTRUP761_CIPHERTEXT_SIZE 1039
 #define SNTRUP761_SIZE 32

-typedef void sntrup761_random_func (void *ctx, size_t length, uint8_t *dst);
-
 void
 sntrup761_keypair (uint8_t *pk, uint8_t *sk,
-                   void *random_ctx, sntrup761_random_func *random);
+                   void *random_ctx, random_func *random);

 void
 sntrup761_enc (uint8_t *c, uint8_t *k, const uint8_t *pk,
-               void *random_ctx, sntrup761_random_func *random);
+               void *random_ctx, random_func *random);

 void
 sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);

-#endif /* SNTRUP761_H */
+#endif
@@ -0,0 +1,6 @@
+#include <string.h>
+#include "sntrup_random.h"
+
+void sxcrandom_dummy (void *ctx, size_t length, uint8_t *dst) {
+  memset(dst, 0x00, length);
+}
@@ -0,0 +1,10 @@
+#ifndef SXCRANDOM_H
+#define SXCRANDOM_H
+
+#include <stdint.h>
+
+typedef void random_func (void *ctx, size_t length, uint8_t *dst);
+
+void sxcrandom_dummy (void *ctx, size_t length, uint8_t *dst);
+
+#endif
@@ -0,0 +1,13 @@
+// #include <openssl/sha.h>
+#include "cryptonite_sha512.h"
+#include "sntrup_sha512.h"
+
+void crypto_hash_sha512 (unsigned char *out,
+                         const unsigned char *in,
+                         unsigned long long inlen)
+{
+  struct sha512_ctx ctx;
+  cryptonite_sha512_init(&ctx);
+  cryptonite_sha512_update(&ctx, (const uint8_t *) in, (uint32_t) inlen);
+  cryptonite_sha512_finalize(&ctx, (uint8_t *) out);
+}
@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.5.0.4
+version: 5.4.0.3
 synopsis: SimpleXMQ message broker
 description: |
  This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -20,8 +20,8 @@ category: Chat, Network, Web, System, Cryptography
 extra-source-files:
  - README.md
  - CHANGELOG.md
-  - cbits/sha512.h
-  - cbits/sntrup761.h
+  - cbits/*.h
+  - cbits/*.c

 dependencies:
  - aeson == 2.2.*
@@ -32,31 +32,27 @@ dependencies:
  - attoparsec == 0.14.*
  - base >= 4.14 && < 5
  - base64-bytestring >= 1.0 && < 1.3
+  - bytestring == 0.11.*
  - 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.*
+  - cryptonite == 0.30.*
+  - cryptostore == 0.2.*
  - data-default == 0.7.*
  - direct-sqlcipher == 2.3.*
  - directory == 1.3.*
  - filepath == 1.4.*
  - hourglass == 0.2.*
  - http-types == 0.12.*
-  - http2 >= 4.2.2 && < 4.3
+  - http2 >= 4.1.4 && < 4.2
  - ini == 0.4.1
  - iproute == 1.7.*
  - iso8601-time == 0.1.*
  - memory == 0.18.*
-  - mtl >= 2.3.1 && < 3.0
+  - mtl == 2.3.*
  - 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
@@ -64,14 +60,20 @@ dependencies:
  - socks == 0.6.*
  - sqlcipher-simple == 0.4.*
  - stm == 2.5.*
+  - template-haskell == 2.20.*
  - temporary == 1.3.*
-  - time == 1.12.*
+  - text == 2.0.*
+  - time == 1.9.*
+  - time-compat == 1.9.*
  - time-manager == 0.0.*
-  - tls >= 1.7.0 && < 1.8
+  - tls >= 1.6.0 && < 1.7
  - transformers == 0.6.*
  - unliftio == 0.2.*
  - unliftio-core == 0.2.*
  - websockets == 0.12.*
+  - x509 == 1.7.*
+  - x509-store == 1.6.*
+  - x509-validation == 1.6.*
  - yaml == 0.11.*

 flags:
@@ -79,33 +81,23 @@ flags:
    description: Enable swift JSON format
    manual: True
    default: False
-  use_crypton:
-    description: Use crypton etc. in cryptostore
-    manual: True
-    default: True

 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/cryptonite_hash_prefix.c # gets included in sha512
+    - cbits/cryptonite_chacha.c
+    - cbits/cryptonite_sha512.c
+    - cbits/sntrup_random.c
+    - cbits/sntrup_sha512.c
    - cbits/sntrup761.c
  include-dirs: cbits
-  extra-libraries: crypto
+  # extra-libraries: crypto # not used for sha512

 executables:
  smp-server:
@@ -1,58 +0,0 @@
-# Re-sync encryption ratchets, queue rotation, message delivery receipts
-
-This is very unfocussed doc outlining several problems that seem somewhat related, and some possible solution approaches.
-
-## Problems
-
-When old database backup is used, the sending client encrypts the messages in a way that the receiving client cannot decrypt them, because it does not store the old keys, and does not try to decrypt ratchet headers using the old keys. When receiving the messages, the client that uses the old database is unable to decrypt them, either the header or the message itself (if more than 500 messages are skipped, or if root ratchet step happened).
-
-The same symptoms happen during the queue rotation, unfortunately, as we do not keep the history of received messages once they are acknowledged, so the client reports these error to the users.
-
-While these are two different problems, to the users they manifest in the same way, so it is difficult to differentiate.
-
-Another ratchet problem that should be solved as well is not deleting unused skipped keys after some time or some number of events, possibly it should be considered at the same time.
-
-While it is tempting to consider delivery receipts as an isolated problem, it is somewhat coupled, as the requests to re-sync ratchets and to re-deliver skipped messages are effectively delivery receipts.
-
-A naive solution to delivery receipts when each message is responded to with a confirmation has two downsides:
-
- it doubles the traffic.
- in the absense of delays, it also leaks some information about the network latency, that can be used to track user's location.
-
-Both problems can be mitigated by sending delivery receipts with a random delay, to confirm all messages sent, not each one. But this would only reduce the traffic when the sender sends many messages. Alternatively, we could think how to reduce the block size for SMP commands. The challenge is profile pictures and image previews, so to reduce traffic we need to start sending them as XFTP files, potentially with a smaller 64kb chunks (that would also increase preview quality).
-
-## Solution for queue rotation
-
-We need to:
- store and show the rotation status in the UI to prevent attempts to rotate the queue multiple times.
- process multiple message delivery events while there is a redundancy, to avoid errors in terminal.
- differentiate between decryption errors during queue rotation - that would require keeping the messages for some time, at least keeping their IDs and hashes together with some additional status. In this case when duplicate or old message arrives, we can check whether this message was already processed, and do not show error if it was.
-
-## Solution to re-sync ratchets
-
-When we establish that the receiving client is indeed unable to decrypt messages, we should:
- notify the user - it is already happening, but it happens in case of rotation as well.
- optionally, notify another client that message was not decrypted - this effectively becomes a delivery receipt. That could be a separate command triggered by the user in the UI.
- clients can get into this state at the same time, how do we handle concurrent requests? Possibly, we could design these messages so this is irrelevant whether the message is sent in response or not, and calculate the new ratchet keys once the clients have both the sent and received messages. After that both clients can send "ratchet reset" message:
-  - EKEY - message containing a new set of keys to initialize the ratchets
-  - EREADY - message confirming that the ratchet is ready, already e2e encrypted
-
-The downside of this approach, is that unlike the initial handshake, where the second ratchet key is sent in e2e encrypted response, this message will be sent only encrypted with queue key. We could change this protocol by adding EREPLY message, and the clients would know to ingnore EKEY with bigger hash of the keys, so that the client who sent keys with smaller hash would be processing response from another client (that is if EKEY is received after EKEY is sent).
-
-```
-A                B
-
-EKEY 1 ->        <- EKEY 2 (e2e encrypted with per-queue key only)
-EKEY 2 <-        -> EKEY 1
-1 < 2, wait      2 > 1, reply EREPLY 3 (e2e encrypted with ratchets)
-ratchet: 1, 3   ratchet: 3, 1
-```
-
-Once ratchets are re-synched the clients could additionally request delivery of skipped messages. As ratchets being out of sync is not the only problem when messages can be lost, it may be managed independently from the ratchet re-sync. This problem seems tied with delivery receipts too, as requesting to re-deliver some messages automatically confirms that some other messages were delivered.
-
-Alternatively, the request for ratchet sync can already contain the ID of the first failed message - that would allow the agent:
- stop sending messages until ratchets are in sync.
- re-deliver failed messages first.
- only then deliver any pending messages.
-
-This approach would probably result in a better UX (no out of order delivery), but requires tracking pending messages that are not attempted to deliver and to also insert old messages in the delivery queue with the old IDs.
@@ -1,34 +0,0 @@
-# SMP and XFTP delivery relays
-
-## Problem
-
-SimpleX network relies on SMP relays to hold sent messages while the recipient is offline. This design provides many advantages over pure p2p designs [1]. The threat model for relays is covered in [2].
-
-The problem with this design is that the relays are chosen by the recipients, and they as a result can be used to record transport addresses of the senders.
-
-Similar problem, but reversed, exists with XFTP design - XFTP relays are chosen by the senders and also can be modified to record transport addresses of the recipients.
-
-The current solution to this problem is to use onion routing to access relays, and many users do it already. The downside is that it requires additional configuration and can be complex to some users.
-
-## Solution approach
-
-Add a second type of relays to the network design.
-
-For SMP protocol, these relays would accept messages from the senders and deliver them to the recipients. If the recipient were to modify the relay used to receive the messages to also records senders' IP addresses, then they would only succeed in recording the IP address of the relay, not the sender.
-
-Similar relay can be introduced for XFTP protocol.
-
-The additional advantage of using the relays is the reduced number of network connections that need to be used, and reduced traffic.
-
-Compared with Tor this approach has:
- lower latency
- no centralized components or the registry of the servers
- still no visibility of the whole network to the relays, as sending relays do not need to randomly choose the next relay, but would forward the messages directly to the destination relay.
-
-The downside of this approach is that relays will have more visibility of the network than in the current design.
-
-## Implementation considerations
-
-1. Should this new relays be included in the existing SMP and XFTP protocols and servers, or should they be designed as separate protocols and servers?
-
-2. Should the client aim to choose the same host for delivery relay as the destination server (to reduce the traffic), if possible, or should it aim to choose a different host (to reduce metadata available to single host)? The answer to this would affect the answer to the first question.
@@ -1,240 +0,0 @@
-# Protecting IP addresses of the users from their contacts
-
-## Problem
-
-SMP protocol relays are chosen and can be controlled by the message recipients. It means that the recipients can find out IP addresses of message senders by modifying SMP relay code (or by using proxies and timing correlation), unless the senders use VPN or some overlay network. Tor is an audequate solution in most cases to mitigate it, but it requires additional technical knowledge to install and configure (even installing Orbot on Android is seen as "complex" by many users), and reduces usability because of higher latency.
-
-The lack of in-built IP address protection is the main concern of many users, particularly given that most people do not realise that it is lacking by default - without transport protection SimpleX is not perceived as a "whole product".
-
-Similarly, XFTP protocol relays are chosen by senders, and they can be used to detect file recipients' IP addresses.
-
-## Possible solutions
-
-1. Embed Tor in the client.
-
-Pros:
- no changes in the protocols/servers
- acceptable threat model for most users
- removes complexity of installing and configuring Tor
- probably, the most attractive option for Tor users
-
-Cons:
- higher latency and error rate
- higher resource usage
- requires us updating Tor client regularly
- restriction on Tor usage in some networks, so it would require supporting bridges in the app UI
- legislative restrictions on Tor usage, so it may require supporting multiple app versions, and won't solve the problem where Tor is not embedded
-
-2. Thin clients with hosted accounts.
-
-Host some part of the current client on the server and have another part running on the devices.
-
-Pros:
- substantially reduces the traffic for mobile clients
- probably the most attractive option for mass market users who expect to have an account on the server and be able to access it from multiple devices and via web.
-
-Cons:
- a lot of design and development
- makes accounts visible to the server
- the new protocol design to protect connections graph and message content from the hosting server.
- quite different threat model
-
-Overall, this is not a viable or even appropriate option for the current stage.
-
-3. SMP / XFTP proxy.
-
-Introduce SMP and XFTP protocol extenstions to allow message senders and file recipients to delegate the tasks of sending messages and receiving files to the proxies, so that peer-chosen relays can only observe IP addresses of the proxies and not of the users.
-
-Pros:
- no dependency on and lower latency than via Tor
- reduces client traffic, both due to retries handled by these proxies and due to the smaller number of connections to the peer-chosen relays. The flip side is that additional commands (and traffic) are needed to create the sessions with relays.
- higher transport privacy: protects IP addresses from peers and makes transport correlation harder.
- additional function: retrying pending messages, while the queue is not secured yet, without extra traffic for the clients.
- improves current threat model by preventing session-based correlation of the traffic by the destination relay (assuming no information sharing with the proxies), as there will be one session between proxy and destination relay, mixing traffic from multiple users.
-
-Cons:
- design and development cost
- can undermine delivery stability
-
-This seems an attractive option, both from technical (reasonable complexity) and positioning (moving SimpleX closer to mix networks, while still avoiding server list visibility) points of view, and it is in the middle between embedding Tor, which would make the product more niche and has downsides and development costs too, and thin clients, which is 10x+ more work, and also creates a different threat model, that is not very attractive for the current stage and users.
-
-Below considers this design.
-
-## SMP/XFTP proxy design
-
-### Design requirements
-
-1. To avoid increasing the complexity of self-hosting, we should not create additional server types, and existing SMP and XFTP servers should be extended to provide proxy functions.
-
-2. SMP proxy should not be able to observe queue addresses and their count on the destination relays. This requirement is not needed for XFTP proxies, as each file chunk is downloaded only once, so there is no need to hide its address.
-
-3. There must be no identifiers and cyphertext in common in outgoing and incoming traffic inside TLS (the current designs have this quality).
-
-4. Traffic between the client and destination relays must be e2e encrypted, with MITM-by-proxy mitigated, relying on the relay identity (certificate fingerprint), ideally without any additional fingerprint in relay address.
-
-5. SMP proxy should implement retry logic and hold messages while they are delivered. They also should return relay replies to the client. To avoid any additional traffic the client should just add "sent to proxy" status and only show "sent" once proxy returns the response from the destination relay - there should be no additional response from the proxy confirming acceptance to delivery.
-
-This would also reduce the difference in how the traffic looks to the observer - sending via proxy may look similar to sending to the usual server (which can be further supported by friendly destination relays that could add latency for direct requests and reply quickly when response came via proxy and be undermined by hostile relays that would introduce some latency pattern to help traffic correlation. The latter problem can be mitigated by having a fixed response latency from proxy that may be "come back later for destination response").
-
-6. Sending messages to groups have to be batched in the client to avoid multiple requests for destination relay sessions - such requests can be batched to proxy, even though it leaks _some_ metadata - which destination relays are used by a given sender's IP address, it also reduces the overhead from proxies – it could be an option based on the privacy slider.
-
-6. SMP proxy may also increase utility and privacy of the platform:
-
- holding messages and retrying them for the new connections while the receiving queue is not secured yet.
- add delays in message delivery to make traffic correlation harder (same can be done in SMP relays).
-
-### Implementation considerations
-
-1. Block size. Possibly, there is not enough spare capacity in the current 16kb block to fit additional headers, any necessary metadata and encryption authentication tags, in which case we cannot send SMP and SMP-proxy traffic in the same transport connection (in case the same server plays both roles). In which case we will need to negotiate role during connection handshake and define a different (sub-)protocol for SMP-proxy.
-
-2. To be decided if we see it as extension of SMP protocol or as another protocol, irrespective of whether it's provided by the same or another server. Given different roles and block size it may be simpler to see it as a separate protocol, and which protocol is provided in the connection is determined during handshake.
-
-3. We probably should aim to avoid changing agent/client logic and see it instead as transport concern that can be dynamically decided at a point of sending a message, based on the current configuration.
-
-4. Configuration should probably allow to choose between not using proxies (particularly, during testing, when it would be the default), using proxies only for unknown relays, and using proxies for all relays (extra traffic, but more complex transport correlation - although randomizing this choice can be more beneficial to the transport privacy). The clients can aim to use proxy from another provider, to reduce the risks of sharing the information.
-
-### SMP-proxy protocol
-
-The flow of the messages will be:
-
-1. Client requests proxy to create session with the relay by sending `server` command with the SMP relay address and optional proxy basic AUTH (below). It should be possible to batch multiple session requests into one block, to reduce traffic.
-
-2. Proxy connects to SMP relay, negotiating a shared secret in the handshake that will be used to encrypt all sender blocks inside TLS (proxy-relay encryption). SMP relay also returns in handshake its temporary DH key to agree e2e encryption with the client (sender-relay encryption, to hide metadata sent to the destination relay from proxy).
-
-3. Proxy replies with `server_id` command including relay session ID to identify it in further requests, relay DH key for e2e encryption with the client - this key is signed with the TLS online private key associated with the certificate (its fingerprint is included in the relay address), and the TLS session ID between proxy and relay (this session ID must be used in transmissions, to mitigate replay attacks as before).
-
-A possible attack here is that proxy can use this TLS session to replay commands received from the client. Possibly, it could be mitigated with a bloom filter per proxy/SMP relay connection that would reject the repeated DH keys (that need to be used for replay), and also with DH key expiration (this mitigation should allow some acceptable rate of false positives from the bloom filter).
-
-With 32 bits per key there will be ~1/1,000,000 false positives (see https://en.wikipedia.org/wiki/Bloom_filter), and the filter would use ~32mb per each proxy connection if we reset relay key every 1000000 messages or more frequently. Given that the only commands accepted via relay would be SEND, replaying it would be interpreted by the receiving client as duplicate message delivery, so a small number of replayed messages won't cause any problems. But without mitigation it could be used to flood the receiving SMP relay queues with repeated messages, effectively causing DoS on these queues, even in case when SMP relays require basic auth to create queues.
-
-Given that the client chooses proxy it has some trust to, maybe this replay attack risk can be accepted.
-
-It is important that the same public key from destination relay is returned to all clients, so proxy does not need to repeat this request to know relays while the key did not expire, as using different keys for different clients would allow destination relays to correlate requests to the clients. A proxy that colludes with the destination relay can pass different public keys to the same client, but it is not changing threat model as colluding proxy can share information as well. It is also important that the client uses a new random key for each command, as using the same key would allow the destination relay to identify these commands as comming from the same user, and using a different key for each queue while would protect privacy of the user from the destination relay, would make it visible to the proxy how many different queues the client has on destination relay.
-
-*Unrelated cosideration for SMP protocol privacy improvement*: instead of signing commands to the destination relay, the sender could have a ratchet per queue agreed with the destination relay that would simply use authenticated encryption with per-message symmetric key to encrypt the message on the way to relay, and this encryption would be used as a proof of sender.
-
-4. Now the client sends `forward` to proxy, which it then forwards to SMP relay, applying additional encryption layer.
-
-5. SMP relay sends `response` to proxy applying additional encryption layer, which it then forwards to the client removing the additional encryption layer.
-
-Effectively it works as a simplified two-hop onion routing with the first relay (proxy) chosen by the sending client and the second relay chosen by the recipient, not only protecting senders' IP addresses from the recipients' relays, but also preventing recipients relays from correlating senders' traffic to different queues, as TLS session is owned by the proxy now and it mixes the traffic from multiple senders. To correlate traffic to users, proxy and relay would have to combine their information. SMP relays are still able to correlate traffic to receiving users via transport session.
-
-Sequence diagram for sending the message via SMP proxy:
-
-```
-------------               -------------                     -------------              -------------
-|  sending  |               |    SMP    |                     |    SMP    |              | receiving |
-|  client   |               |   proxy   |                     |   relay   |              |  client   |
-------------               -------------                     -------------              -------------
-     |       `server`             |                                 |                          |
-     | -------------------------> |   create TLS session, get keys  |                          |
-     |                            | ------------------------------> |                          |
-     |        `server_id`         |       (if doesn't exist)        |                          |
-     | <------------------------- |                                 |                          |
-     |                            |                                 |                          |
-     | TLS(F:s2r(SEND(e2e(msg)))) |                                 |                          |
-     | -------------------------> | TLS(F:p2r(s2r(SEND(e2e(msg))))) |                          |
-     |                            | ------------------------------> |                          |
-     |                            |                                 |                          |
-     |                            |     TLS(R:p2r(s2r(OK/ERR)))     |                          |
-     |     TLS(R:s2r(OK/ERR))     | <------------------------------ |                          |
-     | <------------------------- |                                 | TLS(MSG(r2c(e2e(msg))))  |
-     |                            |                                 | -----------------------> |
-     |                            |                                 |                          |
-     |                            |                                 |        TLS(ACK)          |
-     |                            |                                 | <----------------------- |
-     |                            |                                 |                          |
-     |                            |                                 |                          |
-
-```
-
-Below diagram shows the encrypttion layers for `forward` and `response` commands:
-
- s2r (added) - encryption between client and SMP relay, with relay key returned in server_id command, with MITM by proxy mitigated by verifying the certificate fingerprint included in the relay address.
- e2e (exists now) - end-to-end encryption per SMP queue, with double ratchet e2e encryption inside it.
- p2r (added) - additional encryption between proxy and SMP relay with key agreed in the handshake, to mitigate traffic correlation inside TLS. This key could also be signed by the same certificate, if we don't want to rely on TLS security.
- r2c (exists now) additional encryption between SMP relay and client to prevent traffic correlation inside TLS.
-
-```
-----------------             -----------------  -- TLS --  -----------------             -----------------
-|               |  -- TLS --  |               |  -- p2r --  |               |  -- TLS --  |               |
-|               |  -- s2r --  |               |  -- s2r --  |               |  -- r2c --  |               |
-|    sending    |  -- e2e --  |               |  -- e2e --  |               |  -- e2e --  |   receiving   |
-|    client     |     MSG     |   SMP proxy   |     MSG     |   SMP relay   |     MSG     |    client     |
-|               |  -- e2e --  |               |  -- e2e --  |               |  -- e2e --  |               |
-|               |  -- s2r --  |               |  -- s2r --  |               |  -- r2c --  |               |
-|               |  -- TLS --  |               |  -- p2r --  |               |  -- TLS --  |               |
-----------------             -----------------  -- TLS --  -----------------             -----------------
-```
-
-When proxy connects to SMP relay it would indicate in the handshake that it will use proxy protocol and the SMP relay would expect the same `forward` commands and reply with `response`s.
-
-Below syntax aims to fit in 16kb block using spare capacity in SMP protocol.
-
-```abnf
-proxy_block = padded(proxy_transmission, 16384)
-proxy_transmission = corr_id relay_session_id proxy_command
-corr_id = length *8 OCTET
-proxy_command = server / server_id / forward / response / error
-server = "S" address [relay_basic_auth] ; creates transport session between proxy and relay
-server_id = "I" relay_session_id tls_session_id signed_relay_key ;
-    ; session_id is the TLS session ID between proxy and relay, it has to be included inside encrypted block to prevent replay attacks
-forward = %s"F" random_dh_pub_key encrypted_block ; it's important that a new key is used for each command, to prevent any correlation by proxy or by destination relay
-response = %s"R" encrypted_block; response received from the destination SMP relay
-relay_session_id = length *8 OCTET
-error = %s"E" error
-```
-
-The overhead is: 1+8 (corrId) + 1+8 (relay_session_id) + 1 (command) + 1+32 (random_dh_pub_key) + 2 (original length) + 16 (auth tag for e2e encryption) + 16 (auth tag for proxy to relay encryption) = 86 bytes. The reserve for sent messages in SMP is ~84 bytes, so it should about fit with some reduced bytes somewhere.
-
-Another possible design is to allow mixing sent messages and normal SMP commands in the same transport connection, but it can make fitting in the block a bit harder, additional overhead would be: 1 (transmission count) + 2 (transmission size) + 1 (empty signature) = 4 bytes.
-
-The above assumes that the client can only send one message to an SMP relay and then has to wait for response before sending the next message. Missing the response would cause re-delivery (further improvement is possible when proxy detects these redelieveries and not send them to relays but simply reply with the same response).
-
-### Threat model for SMP proxy and changes to threat model for SMP
-
-#### SMP proxy
-
-*can:*
-
- learn a user's IP address, as long as Tor is not used.
-
- learn when a user with a given IP address is online.
-
- know how many messages are sent from a given IP address and to a given destination SMP relay.
-
- drop all messages from a given IP address or to a given destination relay.
-
- unless SMP relay detects repeated public DH keys of senders, replay messages to a destination relay within a single session, causing either duplicate message delivery (which will be detected and ignored by the receiving clients), or, when receiving client is not connected to SMP relay, exhausting capacity of destination queues used within the session.
-
-*cannot:*
-
- perform queue correlation (matching multiple queues to a single user), unless it has additional information from SMP relay.
-
- undetectably add, duplicate, or corrupt individual messages.
-
- undetectably drop individual messages, so long as a subsequent message is delivered.
-
- learn the contents of messages.
-
- learn the destination queues of messages.
-
- distinguish noise messages from regular messages except via timing regularities.
-
- compromise the user's end-to-end encryption with another user via an active attack.
-
- compromise the user's end-to-end encryption with destination relay via an active attack.
-
-#### SMP relay accessed via SMP proxy
-
-*still can:*
-
- perform recipients' queue correlation (matching multiple queues to a single recipient) via either a re-used transport connection, user's IP Address, or connection timing regularities
-
-*no longer can:*
-
- perform senders' queue correlation (matching multiple queues to a single sender) via either a re-used transport connection, user's IP Address, or connection timing regularities, unless it has additional information from SMP proxy.
-
- learn a sender's IP address, track them through other IP addresses they use to access the same queue, and infer information (e.g. employer) based on the IP addresses, even if Tor is not used.
-
-The rest of the threat model for SMP relays remains the same as in [overview](../protocol/overview-tjr.md#simplex-messaging-protocol-server).
@@ -1,361 +0,0 @@
-# SimpleX Remote Control protocol
-
-Using profiles in SimpleX Chat mobile app from desktop app with minimal risk to the security/threat model of SimpleX protocols.
-
-## Problem
-
-Synchronizing profiles that use double ratchet for e2e encryption is effectively impossible in a way that tolerates partitioning between devices without reducing security of double ratchet.
-
-We are not considering replacing (or weakening) double ratchet to allow profile synchronization, as some other messengers did (e.g., Session). We are also not considering Signal model, when profile is known to the server and adding devices results in changing security code and no visibility of conversation history, as it would be substantially different from the current model, and also effectively weakens the security, as in practives most users don't revalidate security codes when they change.
-
-## Solution
-
-The proposed solution is a new remote access/control protocol, when the application on host device (usually mobile) acts as a server, and application on another device (usually desktop) acts as a controller usually running in the same local network.
-
-Existing service discovery and remote control protocols known to us are vulnerable to spoofing, spamming and MITM attacks. This design aims to solve these problems.
-
-## Requirements
-
- Strong, cryptographically verified identity of the controller device, with the initial connection requiring out-of-band communication of public keys (QR code or link).
- Identity verification of the host device during session handshake.
- Protection against malicious "controllers" trying to make host connect to them instead of valid controller on the same network.
- Protection against replay attacks, both during discovery and during control session.
- Additional encryption layer inside TLS, with post-quantum algorithm in key agreement.
- Protect host device from unauthorized access in case of controller compromise.
- Post-compromised security - that is, even if long term secrets were copied from the controller, and host device was made to connect to malicious controller device, prevent malicious controller from accessing the host device data.
- Allow general high-level interactions common for many applications:
-  - RPC pattern for commands executed by the host application.
-  - Events sent by host to update controller UI.
-  - Uploading and downloading files between host and controller, either to be processed by the host or to be presented in the controller UI.
-
-This design will allow application-level protocol that is quite close to how SimpleX Chat UI interacts with SimpleX Chat core - there is a similar RPC + events protocol and support for files. The application-level protocol is out of scope of this specification.
-
-## Protocol phases
-
-Protocol consists of four phases:
- controller session invitation
- establishing session TLS connection
- session verification and protocol negotiation
- session operation
-
-### Session invitation
-
-The invitation to the first session between host and controller pair MUST be shared out-of-band, to establish a long term identity keys/certificates of the controller to host device.
-
-The subsequent sessions can be announced via an application-defined site-local multicast group, e.g. `224.0.0.251` (also used in mDNS/bonjour) and an application-defined port (SimpleX Chat uses 5227).
-
-The session invitation contains this data:
- supported version range for remote control protocol
- application-specific information, e.g. device name, application name and supported version range, settings, etc.
- session start time in seconds since epoch
- if multicast is used, counter of announce packets sent by controller
- network address (ipv4 address and port) of the controller
- 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. 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.
- Timestamp is within some window from the current time.
- Long-term key signature is valid.
- Long-term CA and signature key are the same as in the first session.
- Some version in the offered range is supported.
-
-OOB session invitation is a URI with this syntax:
-
-```abnf
-sessionAddressUri = "xrcp://" encodedCAFingerprint "@" host ":" port "#/?" qsParams
-encodedCAFingerprint = base64url
-qsParams = param *("&" param)
-param = versionRangeParam / appInfoParam / sessionTsParam /
-        sessPubKeyParam / idPubKeyParam / kemEncKeyParam / dhPubKeyParam /
-        sessSignatureParam / idSignatureParam
-versionRangeParam = "v=" (versionParam / (versionParam "-" versionParam))
-versionParam = 1*DIGIT
-appInfoParam = "app=" escapedJSON ; optional
-sessionTsParam = "ts=" 1*DIGIT
-sessPubKeyParam = "skey=" base64url ; required
-idPubKeyParam = "idkey=" base64url ; required
-dhPubKeyParam = "dh=" base64url ; required
-sessSignatureParam = "ssig=" base64url ; required, signs the URI with this and idSignatureParam param removed
-idSignatureParam = "idsig=" base64url ; required, signs the URI with this param removed
-base64url = <base64url encoded binary> ; RFC4648, section 5
-```
-
-Multicast session announcement is a binary encoded packet with this syntax:
-
-```abnf
-sessionAddressPacket = dhPubKey nonce encrypted(unpaddedSize sessionAddress packetPad)
-dhPubKey = length x509encoded ; same as announced
-nonce = length *OCTET
-sessionAddress = largeLength sessionAddressUri ; as above
-length = 1*1 OCTET ; for binary data up to 255 bytes
-largeLength = 2*2 OCTET ; for binary data up to 65535 bytes
-packetPad = <pad packet size to 1450 bytes> ; possibly, we may need to move KEM agreement one step later,
-; with encapsulation key in HELLO block and KEM ciphertext in reply to HELLO.
-```
-
-### Establishing session TLS connection
-
-Host connects to controller via TCP session and validates CA credentials during TLS handshake. Controller acts as a TCP server in this connection, to avoid host device listening on a port, which might create an attack vector. During TLS handshake the controller's TCP server MUST present a self-signed two-certificate chain where the fingerprint of the first certificate MUST be the same as in the announcement.
-
-Host device presents its own client certificate chain with CA representing a long-term identity of the host device.
-
-### Session verification and protocol negotiation
-
-Once TLS session is established, both the host and controller device present a "session security code" to the user who must match them (e.g., visually or via QR code scan) and confirm on the host device. The session security code must be a digest of tlsunique channel binding. As it is computed as a digest of the TLS handshake for both the controller and the host, it will validate that the same TLS certificates are used on both sides, and that the same TLS session is established, mitigating the possibility of MITM attack in the connection.
-
-Once the session is confirmed by the user, the host device sends "hello" block to the controller. ALPN TLS extension is not used to obtain tlsunique prior to sending any packets.
-
-Block size should be 16384 bytes.
-
-Host HELLO must contain:
- new session DH key - used to compute new shared secret with the controller keys from the announcement.
- encrypted part of hello block (JSON object), containing:
-  - chosen protocol version.
-  - host CA TLS certificate fingerprint - part of host long term identity - must match the one presented in TLS handshake and the previous sessions, otherwise the connection is terminated.
-  - KEM encapsulation key - used to compute new shared secret for the session.
-  - additional application specific parameters, e.g host device name, application version, host settings or JSON encoding format.
-
-Hello block syntax:
-
-```abnf
-hostHello = unpaddedSize %s"HELLO " dhPubKey nonce encrypted(unpaddedSize hostHelloJSON helloPad) pad
-unpaddedSize = largeLength
-dhPubKey = length x509encoded
-pad = <pad block size to 16384 bytes>
-helloPad = <pad hello size to 12888 bytes>
-largeLength = 2*2 OCTET
-```
-
-Controller decrypts (including the first session) and validates the received hello block:
- Chosen versions are supported (must be within offered ranges).
- CA fingerprint matches the one presented in TLS handshake and the previous sessions - in subsequent sessions TLS connection should be rejected if the fingerprint is different.
-
-JTD schema for the encrypted part of host HELLO block `hostHelloJSON`: 
-
-```json
-{
-  "definitions": {
-    "version": {
-      "type": "string",
-      "metadata": {
-        "format": "[0-9]+"
-      }
-    },
-    "base64url": {
-      "type": "string",
-      "metadata": {
-        "format": "base64url"
-      }
-    }
-  },
-  "properties": {
-    "v": {"ref": "version"},
-    "ca": {"ref": "base64url"},
-    "kem": {"ref": "base64url"}
-  },
-  "optionalProperties": {
-    "app": {"properties": {}, "additionalProperties": true}
-  },
-  "additionalProperties": true
-}
-```
-
-Controller should reply with with `hello` or `error` response:
-
-```abnf
-ctrlHello = unpaddedSize %s"HELLO " kemCyphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
-; ctrlHelloJSON is encrypted with the hybrid secret,
-; including both previously agreed DH secret and KEM secret from kemCyphertext
-unpaddedSize = largeLength
-kemCyphertext = largeLength *OCTET
-pad = <pad block size to 16384 bytes>
-helloPad = <pad hello size to 12888 bytes>
-largeLength = 2*2 OCTET
-
-ctrlError = unpaddedSize %s"ERROR " nonce encrypted(unpaddedSize ctrlErrorJSON helloPad) pad
-; ctrlErrorJSON is encrypted using previously agreed DH secret.
-```
-
-JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`:
-
-```json
-{
-  "properties": {},
-  "additionalProperties": true
-}
-```
-
-JTD schema for the encrypted part of controller ERROR block `ctrlErrorJSON`:
-
-```json
-{
-  "properties": {
-    "message": {"type": "string"}
-  },
-  "additionalProperties": true
-}
-```
-
-Once controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections.
-
-
-### Сontroller/host session operation
-
-The protocol for communication during the session is out of scope of this protocol.
-
-SimpleX Chat will use HTTP2 encoding, where host device acts as a server and controller acts as a client (these roles are reversed compared with TLS connection).
-
-Payloads in the protocol must be encrypted using NaCL cryptobox using the hybrid shared secret agreed during session establishment.
-
-Commands of the controller must be signed after the encryption using the controller's session and long term Ed25519 keys.
-
-tlsunique channel binding from TLS session MUST be included in commands (included in the signed body).
-
-The syntax for encrypted command and response body encoding:
-
-```
-commandBody = encBody sessSignature idSignature (attachment / noAttachment)
-responseBody = encBody attachment; should match counter in the 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
-encLength32 = 4*4 OCTET ; uint32, includes authTag
-```
-
-If the command or response includes attachment, it's hash must be included in command/response and validated.
-
-## Key agreement for announcement packet and for session
-
-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 containt 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 cyphertext 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 secred 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.
-
-For the session, the shared secred is computed again using the KEM shared secret encapsulated by the controller using the new KEM key from the HOST hello block and DH shared secret computed using the host DH key from HELLO block and the new controller DH key from the announcement.
-
-To describe it in pseudocode:
-
-```
-// session 1
-hostHelloSecret(1) = dhSecret(1)
-sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
-dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
-kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
-// kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
-kemSecret(1) = dec(kemCiphertext(1), kemDecKey(1))
-
-// multicast announcement for session n
-announcementSecret(n) = sha256(dhSecret(n'))
-dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
-
-// session n
-hostHelloSecret(n) = dhSecret(n)
-sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
-dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
-// controllerDhKey(n) is either from invitation or from multicast announcement
-kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
-kemSecret(n) = dec(kemCiphertext(n), kemDecKey(n))
-```
-
-If controller fails to store the new host DH key after receiving HELLO block, the encryption will become out of sync and the host won't be able to decrypt the next announcement. To mitigate it, the host should keep the last session DH key and also previous session DH key to try to decrypt the next announcement computing shared secret using both keys (first the new one, and in case it fails - the previous).
-
-To decrypt multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
-
-## Other options
-
-The proposed design has these pros/cons:
-
-Pros:
- mobile host that has sensitive data doesn't act as TLS server.
- multicast is optional - all sessions can happen via QR code only.
-
-Cons:
- reversing of client/server roles between TLS and HTTP2.
- in the first session mobile host TLS client credentials are verified after TLS connection is accepted.
- cannot be used with host that runs in VM.
-
-The alternative design will use mobile host device as TLS server. The session negotiation process:
-
- desktop shares its initial credentials via QR code, only for the first session
- mobile sends encrypted multicast with session address, TLS CA fingerprint, DH key in clear text
- desktop connects to mobile
- session tlsunique presented to users on both devices - either user would have to confirm session on both devices or the mobile would have to send an additional "ready" block.
-
-Pros:
- no reversing server role between TLS and HTTP2
- TLS credentials are exchanged before TLS, so invalid credentials can be rejected during the handshake of the first session.
- if some other way to pass data from host to controller is added, then it can be used with host running in VM.
-
-Cons:
- multicast is mandatory, as there is no efficient way to communicate from mobile to desktop.
- still needs hello or confirmation on both devices
- mobile is now acting as TLS server creating additional attack vector
-
-In both proposed and alternative design mobile host has chat data, acts as HTTP2 server, commands are signed with desktop key presented out-of–band, and both commands and responses are encrypted inside TLS session.
-
-Other considered options:
- SSH - more work integrating it.
- use SMP connection to negotiate TLS session - it seems wrong to require Internet connection to negotiate a local network connection between desktop and mobile.
- other multicast service discovery protocols - quite insecure.
-
-## Threat model
-
-#### A passive network adversary able to monitor the site-local traffic:
-
-*can:*
- observe session times, duration and volume of the transmitted data between host and controller.
-
-*cannot:*
- observe the content of the transmitted data.
- substitute the transmitted commands or responses.
- replay transmitted commands or events from the hosts.
-
-#### An active network adversary able to intercept and substitute the site-local traffic:
-
-*can:*
- prevent host and controller devices from establishing the session
-
-*cannot:*
- same as passive adversary, provided that user visually verified session code out-of-band.
-
-#### An active adversary with the access to the network:
-
-*can:*
- spam controller device.
-
-*cannot:*
- compromise host or controller devices.
-
-#### An active adversary with the access to the network who also observed OOB announcement:
-
-*can:*
- connect to controller instead of the host.
- present incorrect data to the controller.
-
-*cannot:*
- connect to the host or make host connect to itself.
-
-#### Compromised controller device:
-
-*can:*
- observe the content of the transmitted data.
- access any data of the controlled host application, within the capabilities of the provided API.
-
-*cannot:*
- access other data on the host device.
- compromise host device.
-
-#### Compromised host device:
-
-*can:*
- present incorrect data to the controller.
- incorrectly interpret controller commands.
-
-*cannot:*
- access controller data, even related to this host device.
@@ -1,11 +1,11 @@
 cabal-version: 1.12

-- This file has been generated from package.yaml by hpack version 0.35.0.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack

 name:           simplexmq
-version:        5.5.0.4
+version:        5.4.0.3
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                <./docs/Simplex-Messaging-Client.html client> and
@@ -26,19 +26,26 @@ build-type:     Simple
 extra-source-files:
    README.md
    CHANGELOG.md
-    cbits/sha512.h
+    cbits/cryptonite_align.h
+    cbits/cryptonite_bitfn.h
+    cbits/cryptonite_chacha.h
+    cbits/cryptonite_hash_prefix.h
+    cbits/cryptonite_sha512.h
    cbits/sntrup761.h
+    cbits/sntrup_random.h
+    cbits/sntrup_sha512.h
+    cbits/cryptonite_chacha.c
+    cbits/cryptonite_hash_prefix.c
+    cbits/cryptonite_sha512.c
+    cbits/sntrup761.c
+    cbits/sntrup_random.c
+    cbits/sntrup_sha512.c

 flag swift
  description: Enable swift JSON format
  manual: True
  default: False

-flag use_crypton
-  description: Use crypton etc. in cryptostore
-  manual: True
-  default: True
-
 library
  exposed-modules:
      Simplex.FileTransfer.Agent
@@ -51,7 +58,6 @@ library
      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
@@ -99,18 +105,14 @@ library
      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.TAsyncs
      Simplex.Messaging.Agent.TRcvQueues
-      Simplex.Messaging.Builder
      Simplex.Messaging.Client
      Simplex.Messaging.Client.Agent
      Simplex.Messaging.Crypto
      Simplex.Messaging.Crypto.File
      Simplex.Messaging.Crypto.Lazy
      Simplex.Messaging.Crypto.Ratchet
-      Simplex.Messaging.Crypto.SNTRUP761
      Simplex.Messaging.Crypto.SNTRUP761.Bindings
      Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
      Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
@@ -157,11 +159,6 @@ library
      Simplex.Messaging.Transport.WebSockets
      Simplex.Messaging.Util
      Simplex.Messaging.Version
-      Simplex.RemoteControl.Client
-      Simplex.RemoteControl.Discovery
-      Simplex.RemoteControl.Discovery.Multicast
-      Simplex.RemoteControl.Invitation
-      Simplex.RemoteControl.Types
  other-modules:
      Paths_simplexmq
  hs-source-dirs:
@@ -170,10 +167,11 @@ library
  include-dirs:
      cbits
  c-sources:
-      cbits/sha512.c
+      cbits/cryptonite_chacha.c
+      cbits/cryptonite_sha512.c
+      cbits/sntrup_random.c
+      cbits/sntrup_sha512.c
      cbits/sntrup761.c
-  extra-libraries:
-      crypto
  build-depends:
      aeson ==2.2.*
    , ansi-terminal >=0.10 && <0.12
@@ -183,31 +181,27 @@ library
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -215,28 +209,24 @@ library
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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 ntf-server
  main-is: Main.hs
@@ -254,31 +244,27 @@ executable ntf-server
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -287,28 +273,24 @@ executable ntf-server
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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-agent
  main-is: Main.hs
@@ -326,31 +308,27 @@ executable smp-agent
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -359,28 +337,24 @@ executable smp-agent
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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
  main-is: Main.hs
@@ -398,31 +372,27 @@ executable smp-server
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -431,28 +401,24 @@ executable smp-server
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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
  main-is: Main.hs
@@ -470,31 +436,27 @@ executable xftp
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -503,28 +465,24 @@ executable xftp
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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
  main-is: Main.hs
@@ -542,31 +500,27 @@ executable xftp-server
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , direct-sqlcipher ==2.3.*
    , directory ==1.3.*
    , filepath ==1.4.*
    , hourglass ==0.2.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -575,28 +529,24 @@ executable xftp-server
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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
  type: exitcode-stdio-1.0
@@ -622,7 +572,6 @@ test-suite simplexmq-test
      FileDescriptionTests
      NtfClient
      NtfServerTests
-      RemoteControl
      ServerTests
      SMPAgentClient
      SMPClient
@@ -645,15 +594,13 @@ test-suite simplexmq-test
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.11.*
    , 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.*
+    , cryptonite ==0.30.*
+    , cryptostore ==0.2.*
    , data-default ==0.7.*
    , deepseq ==1.4.*
    , direct-sqlcipher ==2.3.*
@@ -664,17 +611,15 @@ test-suite simplexmq-test
    , hspec ==2.11.*
    , hspec-core ==2.11.*
    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
+    , http2 >=4.1.4 && <4.2
    , ini ==0.4.1
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , main-tester ==0.2.*
    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
+    , mtl ==2.3.*
    , 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
@@ -684,26 +629,22 @@ test-suite simplexmq-test
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
+    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , time ==1.12.*
+    , text ==2.0.*
+    , time ==1.9.*
+    , time-compat ==1.9.*
    , time-manager ==0.0.*
    , timeit ==2.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.6.0 && <1.7
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
+    , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
    , yaml ==0.11.*
  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
@@ -4,9 +4,11 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

@@ -30,7 +32,6 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.Composition ((.:))
 import Data.Int (Int64)
 import Data.List (foldl', sortOn)
 import qualified Data.List.NonEmpty as L
@@ -58,6 +59,8 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol (EntityId, XFTPServer)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
@@ -67,38 +70,41 @@ startXFTPWorkers :: AgentMonad m => AgentClient -> Maybe FilePath -> m ()
 startXFTPWorkers c workDir = do
  wd <- asks $ xftpWorkDir . xftpAgent
  atomically $ writeTVar wd workDir
-  cfg <- asks config
-  startRcvFiles cfg
-  startSndFiles cfg
-  startDelFiles cfg
+  startRcvFiles
+  startSndFiles
+  startDelFiles
  where
-    startRcvFiles AgentConfig {rcvFilesTTL} = do
+    startRcvFiles = do
+      rcvFilesTTL <- asks $ rcvFilesTTL . config
      pendingRcvServers <- withStore' c (`getPendingRcvFilesServers` rcvFilesTTL)
-      forM_ pendingRcvServers $ \s -> resumeXFTPRcvWork c (Just s)
+      forM_ pendingRcvServers $ \s -> addXFTPRcvWorker c (Just s)
      -- start local worker for files pending decryption,
      -- no need to make an extra query for the check
      -- as the worker will check the store anyway
-      resumeXFTPRcvWork c Nothing
-    startSndFiles AgentConfig {sndFilesTTL} = do
+      addXFTPRcvWorker c Nothing
+    startSndFiles = do
+      sndFilesTTL <- asks $ sndFilesTTL . config
      -- start worker for files pending encryption/creation
-      resumeXFTPSndWork c Nothing
+      addXFTPSndWorker c Nothing
      pendingSndServers <- withStore' c (`getPendingSndFilesServers` sndFilesTTL)
-      forM_ pendingSndServers $ \s -> resumeXFTPSndWork c (Just s)
-    startDelFiles AgentConfig {rcvFilesTTL} = do
+      forM_ pendingSndServers $ \s -> addXFTPSndWorker c (Just s)
+    startDelFiles = do
+      rcvFilesTTL <- asks $ rcvFilesTTL . config
      pendingDelServers <- withStore' c (`getPendingDelFilesServers` rcvFilesTTL)
-      forM_ pendingDelServers $ resumeXFTPDelWork c
+      forM_ pendingDelServers $ addXFTPDelWorker c

 closeXFTPAgent :: MonadUnliftIO m => XFTPAgent -> m ()
-closeXFTPAgent a = do
-  stopWorkers $ xftpRcvWorkers a
-  stopWorkers $ xftpSndWorkers a
-  stopWorkers $ xftpDelWorkers a
+closeXFTPAgent XFTPAgent {xftpRcvWorkers, xftpSndWorkers} = do
+  stopWorkers xftpRcvWorkers
+  stopWorkers xftpSndWorkers
  where
-    stopWorkers workers = atomically (swapTVar workers M.empty) >>= mapM_ (liftIO . cancelWorker)
+    stopWorkers wsSel = do
+      ws <- atomically $ stateTVar wsSel (,M.empty)
+      mapM_ (uninterruptibleCancel . snd) ws

 xftpReceiveFile' :: AgentMonad m => AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> m RcvFileId
 xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks}) cfArgs = do
-  g <- asks random
+  g <- asks idsDrg
  prefixPath <- getPrefixPath "rcv.xftp"
  createDirectory prefixPath
  let relPrefixPath = takeFileName prefixPath
@@ -113,7 +119,7 @@ xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks}) cfA
  where
    downloadChunk :: AgentMonad m => FileChunk -> m ()
    downloadChunk FileChunk {replicas = (FileChunkReplica {server} : _)} = do
-      void $ getXFTPRcvWorker True c (Just server)
+      addXFTPRcvWorker c (Just server)
    downloadChunk _ = throwError $ INTERNAL "no replicas"

 getPrefixPath :: AgentMonad m => String -> m FilePath
@@ -129,35 +135,55 @@ toFSFilePath f = (</> f) <$> getXFTPWorkPath
 createEmptyFile :: AgentMonad m => FilePath -> m ()
 createEmptyFile fPath = liftIO $ B.writeFile fPath ""

-resumeXFTPRcvWork :: AgentMonad' m => AgentClient -> Maybe XFTPServer -> m ()
-resumeXFTPRcvWork = void .: getXFTPRcvWorker False
+addXFTPRcvWorker :: AgentMonad m => AgentClient -> Maybe XFTPServer -> m ()
+addXFTPRcvWorker c = addWorker c xftpRcvWorkers runXFTPRcvWorker runXFTPRcvLocalWorker

-getXFTPRcvWorker :: AgentMonad' m => Bool -> AgentClient -> Maybe XFTPServer -> m Worker
-getXFTPRcvWorker hasWork c server = do
-  ws <- asks $ xftpRcvWorkers . xftpAgent
-  getAgentWorker "xftp_rcv" hasWork c server ws $
-    maybe (runXFTPRcvLocalWorker c) (runXFTPRcvWorker c) server
+addWorker ::
+  AgentMonad m =>
+  AgentClient ->
+  (XFTPAgent -> TMap (Maybe XFTPServer) (TMVar (), Async ())) ->
+  (AgentClient -> XFTPServer -> TMVar () -> m ()) ->
+  (AgentClient -> TMVar () -> m ()) ->
+  Maybe XFTPServer ->
+  m ()
+addWorker c wsSel runWorker runWorkerNoSrv srv_ = do
+  ws <- asks $ wsSel . xftpAgent
+  atomically (TM.lookup srv_ ws) >>= \case
+    Nothing -> do
+      doWork <- newTMVarIO ()
+      let runWorker' = case srv_ of
+            Just srv -> runWorker c srv doWork
+            Nothing -> runWorkerNoSrv c doWork
+      worker <- async $ runWorker' `agentFinally` atomically (TM.delete srv_ ws)
+      atomically $ TM.insert srv_ (doWork, worker) ws
+    Just (doWork, _) ->
+      void . atomically $ tryPutTMVar doWork ()

-runXFTPRcvWorker :: forall m. AgentMonad m => AgentClient -> XFTPServer -> Worker -> m ()
-runXFTPRcvWorker c srv Worker {doWork} = do
-  cfg <- asks config
+runXFTPRcvWorker :: forall m. AgentMonad m => AgentClient -> XFTPServer -> TMVar () -> m ()
+runXFTPRcvWorker c srv doWork = do
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    atomically $ assertAgentForeground c
-    runXFTPOperation cfg
+    runXFTPOperation
  where
-    runXFTPOperation :: AgentConfig -> m ()
-    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} =
-      withWork c doWork (\db -> getNextRcvChunkToDownload db srv rcvFilesTTL) $ \case
-        RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []} -> rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) "chunk has no replicas"
-        fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _} -> do
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
+    runXFTPOperation :: m ()
+    runXFTPOperation = do
+      rcvFilesTTL <- asks (rcvFilesTTL . config)
+      nextChunk <- withStore' c $ \db -> getNextRcvChunkToDownload db srv rcvFilesTTL
+      case nextChunk of
+        Nothing -> noWorkToDo
+        Just RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []} -> rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) "chunk has no replicas"
+        Just fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _} -> do
+          ri <- asks $ reconnectInterval . config
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
-          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop ->
+          withRetryInterval ri' $ \delay' loop ->
            downloadFileChunk fc replica
              `catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
              flip catchAgentError (\_ -> pure ()) $ do
+                notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                when notifyOnRetry $ notify c rcvFileEntityId $ RFERR e
                closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
@@ -180,8 +206,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
        liftIO . when complete $ updateRcvFileStatus db rcvFileId RFSReceived
        pure (complete, RFPROG rcvd total)
      notify c rcvFileEntityId progress
-      when complete . void $
-        getXFTPRcvWorker True c Nothing
+      when complete $ addXFTPRcvWorker c Nothing
      where
        receivedSize :: [RcvFileChunk] -> Int64
        receivedSize = foldl' (\sz ch -> sz + receivedChunkSize ch) 0
@@ -190,12 +215,6 @@ runXFTPRcvWorker c srv Worker {doWork} = do
          | otherwise = 0
        chunkReceived RcvFileChunk {replicas} = any received replicas

-- The first call of action has n == 0, maxN is max number of retries
-withRetryIntervalLimit :: forall m. MonadIO m => Int -> RetryInterval -> (Int64 -> m () -> m ()) -> m ()
-withRetryIntervalLimit maxN ri action =
-  withRetryIntervalCount ri $ \n delay loop ->
-    when (n < maxN) $ action delay loop
-
 retryOnError :: AgentMonad m => Text -> m a -> m a -> AgentErrorType -> m a
 retryOnError name loop done e = do
  logError $ name <> " error: " <> tshow e
@@ -209,19 +228,22 @@ rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath internalErrStr = do
  withStore' c $ \db -> updateRcvFileError db rcvFileId internalErrStr
  notify c rcvFileEntityId $ RFERR $ INTERNAL internalErrStr

-runXFTPRcvLocalWorker :: forall m. AgentMonad m => AgentClient -> Worker -> m ()
-runXFTPRcvLocalWorker c Worker {doWork} = do
-  cfg <- asks config
+runXFTPRcvLocalWorker :: forall m. AgentMonad m => AgentClient -> TMVar () -> m ()
+runXFTPRcvLocalWorker c doWork = do
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    atomically $ assertAgentForeground c
-    runXFTPOperation cfg
+    runXFTPOperation
  where
-    runXFTPOperation :: AgentConfig -> m ()
-    runXFTPOperation AgentConfig {rcvFilesTTL} =
-      withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
-        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
+    runXFTPOperation :: m ()
+    runXFTPOperation = do
+      rcvFilesTTL <- asks (rcvFilesTTL . config)
+      nextFile <- withStore' c (`getNextRcvFileToDecrypt` rcvFilesTTL)
+      case nextFile of
+        Nothing -> noWorkToDo
+        Just f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
          decryptFile f `catchAgentError` (rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath . show)
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
    decryptFile :: RcvFile -> m ()
    decryptFile RcvFile {rcvFileId, rcvFileEntityId, key, nonce, tmpPath, saveFile, status, chunks} = do
      let CryptoFile savePath cfArgs = saveFile
@@ -261,43 +283,40 @@ notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, APC (sAEntit

 xftpSendFile' :: AgentMonad m => AgentClient -> UserId -> CryptoFile -> Int -> m SndFileId
 xftpSendFile' c userId file numRecipients = do
-  g <- asks random
+  g <- asks idsDrg
  prefixPath <- getPrefixPath "snd.xftp"
  createDirectory prefixPath
  let relPrefixPath = takeFileName prefixPath
-  key <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  key <- liftIO C.randomSbKey
+  nonce <- liftIO C.randomCbNonce
  -- saving absolute filePath will not allow to restore file encryption after app update, but it's a short window
  fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce
-  void $ getXFTPSndWorker True c Nothing
+  addXFTPSndWorker c Nothing
  pure fId

-resumeXFTPSndWork :: AgentMonad' m => AgentClient -> Maybe XFTPServer -> m ()
-resumeXFTPSndWork = void .: getXFTPSndWorker False
+addXFTPSndWorker :: AgentMonad m => AgentClient -> Maybe XFTPServer -> m ()
+addXFTPSndWorker c = addWorker c xftpSndWorkers runXFTPSndWorker runXFTPSndPrepareWorker

-getXFTPSndWorker :: AgentMonad' m => Bool -> AgentClient -> Maybe XFTPServer -> m Worker
-getXFTPSndWorker hasWork c server = do
-  ws <- asks $ xftpSndWorkers . xftpAgent
-  getAgentWorker "xftp_snd" hasWork c server ws $
-    maybe (runXFTPSndPrepareWorker c) (runXFTPSndWorker c) server
-
-runXFTPSndPrepareWorker :: forall m. AgentMonad m => AgentClient -> Worker -> m ()
-runXFTPSndPrepareWorker c Worker {doWork} = do
-  cfg <- asks config
+runXFTPSndPrepareWorker :: forall m. AgentMonad m => AgentClient -> TMVar () -> m ()
+runXFTPSndPrepareWorker c doWork = do
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    atomically $ assertAgentForeground c
-    runXFTPOperation cfg
+    runXFTPOperation
  where
-    runXFTPOperation :: AgentConfig -> m ()
-    runXFTPOperation cfg@AgentConfig {sndFilesTTL} =
-      withWork c doWork (`getNextSndFileToPrepare` sndFilesTTL) $
-        \f@SndFile {sndFileId, sndFileEntityId, prefixPath} ->
-          prepareFile cfg f `catchAgentError` (sndWorkerInternalError c sndFileId sndFileEntityId prefixPath . show)
-    prepareFile :: AgentConfig -> SndFile -> m ()
-    prepareFile _ SndFile {prefixPath = Nothing} =
+    runXFTPOperation :: m ()
+    runXFTPOperation = do
+      sndFilesTTL <- asks (sndFilesTTL . config)
+      nextFile <- withStore' c (`getNextSndFileToPrepare` sndFilesTTL)
+      case nextFile of
+        Nothing -> noWorkToDo
+        Just f@SndFile {sndFileId, sndFileEntityId, prefixPath} ->
+          prepareFile f `catchAgentError` (sndWorkerInternalError c sndFileId sndFileEntityId prefixPath . show)
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
+    prepareFile :: SndFile -> m ()
+    prepareFile SndFile {prefixPath = Nothing} =
      throwError $ INTERNAL "no prefix path"
-    prepareFile cfg sndFile@SndFile {sndFileId, userId, prefixPath = Just ppath, status} = do
+    prepareFile sndFile@SndFile {sndFileId, userId, prefixPath = Just ppath, status} = do
      SndFile {numRecipients, chunks} <-
        if status /= SFSEncrypted -- status is SFSNew or SFSEncrypting
          then do
@@ -310,13 +329,12 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
              updateSndFileEncrypted db sndFileId digest chunkSpecsDigests
              getSndFile db sndFileId
          else pure sndFile
+      maxRecipients <- asks (xftpMaxRecipientsPerRequest . config)
      let numRecipients' = min numRecipients maxRecipients
      -- concurrently?
-      -- separate worker to create chunks? record retries and delay on snd_file_chunks?
      forM_ (filter (not . chunkCreated) chunks) $ createChunk numRecipients'
      withStore' c $ \db -> updateSndFileStatus db sndFileId SFSUploading
      where
-        AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients, messageRetryInterval = ri} = cfg
        encryptFileForUpload :: SndFile -> FilePath -> m (FileDigest, [(XFTPChunkSpec, FileDigest)])
        encryptFileForUpload SndFile {key, nonce, srcFile} fsEncPath = do
          let CryptoFile {filePath} = srcFile
@@ -341,9 +359,10 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
          atomically $ assertAgentForeground c
          (replica, ProtoServerWithAuth srv _) <- tryCreate
          withStore' c $ \db -> createSndFileReplica db ch replica
-          void $ getXFTPSndWorker True c (Just srv)
+          addXFTPSndWorker c $ Just srv
          where
            tryCreate = do
+              ri <- asks $ messageRetryInterval . config
              usedSrvs <- newTVarIO ([] :: [XFTPServer])
              withRetryInterval (riFast ri) $ \_ loop ->
                createWithNextSrv usedSrvs
@@ -363,34 +382,39 @@ sndWorkerInternalError c sndFileId sndFileEntityId prefixPath internalErrStr = d
  withStore' c $ \db -> updateSndFileError db sndFileId internalErrStr
  notify c sndFileEntityId $ SFERR $ INTERNAL internalErrStr

-runXFTPSndWorker :: forall m. AgentMonad m => AgentClient -> XFTPServer -> Worker -> m ()
-runXFTPSndWorker c srv Worker {doWork} = do
-  cfg <- asks config
+runXFTPSndWorker :: forall m. AgentMonad m => AgentClient -> XFTPServer -> TMVar () -> m ()
+runXFTPSndWorker c srv doWork = do
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    atomically $ assertAgentForeground c
-    runXFTPOperation cfg
+    runXFTPOperation
  where
-    runXFTPOperation :: AgentConfig -> m ()
-    runXFTPOperation cfg@AgentConfig {sndFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} = do
-      withWork c doWork (\db -> getNextSndChunkToUpload db srv sndFilesTTL) $ \case
-        SndFileChunk {sndFileId, sndFileEntityId, filePrefixPath, replicas = []} -> sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) "chunk has no replicas"
-        fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
+    runXFTPOperation :: m ()
+    runXFTPOperation = do
+      sndFilesTTL <- asks (sndFilesTTL . config)
+      nextChunk <- withStore' c $ \db -> getNextSndChunkToUpload db srv sndFilesTTL
+      case nextChunk of
+        Nothing -> noWorkToDo
+        Just SndFileChunk {sndFileId, sndFileEntityId, filePrefixPath, replicas = []} -> sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) "chunk has no replicas"
+        Just fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
+          ri <- asks $ reconnectInterval . config
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
-          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop ->
-            uploadFileChunk cfg fc replica
+          withRetryInterval ri' $ \delay' loop ->
+            uploadFileChunk fc replica
              `catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
              flip catchAgentError (\_ -> pure ()) $ do
+                notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                when notifyOnRetry $ notify c sndFileEntityId $ SFERR e
                closeXFTPServerClient c userId server digest
                withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
              atomically $ assertAgentForeground c
              loop
            retryDone e = sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) (show e)
-    uploadFileChunk :: AgentConfig -> SndFileChunk -> SndFileChunkReplica -> m ()
-    uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
+    uploadFileChunk :: SndFileChunk -> SndFileChunkReplica -> m ()
+    uploadFileChunk sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
      replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
      fsFilePath <- toFSFilePath filePath
      unlessM (doesFileExist fsFilePath) $ throwError $ INTERNAL "encrypted file doesn't exist on upload"
@@ -416,6 +440,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
          | length rcvIdsKeys > numRecipients = throwError $ INTERNAL "too many recipients"
          | length rcvIdsKeys == numRecipients = pure cr
          | otherwise = do
+              maxRecipients <- asks $ xftpMaxRecipientsPerRequest . config
              let numRecipients' = min (numRecipients - length rcvIdsKeys) maxRecipients
              rcvIdsKeys' <- agentXFTPAddRecipients c userId chunkDigest cr numRecipients'
              cr' <- withStore' c $ \db -> addSndChunkReplicaRecipients db cr $ L.toList rcvIdsKeys'
@@ -460,7 +485,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
            rcvChunks :: [[FileChunk]]
            rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
            sortChunks :: [FileChunk] -> [FileChunk]
-            sortChunks = map reverseReplicas . sortOn (\FileChunk {chunkNo} -> chunkNo)
+            sortChunks = map reverseReplicas . sortOn (\fc -> fc.chunkNo)
            reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
            addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
            addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
@@ -503,47 +528,55 @@ deleteSndFileRemote c userId sndFileEntityId (ValidFileDescription FileDescripti
    deleteFileChunk :: FileChunk -> m ()
    deleteFileChunk FileChunk {digest, replicas = replica@FileChunkReplica {server} : _} = do
      withStore' c $ \db -> createDeletedSndChunkReplica db userId replica digest
-      void $ getXFTPDelWorker True c server
+      addXFTPDelWorker c server
    deleteFileChunk _ = pure ()

-resumeXFTPDelWork :: AgentMonad' m => AgentClient -> XFTPServer -> m ()
-resumeXFTPDelWork = void .: getXFTPDelWorker False
-
-getXFTPDelWorker :: AgentMonad' m => Bool -> AgentClient -> XFTPServer -> m Worker
-getXFTPDelWorker hasWork c server = do
+addXFTPDelWorker :: AgentMonad m => AgentClient -> XFTPServer -> m ()
+addXFTPDelWorker c srv = do
  ws <- asks $ xftpDelWorkers . xftpAgent
-  getAgentWorker "xftp_del" hasWork c server ws $ runXFTPDelWorker c server
+  atomically (TM.lookup srv ws) >>= \case
+    Nothing -> do
+      doWork <- newTMVarIO ()
+      worker <- async $ runXFTPDelWorker c srv doWork `agentFinally` atomically (TM.delete srv ws)
+      atomically $ TM.insert srv (doWork, worker) ws
+    Just (doWork, _) ->
+      void . atomically $ tryPutTMVar doWork ()

-runXFTPDelWorker :: forall m. AgentMonad m => AgentClient -> XFTPServer -> Worker -> m ()
-runXFTPDelWorker c srv Worker {doWork} = do
-  cfg <- asks config
+runXFTPDelWorker :: forall m. AgentMonad m => AgentClient -> XFTPServer -> TMVar () -> m ()
+runXFTPDelWorker c srv doWork = do
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    atomically $ assertAgentForeground c
-    runXFTPOperation cfg
+    runXFTPOperation
  where
-    runXFTPOperation :: AgentConfig -> m ()
-    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} = do
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
+    runXFTPOperation :: m ()
+    runXFTPOperation = do
      -- no point in deleting files older than rcv ttl, as they will be expired on server
-      withWork c doWork (\db -> getNextDeletedSndChunkReplica db srv rcvFilesTTL) processDeletedReplica
-      where
-        processDeletedReplica replica@DeletedSndChunkReplica {deletedSndChunkReplicaId, userId, server, chunkDigest, delay} = do
+      rcvFilesTTL <- asks (rcvFilesTTL . config)
+      nextReplica <- withStore' c $ \db -> getNextDeletedSndChunkReplica db srv rcvFilesTTL
+      case nextReplica of
+        Nothing -> noWorkToDo
+        Just replica@DeletedSndChunkReplica {deletedSndChunkReplicaId, userId, server, chunkDigest, delay} -> do
+          ri <- asks $ reconnectInterval . config
          let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
-          withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop ->
-            deleteChunkReplica
+          withRetryInterval ri' $ \delay' loop ->
+            deleteChunkReplica replica
              `catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
          where
            retryLoop loop e replicaDelay = do
              flip catchAgentError (\_ -> pure ()) $ do
+                notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                when notifyOnRetry $ notify c "" $ SFERR e
                closeXFTPServerClient c userId server chunkDigest
                withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
              atomically $ assertAgentForeground c
              loop
            retryDone = delWorkerInternalError c deletedSndChunkReplicaId
-            deleteChunkReplica = do
-              agentXFTPDeleteChunk c userId replica
-              withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
+    deleteChunkReplica :: DeletedSndChunkReplica -> m ()
+    deleteChunkReplica replica@DeletedSndChunkReplica {userId, deletedSndChunkReplicaId} = do
+      agentXFTPDeleteChunk c userId replica
+      withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId

 delWorkerInternalError :: AgentMonad m => AgentClient -> Int64 -> AgentErrorType -> m ()
 delWorkerInternalError c deletedSndChunkReplicaId e = do
@@ -3,6 +3,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -11,9 +12,8 @@ module Simplex.FileTransfer.Client where

 import Control.Monad
 import Control.Monad.Except
-import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (first)
-import qualified Data.ByteString.Builder as BB
+import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
@@ -25,7 +25,6 @@ import qualified Network.HTTP2.Client as H
 import Simplex.FileTransfer.Description (mb)
 import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Transport
-import Simplex.Messaging.Builder (Builder, builder)
 import Simplex.Messaging.Client
  ( NetworkConfig (..),
    ProtocolClientError (..),
@@ -112,7 +111,7 @@ xftpClientServer = B.unpack . strEncode . snd3 . transportSession
    snd3 (_, s, _) = s

 xftpTransportHost :: XFTPClient -> TransportHost
-xftpTransportHost XFTPClient {http2Client = HTTP2Client {client_ = HClient {host}}} = host
+xftpTransportHost c = c.http2Client.client_.host

 xftpSessionTs :: XFTPClient -> UTCTime
 xftpSessionTs = sessionTs . http2Client
@@ -133,15 +132,11 @@ xftpClientError = \case
  HCIOError e -> PCEIOError e

 sendXFTPCommand :: forall p. FilePartyI p => XFTPClient -> C.APrivateSignKey -> XFTPFileId -> FileCommand p -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-sendXFTPCommand c@XFTPClient {http2Client = HTTP2Client {sessionId}} pKey fId cmd chunkSpec_ = do
+sendXFTPCommand XFTPClient {config, http2Client = http2@HTTP2Client {sessionId}} pKey fId cmd chunkSpec_ = do
  t <-
    liftEither . first PCETransportError $
      xftpEncodeTransmission sessionId (Just pKey) ("", fId, FileCmd (sFileParty @p) cmd)
-  sendXFTPTransmission c t chunkSpec_
-
-sendXFTPTransmission :: XFTPClient -> Builder -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
-sendXFTPTransmission XFTPClient {config, http2Client = http2@HTTP2Client {sessionId}} t chunkSpec_ = do
-  let req = H.requestStreaming N.methodPost "/" [] streamBody
+  let req = H.requestStreaming N.methodPost "/" [] $ streamBody t
      reqTimeout = (\XFTPChunkSpec {chunkSize} -> chunkTimeout config chunkSize) <$> chunkSpec_
  HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- liftEitherError xftpClientError $ sendRequest http2 req reqTimeout
  when (B.length bodyHead /= xftpBlockSize) $ throwError $ PCEResponseError BLOCK
@@ -153,9 +148,9 @@ sendXFTPTransmission XFTPClient {config, http2Client = http2@HTTP2Client {sessio
      _ -> pure (r, body)
    Left e -> throwError $ PCEResponseError e
  where
-    streamBody :: (BB.Builder -> IO ()) -> IO () -> IO ()
-    streamBody send done = do
-      send $ builder t
+    streamBody :: ByteString -> (Builder -> IO ()) -> IO () -> IO ()
+    streamBody t send done = do
+      send $ byteString t
      forM_ chunkSpec_ $ \XFTPChunkSpec {filePath, chunkOffset, chunkSize} ->
        withFile filePath ReadMode $ \h -> do
          hSeek h AbsoluteSeek $ fromIntegral chunkOffset
@@ -184,9 +179,9 @@ uploadXFTPChunk :: XFTPClient -> C.APrivateSignKey -> XFTPFileId -> XFTPChunkSpe
 uploadXFTPChunk c spKey fId chunkSpec =
  sendXFTPCommand c spKey fId FPUT (Just chunkSpec) >>= okResponse

-downloadXFTPChunk :: TVar ChaChaDRG -> XFTPClient -> C.APrivateSignKey -> XFTPFileId -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
-downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {filePath, chunkSize} = do
-  (rDhKey, rpDhKey) <- atomically $ C.generateKeyPair g
+downloadXFTPChunk :: XFTPClient -> C.APrivateSignKey -> XFTPFileId -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
+downloadXFTPChunk c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {filePath, chunkSize} = do
+  (rDhKey, rpDhKey) <- liftIO C.generateKeyPair'
  sendXFTPCommand c rpKey fId (FGET rDhKey) Nothing >>= \case
    (FRFile sDhKey cbNonce, HTTP2Body {bodyHead = _bg, bodySize = _bs, bodyPart}) -> case bodyPart of
      -- TODO atm bodySize is set to 0, so chunkSize will be incorrect - validate once set
@@ -212,16 +207,6 @@ deleteXFTPChunk c spKey sId = sendXFTPCommand c spKey sId FDEL Nothing >>= okRes
 ackXFTPChunk :: XFTPClient -> C.APrivateSignKey -> RecipientId -> ExceptT XFTPClientError IO ()
 ackXFTPChunk c rpKey rId = sendXFTPCommand c rpKey rId FACK Nothing >>= okResponse

-pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
-pingXFTP c@XFTPClient {http2Client = HTTP2Client {sessionId}} = do
-  t <-
-    liftEither . first PCETransportError $
-      xftpEncodeTransmission sessionId Nothing ("", "", FileCmd SFRecipient PING)
-  (r, _) <- sendXFTPTransmission c t Nothing
-  case r of
-    FRPong -> pure ()
-    _ -> throwError $ PCEUnexpectedResponse $ bshow r
-
 okResponse :: (FileResponse, HTTP2Body) -> ExceptT XFTPClientError IO ()
 okResponse = \case
  (FROk, body) -> noFile body ()
@@ -5,6 +5,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -15,6 +16,7 @@ module Simplex.FileTransfer.Client.Main
    CLIError (..),
    xftpClientCLI,
    cliSendFile,
+    cliSendFileOpts,
    prepareChunkSizes,
    prepareChunkSpecs,
    maxFileSize,
@@ -27,7 +29,7 @@ where
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
-import Crypto.Random (ChaChaDRG)
+import Crypto.Random (getRandomBytes)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
@@ -263,11 +265,10 @@ cliSendFileOpts :: SendOptions -> Bool -> (Int64 -> Int64 -> IO ()) -> ExceptT C
 cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, retryCount, tempPath, verbose} printInfo notifyProgress = do
  let (_, fileName) = splitFileName filePath
  liftIO $ when printInfo $ printNoNewLine "Encrypting file..."
-  g <- liftIO C.newRandom
-  (encPath, fdRcv, fdSnd, chunkSpecs, encSize) <- encryptFileForUpload g fileName
+  (encPath, fdRcv, fdSnd, chunkSpecs, encSize) <- encryptFileForUpload fileName
  liftIO $ when printInfo $ printNoNewLine "Uploading file..."
  uploadedChunks <- newTVarIO []
-  sentChunks <- uploadFile g chunkSpecs uploadedChunks encSize
+  sentChunks <- uploadFile chunkSpecs uploadedChunks encSize
  whenM (doesFileExist encPath) $ removeFile encPath
  -- TODO if only small chunks, use different default size
  liftIO $ do
@@ -280,13 +281,13 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
      putStrLn "Pass file descriptions to the recipient(s):"
    forM_ fdRcvPaths putStrLn
  where
-    encryptFileForUpload :: TVar ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
-    encryptFileForUpload g fileName = do
+    encryptFileForUpload :: String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
+    encryptFileForUpload fileName = do
      fileSize <- fromInteger <$> getFileSize filePath
      when (fileSize > maxFileSize) $ throwError $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
      encPath <- getEncPath tempPath "xftp"
-      key <- atomically $ C.randomSbKey g
-      nonce <- atomically $ C.randomCbNonce g
+      key <- liftIO C.randomSbKey
+      nonce <- liftIO C.randomCbNonce
      let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
          fileSize' = fromIntegral (B.length fileHdr) + fileSize
          chunkSizes = prepareChunkSizes $ fileSize' + fileSizeLen + authTagSize
@@ -301,8 +302,8 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
          fdSnd = FileDescription {party = SFSender, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = []}
      logInfo $ "encrypted file to " <> tshow encPath
      pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
-    uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
-    uploadFile g chunks uploadedChunks encSize = do
+    uploadFile :: [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
+    uploadFile chunks uploadedChunks encSize = do
      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
      gen <- newTVarIO =<< liftIO newStdGen
      let xftpSrvs = fromMaybe defaultXFTPServers (nonEmpty xftpServers)
@@ -318,8 +319,8 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
        uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec, XFTPServerWithAuth) -> ExceptT CLIError IO (Int, SentFileChunk)
        uploadFileChunk a (chunkNo, chunkSpec@XFTPChunkSpec {chunkSize}, ProtoServerWithAuth xftpServer auth) = do
          logInfo $ "uploading chunk " <> tshow chunkNo <> " to " <> showServer xftpServer <> "..."
-          (sndKey, spKey) <- atomically $ C.generateSignatureKeyPair C.SEd25519 g
-          rKeys <- atomically $ L.fromList <$> replicateM numRecipients (C.generateSignatureKeyPair C.SEd25519 g)
+          (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519
+          rKeys <- liftIO $ L.fromList <$> replicateM numRecipients (C.generateSignatureKeyPair C.SEd25519)
          digest <- liftIO $ getChunkDigest chunkSpec
          let ch = FileInfo {sndKey, size = fromIntegral chunkSize, digest}
          c <- withRetry retryCount $ getXFTPServerClient a xftpServer
@@ -360,7 +361,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
        rcvChunks :: [[FileChunk]]
        rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
        sortChunks :: [FileChunk] -> [FileChunk]
-        sortChunks = map reverseReplicas . sortOn (\FileChunk {chunkNo} -> chunkNo)
+        sortChunks = map reverseReplicas . sortOn (\c -> c.chunkNo)
        reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
        addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
        addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
@@ -419,12 +420,9 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
      liftIO $ printNoNewLine "Downloading file..."
      downloadedChunks <- newTVarIO []
-      let srv FileChunk {replicas} = case replicas of
-            [] -> error "empty FileChunk.replicas"
-            FileChunkReplica {server} : _ -> server
+      let srv FileChunk {replicas} = (head replicas).server
          srvChunks = groupAllOn srv chunks
-      g <- liftIO C.newRandom
-      chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk g a encPath size downloadedChunks)
+      chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk a encPath size downloadedChunks)
      encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
      when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch"
      encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
@@ -436,13 +434,13 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
      liftIO $ do
        printNoNewLine $ "File downloaded: " <> path
        removeFD yes fileDescription
-    downloadFileChunk :: TVar ChaChaDRG -> XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
-    downloadFileChunk g a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do
+    downloadFileChunk :: XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
+    downloadFileChunk a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do
      let FileChunkReplica {server, replicaId, replicaKey} = replica
      logInfo $ "downloading chunk " <> tshow chunkNo <> " from " <> showServer server <> "..."
      chunkPath <- uniqueCombine encPath $ show chunkNo
      let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
-      withReconnect a server retryCount $ \c -> downloadXFTPChunk g c replicaKey (unChunkReplicaId replicaId) chunkSpec
+      withReconnect a server retryCount $ \c -> downloadXFTPChunk c replicaKey (unChunkReplicaId replicaId) chunkSpec
      logInfo $ "downloaded chunk " <> tshow chunkNo <> " to " <> T.pack chunkPath
      downloaded <- atomically . stateTVar downloadedChunks $ \cs ->
        let cs' = fromIntegral (unFileSize chunkSize) : cs in (sum cs', cs')
@@ -450,7 +448,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
        printProgress "Downloaded" downloaded encSize
        when verbose $ putStrLn ""
      pure (chunkNo, chunkPath)
-    downloadFileChunk _ _ _ _ _ _ = throwError $ CLIError "chunk has no replicas"
+    downloadFileChunk _ _ _ _ _ = throwError $ CLIError "chunk has no replicas"
    getFilePath :: String -> ExceptT String IO FilePath
    getFilePath name =
      case filePath of
@@ -500,9 +498,10 @@ cliFileDescrInfo InfoOptions {fileDescription} = do
        printParty
        putStrLn $ "File download size: " <> strEnc size
        putStrLn "File server(s):"
-        forM_ replicas $ \srvReplicas@(FileServerReplica {server} :| _) -> do
-          let chSizes = fmap (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
-          putStrLn $ strEnc server <> ": " <> strEnc (FileSize $ sum chSizes)
+        forM_ replicas $ \srvReplicas -> do
+          let srv = (head srvReplicas).server
+              chSizes = map (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
+          putStrLn $ strEnc srv <> ": " <> strEnc (FileSize $ sum chSizes)
      where
        printParty :: IO ()
        printParty = case party of
@@ -594,8 +593,7 @@ cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = do
  putStrLn $ "File created: " <> filePath
  where
    saveRandomFile h sz = do
-      g <- C.newRandom
-      bytes <- atomically $ C.randomBytes (fromIntegral $ min mb' sz) g
+      bytes <- getRandomBytes $ fromIntegral $ min mb' sz
      B.hPut h bytes
      when (sz > mb') $ saveRandomFile h (sz - mb')
    mb' = mb 1
@@ -4,6 +4,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -44,8 +45,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List (foldl', sortOn)
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -60,7 +59,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, parseAll)
 import Simplex.Messaging.Protocol (XFTPServer)
-import Simplex.Messaging.Util (bshow, (<$?>))
+import Simplex.Messaging.Util (bshow, groupAllOn, (<$?>))

 data FileDescription (p :: FileParty) = FileDescription
  { party :: SFileParty p,
@@ -200,7 +199,7 @@ validateFileDescription fd@FileDescription {size, chunks}
  | chunksSize chunks /= unFileSize size = Left "chunks total size is different than file size"
  | otherwise = Right $ ValidFD fd
  where
-    chunkNos = map (\FileChunk {chunkNo} -> chunkNo) chunks
+    chunkNos = map (\c -> c.chunkNo) chunks
    chunksSize = fromIntegral . foldl' (\s FileChunk {chunkSize} -> s + unFileSize chunkSize) 0

 encodeFileDescription :: FileDescription p -> YAMLFileDescription
@@ -241,18 +240,18 @@ instance FromField a => FromField (FileSize a) where fromField f = FileSize <$>

 instance ToField a => ToField (FileSize a) where toField (FileSize s) = toField s

-groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
+groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [[FileServerReplica]]
 groupReplicasByServer defChunkSize =
-  L.groupAllWith (\FileServerReplica {server} -> server) . unfoldChunksToReplicas defChunkSize
+  groupAllOn (\r -> r.server) . unfoldChunksToReplicas defChunkSize

 encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
 encodeFileReplicas defChunkSize =
  map encodeServerReplicas . groupReplicasByServer defChunkSize
  where
-    encodeServerReplicas fs@(FileServerReplica {server} :| _) =
+    encodeServerReplicas fs =
      YAMLServerReplicas
-        { server,
-          chunks = map (B.unpack . encodeServerReplica) $ L.toList fs
+        { server = (head fs).server, -- groupAllOn guarantees that fs is not empty
+          chunks = map (B.unpack . encodeServerReplica) fs
        }

 encodeServerReplica :: FileServerReplica -> ByteString
@@ -306,7 +305,7 @@ foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String
 foldReplicasToChunks defChunkSize fs = do
  sd <- foldSizesDigests fs
  -- TODO validate (check that chunks match) or in separate function
-  sortOn (\FileChunk {chunkNo} -> chunkNo) . map reverseReplicas . M.elems <$> foldChunks sd fs
+  sortOn (\c -> c.chunkNo) . map reverseReplicas . M.elems <$> foldChunks sd fs
  where
    foldSizesDigests :: [FileServerReplica] -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
    foldSizesDigests = foldl' addSizeDigest $ Right (M.empty, M.empty)
@@ -24,7 +24,6 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isNothing)
 import Data.Type.Equality
 import Data.Word (Word32)
-import Simplex.Messaging.Builder (Builder)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -52,6 +51,7 @@ import Simplex.Messaging.Protocol
    tEncode,
    tEncodeBatch,
    tParse,
+    _smpP,
  )
 import Simplex.Messaging.Transport (SessionId, TransportError (..))
 import Simplex.Messaging.Util (bshow, (<$?>))
@@ -395,7 +395,7 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
  Just Refl -> Just c
  _ -> Nothing

-xftpEncodeTransmission :: ProtocolEncoding e c => SessionId -> Maybe C.APrivateSignKey -> Transmission c -> Either TransportError Builder
+xftpEncodeTransmission :: ProtocolEncoding e c => SessionId -> Maybe C.APrivateSignKey -> Transmission c -> Either TransportError ByteString
 xftpEncodeTransmission sessionId pKey (corrId, fId, msg) = do
  let t = encodeTransmission currentXFTPVersion sessionId (corrId, fId, msg)
  xftpEncodeBatch1 $ signTransmission t
@@ -404,10 +404,10 @@ xftpEncodeTransmission sessionId pKey (corrId, fId, msg) = do
    signTransmission t = ((`C.sign` t) <$> pKey, t)

 -- this function uses batch syntax but puts only one transmission in the batch
-xftpEncodeBatch1 :: (Maybe C.ASignature, ByteString) -> Either TransportError Builder
+xftpEncodeBatch1 :: (Maybe C.ASignature, ByteString) -> Either TransportError ByteString
 xftpEncodeBatch1 (sig, t) =
-  let t' = tEncodeBatch 1 . encodeLarge $ tEncode (sig, t)
-   in first (const TELargeMsg) $ C.pad' t' xftpBlockSize
+  let t' = tEncodeBatch 1 . smpEncode . Large $ tEncode (sig, t)
+   in first (const TELargeMsg) $ C.pad t' xftpBlockSize

 xftpDecodeTransmission :: ProtocolEncoding e c => SessionId -> ByteString -> Either XFTPErrorType (SignedTransmission e c)
 xftpDecodeTransmission sessionId t = do
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -15,9 +14,12 @@ module Simplex.FileTransfer.Server where
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
+import Crypto.Random (getRandomBytes)
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as B64
+import Data.ByteString.Builder (byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -31,19 +33,14 @@ 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 GHC.IO.Handle (hSetNewlineMode)
-import GHC.Stats (getRTSStats)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Server as H
-import Network.Socket
 import Simplex.FileTransfer.Protocol
-import Simplex.FileTransfer.Server.Control
 import Simplex.FileTransfer.Server.Env
 import Simplex.FileTransfer.Server.Stats
 import Simplex.FileTransfer.Server.Store
 import Simplex.FileTransfer.Server.StoreLog
 import Simplex.FileTransfer.Transport
-import Simplex.Messaging.Builder (builder)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding.String
@@ -51,18 +48,17 @@ import Simplex.Messaging.Protocol (CorrId, RcvPublicDhKey, RcvPublicVerifyKey, R
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdSignature)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Stats
-import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.Server (runTCPServer)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
 import System.FilePath ((</>))
-import System.IO (hPrint, hPutStrLn, universalNewlineMode)
-import UnliftIO
+import System.IO (BufferMode (..), hPutStrLn, hSetBuffering)
+import UnliftIO (IOMode (..), withFile)
 import UnliftIO.Concurrent (threadDelay)
 import UnliftIO.Directory (doesFileExist, removeFile, renameFile)
-import qualified UnliftIO.Exception as E
+import UnliftIO.Exception
+import UnliftIO.STM

 type M a = ReaderT XFTPEnv IO a

@@ -75,16 +71,16 @@ runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> IO ()
 runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started)

 xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
-xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration} started = do
+xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig} started = do
  restoreServerStats
-  raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
+  raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg) `finally` stopServer
  where
    runServer :: M ()
    runServer = do
      serverParams <- asks tlsServerParams
      env <- ask
      liftIO $
-        runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig inactiveClientExpiration $ \sessionId r sendResponse -> do
+        runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig $ \sessionId r sendResponse -> do
          reqBody <- getHTTP2Body r xftpBlockSize
          processRequest HTTP2Request {sessionId, request = r, reqBody, sendResponse} `runReaderT` env

@@ -108,19 +104,16 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
        forM_ sIds $ \sId -> do
          threadDelay 100000
          atomically (expiredFilePath st sId old)
-            >>= mapM_ (maybeRemove $ delete st sId)
+            >>= mapM_ (remove $ delete st sId)
      where
-        maybeRemove del = maybe del (remove del)
        remove del filePath =
          ifM
            (doesFileExist filePath)
-            ((removeFile filePath >> del) `catch` \(e :: SomeException) -> logError $ "failed to remove expired file " <> tshow filePath <> ": " <> tshow e)
+            (removeFile filePath >> del `catch` \(e :: SomeException) -> logError $ "failed to remove expired file " <> tshow filePath <> ": " <> tshow e)
            del
        delete st sId = do
          withFileLog (`logDeleteFile` sId)
          void $ atomically $ deleteFile st sId
-          FileServerStats {filesExpired} <- asks serverStats
-          atomically $ modifyTVar' filesExpired (+ 1)

    serverStatsThread_ :: XFTPServerConfig -> [M ()]
    serverStatsThread_ XFTPServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
@@ -132,7 +125,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
      initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
      liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
      liftIO $ threadDelay' $ 1_000_000 * (initialDelay + if initialDelay < 0 then 86_400 else 0)
-      FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize} <- asks serverStats
+      FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize} <- asks serverStats
      let interval = 1_000_000 * logInterval
      forever $ do
        withFile statsFilePath AppendMode $ \h -> liftIO $ do
@@ -142,13 +135,12 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
          filesCreated' <- atomically $ swapTVar filesCreated 0
          fileRecipients' <- atomically $ swapTVar fileRecipients 0
          filesUploaded' <- atomically $ swapTVar filesUploaded 0
-          filesExpired' <- atomically $ swapTVar filesExpired 0
          filesDeleted' <- atomically $ swapTVar filesDeleted 0
          files <- atomically $ periodStatCounts filesDownloaded ts
          fileDownloads' <- atomically $ swapTVar fileDownloads 0
          fileDownloadAcks' <- atomically $ swapTVar fileDownloadAcks 0
-          filesCount' <- readTVarIO filesCount
-          filesSize' <- readTVarIO filesSize
+          filesCount' <- atomically $ swapTVar filesCount 0
+          filesSize' <- atomically $ swapTVar filesSize 0
          hPutStrLn h $
            intercalate
              ","
@@ -163,52 +155,10 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
                show fileDownloads',
                show fileDownloadAcks',
                show filesCount',
-                show filesSize',
-                show filesExpired'
+                show filesSize'
              ]
        liftIO $ threadDelay' interval

-    controlPortThread_ :: XFTPServerConfig -> [M ()]
-    controlPortThread_ XFTPServerConfig {controlPort = Just port} = [runCPServer port]
-    controlPortThread_ _ = []
-
-    runCPServer :: ServiceName -> M ()
-    runCPServer port = do
-      cpStarted <- newEmptyTMVarIO
-      u <- askUnliftIO
-      liftIO $ do
-        labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u
-      where
-        runCPClient :: UnliftIO (ReaderT XFTPEnv IO) -> Socket -> IO ()
-        runCPClient u sock = do
-          labelMyThread "control port client"
-          h <- socketToHandle sock ReadWriteMode
-          hSetBuffering h LineBuffering
-          hSetNewlineMode h universalNewlineMode
-          hPutStrLn h "XFTP server control port\n'help' for supported commands"
-          cpLoop h
-          where
-            cpLoop h = do
-              s <- B.hGetLine h
-              case strDecode $ trimCR s of
-                Right CPQuit -> hClose h
-                Right cmd -> processCP h cmd >> cpLoop h
-                Left err -> hPutStrLn h ("error: " <> err) >> cpLoop h
-            processCP h = \case
-              CPStatsRTS -> E.tryAny getRTSStats >>= either (hPrint h) (hPrint h)
-              CPDelete fileId -> unliftIO u $ do
-                fs <- asks store
-                r <- runExceptT $ do
-                  let asSender = ExceptT . atomically $ getFile fs SFSender fileId
-                  let asRecipient = ExceptT . atomically $ getFile fs SFRecipient fileId
-                  (fr, _) <- asSender `catchError` const asRecipient
-                  ExceptT $ deleteServerFile_ fr
-                liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
-              CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit"
-              CPQuit -> pure ()
-              CPSkip -> pure ()
-
 data ServerFile = ServerFile
  { filePath :: FilePath,
    fileSize :: Word32,
@@ -242,7 +192,7 @@ processRequest HTTP2Request {sessionId, reqBody = body@HTTP2Body {bodyHead}, sen
              send "padding error" -- TODO respond with BLOCK error?
              done
            Right t -> do
-              send $ builder t
+              send $ byteString t
              -- timeout sending file in the same way as receiving
              forM_ serverFile_ $ \ServerFile {filePath, fileSize, sbState} -> do
                withFile filePath ReadMode $ \h -> sendEncFile h send sbState (fromIntegral fileSize)
@@ -368,10 +318,9 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
    sendServerFile FileRec {senderId, filePath, fileInfo = FileInfo {size}} rDhKey = do
      readTVarIO filePath >>= \case
        Just path -> do
-          g <- asks random
-          (sDhKey, spDhKey) <- atomically $ C.generateKeyPair g
+          (sDhKey, spDhKey) <- liftIO C.generateKeyPair'
          let dhSecret = C.dh' rDhKey spDhKey
-          cbNonce <- atomically $ C.randomCbNonce g
+          cbNonce <- liftIO C.randomCbNonce
          case LC.cbInit dhSecret cbNonce of
            Right sbState -> do
              stats <- asks serverStats
@@ -382,7 +331,21 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
        _ -> pure (FRErr NO_FILE, Nothing)

    deleteServerFile :: FileRec -> M FileResponse
-    deleteServerFile fr = either FRErr (\() -> FROk) <$> deleteServerFile_ fr
+    deleteServerFile FileRec {senderId, fileInfo, filePath} = do
+      withFileLog (`logDeleteFile` senderId)
+      r <- 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
+        atomically $ modifyTVar' (filesDeleted stats) (+ 1)
+        pure FROk
+      either (pure . FRErr) pure r
+      where
+        deletedStats stats = do
+          atomically $ modifyTVar' (filesCount stats) (subtract 1)
+          atomically $ modifyTVar' (filesSize stats) (subtract $ fromIntegral $ size fileInfo)

    logFileError :: SomeException -> IO ()
    logFileError e = logError $ "Error deleting file: " <> tshow e
@@ -396,28 +359,13 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
      atomically $ modifyTVar' (fileDownloadAcks stats) (+ 1)
      pure FROk

-deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
-deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
-  withFileLog (`logDeleteFile` senderId)
-  runExceptT $ do
-    path <- readTVarIO filePath
-    stats <- asks serverStats
-    ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
-    st <- asks store
-    void $ atomically $ deleteFile st senderId
-    atomically $ modifyTVar' (filesDeleted stats) (+ 1)
-  where
-    deletedStats stats = do
-      atomically $ modifyTVar' (filesCount stats) (subtract 1)
-      atomically $ modifyTVar' (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
-
 randomId :: (MonadUnliftIO m, MonadReader XFTPEnv m) => Int -> m ByteString
-randomId n = atomically . C.randomBytes n =<< asks random
+randomId n = do
+  gVar <- asks idsDrg
+  atomically (C.pseudoRandomBytes n gVar)

 getFileId :: M XFTPFileId
-getFileId = do
-  size <- asks (fileIdSize . config)
-  atomically . C.randomBytes size =<< asks random
+getFileId = liftIO . getRandomBytes =<< asks (fileIdSize . config)

 withFileLog :: (MonadIO m, MonadReader XFTPEnv m) => (StoreLog 'WriteMode -> IO a) -> m ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog
@@ -443,17 +391,14 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
    restoreStats f = whenM (doesFileExist f) $ do
      logInfo $ "restoring server stats from file " <> T.pack f
      liftIO (strDecode <$> B.readFile f) >>= \case
-        Right d@FileServerStatsData {_filesCount = statsFilesCount, _filesSize = statsFilesSize} -> do
+        Right d -> do
          s <- asks serverStats
-          FileStore {files, usedStorage} <- asks store
-          _filesCount <- M.size <$> readTVarIO files
-          _filesSize <- readTVarIO usedStorage
+          fs <- readTVarIO . files =<< asks store
+          let _filesCount = length $ M.keys fs
+              _filesSize = M.foldl' (\n -> (n +) . fromIntegral . size . fileInfo) 0 fs
          atomically $ setFileServerStats s d {_filesCount, _filesSize}
          renameFile f $ f <> ".bak"
          logInfo "server stats restored"
-          when (statsFilesCount /= _filesCount) $ logWarn $ "Files count differs: stats: " <> tshow statsFilesCount <> ", store: " <> tshow _filesCount
-          when (statsFilesSize /= _filesSize) $ logWarn $ "Files size differs: stats: " <> tshow statsFilesSize <> ", store: " <> tshow _filesSize
-          logInfo $ "Restored " <> tshow (_filesSize `div` 1048576) <> " MBs in " <> tshow _filesCount <> " files"
        Left e -> do
          logInfo $ "error restoring server stats: " <> T.pack e
          liftIO exitFailure
@@ -1,31 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.FileTransfer.Server.Control where
-
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
-import Simplex.Messaging.Encoding.String
-
-data ControlProtocol
-  = CPStatsRTS
-  | CPDelete ByteString
-  | CPHelp
-  | CPQuit
-  | CPSkip
-
-instance StrEncoding ControlProtocol where
-  strEncode = \case
-    CPStatsRTS -> "stats-rts"
-    CPDelete bs -> "delete " <> strEncode bs
-    CPHelp -> "help"
-    CPQuit -> "quit"
-    CPSkip -> ""
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "stats-rts" -> pure CPStatsRTS
-      "delete" -> CPDelete <$> (A.space *> strP)
-      "help" -> pure CPHelp
-      "quit" -> pure CPQuit
-      "" -> pure CPSkip
-      _ -> fail "bad ControlProtocol command"
@@ -33,7 +33,6 @@ import UnliftIO.STM

 data XFTPServerConfig = XFTPServerConfig
  { xftpPort :: ServiceName,
-    controlPort :: Maybe ServiceName,
    fileIdSize :: Int,
    storeLogFile :: Maybe FilePath,
    filesPath :: FilePath,
@@ -47,8 +46,6 @@ data XFTPServerConfig = XFTPServerConfig
    newFileBasicAuth :: Maybe BasicAuth,
    -- | time after which the files can be removed and check interval, seconds
    fileExpiration :: Maybe ExpirationConfig,
-    -- | time after which inactive clients can be disconnected and check interval, seconds
-    inactiveClientExpiration :: Maybe ExpirationConfig,
    -- CA certificate private key is not needed for initialization
    caCertificateFile :: FilePath,
    privateKeyFile :: FilePath,
@@ -61,18 +58,11 @@ data XFTPServerConfig = XFTPServerConfig
    transportConfig :: TransportServerConfig
  }

-defaultInactiveClientExpiration :: ExpirationConfig
-defaultInactiveClientExpiration =
-  ExpirationConfig
-    { ttl = 43200, -- seconds, 12 hours
-      checkInterval = 3600 -- seconds, 1 hours
-    }
-
 data XFTPEnv = XFTPEnv
  { config :: XFTPServerConfig,
    store :: FileStore,
    storeLog :: Maybe (StoreLog 'WriteMode),
-    random :: TVar ChaChaDRG,
+    idsDrg :: TVar ChaChaDRG,
    serverIdentity :: C.KeyHash,
    tlsServerParams :: T.ServerParams,
    serverStats :: FileServerStats
@@ -90,7 +80,7 @@ defaultFileExpiration =

 newXFTPServerEnv :: (MonadUnliftIO m, MonadRandom m) => XFTPServerConfig -> m XFTPEnv
 newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertificateFile, certificateFile, privateKeyFile} = do
-  random <- liftIO C.newRandom
+  idsDrg <- drgNew >>= newTVarIO
  store <- atomically newFileStore
  storeLog <- liftIO $ mapM (`readWriteFileStore` store) storeLogFile
  used <- readTVarIO (usedStorage store)
@@ -100,7 +90,7 @@ newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertifi
  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
  serverStats <- atomically . newFileServerStats =<< liftIO getCurrentTime
-  pure XFTPEnv {config, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
+  pure XFTPEnv {config, store, storeLog, idsDrg, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}

 data XFTPRequest
  = XFTPReqNew FileInfo (NonEmpty RcvPublicVerifyKey) (Maybe BasicAuth)
@@ -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)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
@@ -33,7 +33,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)

 xftpServerVersion :: String
-xftpServerVersion = "1.2.0.4"
+xftpServerVersion = "1.1.1"

 xftpServerCLI :: FilePath -> FilePath -> IO ()
 xftpServerCLI cfgPath logPath = do
@@ -100,17 +100,10 @@ xftpServerCLI cfgPath logPath = do
            <> ("host: " <> host <> "\n")
            <> ("port: " <> defaultServerPort <> "\n")
            <> "log_tls_errors: off\n\
-               \# control_port: 5226\n\
               \\n\
               \[FILES]\n"
            <> ("path: " <> filesPath <> "\n")
            <> ("storage_quota: " <> B.unpack (strEncode fileSizeQuota) <> "\n")
-            <> "\n\
-               \[INACTIVE_CLIENTS]\n\
-               \# TTL and interval to check inactive clients\n\
-               \disconnect: off\n"
-            <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-            <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
    runServer ini = do
      hSetBuffering stdout LineBuffering
      hSetBuffering stderr LineBuffering
@@ -125,16 +118,13 @@ xftpServerCLI cfgPath logPath = do
        enableStoreLog = settingIsOn "STORE_LOG" "enable" ini
        logStats = settingIsOn "STORE_LOG" "log_stats" ini
        c = combine cfgPath . ($ defaultX509Config)
-        printXFTPConfig XFTPServerConfig {allowNewFiles, newFileBasicAuth, xftpPort, storeLogFile, fileExpiration, inactiveClientExpiration} = do
+        printXFTPConfig XFTPServerConfig {allowNewFiles, newFileBasicAuth, xftpPort, storeLogFile, fileExpiration} = do
          putStrLn $ case storeLogFile of
            Just f -> "Store log: " <> f
            _ -> "Store log disabled."
          putStrLn $ case fileExpiration of
            Just ExpirationConfig {ttl} -> "expiring files after " <> showTTL ttl
            _ -> "not expiring files"
-          putStrLn $ case inactiveClientExpiration of
-            Just ExpirationConfig {ttl, checkInterval} -> "expiring clients inactive for " <> show ttl <> " seconds every " <> show checkInterval <> " seconds"
-            _ -> "not expiring inactive clients"
          putStrLn $
            "Uploading new files "
              <> if allowNewFiles
@@ -145,7 +135,6 @@ xftpServerCLI cfgPath logPath = do
        serverConfig =
          XFTPServerConfig
            { xftpPort = T.unpack $ strictIni "TRANSPORT" "port" ini,
-              controlPort = either (const Nothing) (Just . T.unpack) $ lookupValue "TRANSPORT" "control_port" ini,
              fileIdSize = 16,
              storeLogFile = enableStoreLog $> storeLogFilePath,
              filesPath = T.unpack $ strictIni "FILES" "path" ini,
@@ -158,12 +147,6 @@ xftpServerCLI cfgPath logPath = do
                  defaultFileExpiration
                    { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini
                    },
-              inactiveClientExpiration =
-                settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
-                  $> ExpirationConfig
-                    { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
-                      checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
-                    },
              caCertificateFile = c caCrtFile,
              privateKeyFile = c serverKeyFile,
              certificateFile = c serverCrtFile,
@@ -4,7 +4,6 @@

 module Simplex.FileTransfer.Server.Stats where

-import Control.Applicative ((<|>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
@@ -19,7 +18,6 @@ data FileServerStats = FileServerStats
    filesCreated :: TVar Int,
    fileRecipients :: TVar Int,
    filesUploaded :: TVar Int,
-    filesExpired :: TVar Int,
    filesDeleted :: TVar Int,
    filesDownloaded :: PeriodStats SenderId,
    fileDownloads :: TVar Int,
@@ -33,7 +31,6 @@ data FileServerStatsData = FileServerStatsData
    _filesCreated :: Int,
    _fileRecipients :: Int,
    _filesUploaded :: Int,
-    _filesExpired :: Int,
    _filesDeleted :: Int,
    _filesDownloaded :: PeriodStatsData SenderId,
    _fileDownloads :: Int,
@@ -49,14 +46,13 @@ newFileServerStats ts = do
  filesCreated <- newTVar 0
  fileRecipients <- newTVar 0
  filesUploaded <- newTVar 0
-  filesExpired <- newTVar 0
  filesDeleted <- newTVar 0
  filesDownloaded <- newPeriodStats
  fileDownloads <- newTVar 0
  fileDownloadAcks <- newTVar 0
  filesCount <- newTVar 0
  filesSize <- newTVar 0
-  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
+  pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}

 getFileServerStatsData :: FileServerStats -> STM FileServerStatsData
 getFileServerStatsData s = do
@@ -64,14 +60,13 @@ getFileServerStatsData s = do
  _filesCreated <- readTVar $ filesCreated s
  _fileRecipients <- readTVar $ fileRecipients s
  _filesUploaded <- readTVar $ filesUploaded s
-  _filesExpired <- readTVar $ filesExpired s
  _filesDeleted <- readTVar $ filesDeleted s
  _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
  _fileDownloads <- readTVar $ fileDownloads s
  _fileDownloadAcks <- readTVar $ fileDownloadAcks s
  _filesCount <- readTVar $ filesCount s
  _filesSize <- readTVar $ filesSize s
-  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
+  pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}

 setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
 setFileServerStats s d = do
@@ -79,7 +74,6 @@ setFileServerStats s d = do
  writeTVar (filesCreated s) $! _filesCreated d
  writeTVar (fileRecipients s) $! _fileRecipients d
  writeTVar (filesUploaded s) $! _filesUploaded d
-  writeTVar (filesExpired s) $! _filesExpired d
  writeTVar (filesDeleted s) $! _filesDeleted d
  setPeriodStats (filesDownloaded s) $! _filesDownloaded d
  writeTVar (fileDownloads s) $! _fileDownloads d
@@ -88,16 +82,13 @@ setFileServerStats s d = do
  writeTVar (filesSize s) $! _filesSize d

 instance StrEncoding FileServerStatsData where
-  strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
+  strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks} =
    B.unlines
      [ "fromTime=" <> strEncode _fromTime,
        "filesCreated=" <> strEncode _filesCreated,
        "fileRecipients=" <> strEncode _fileRecipients,
        "filesUploaded=" <> strEncode _filesUploaded,
-        "filesExpired=" <> strEncode _filesExpired,
        "filesDeleted=" <> strEncode _filesDeleted,
-        "filesCount=" <> strEncode _filesCount,
-        "filesSize=" <> strEncode _filesSize,
        "filesDownloaded:",
        strEncode _filesDownloaded,
        "fileDownloads=" <> strEncode _fileDownloads,
@@ -108,11 +99,8 @@ instance StrEncoding FileServerStatsData where
    _filesCreated <- "filesCreated=" *> strP <* A.endOfLine
    _fileRecipients <- "fileRecipients=" *> strP <* A.endOfLine
    _filesUploaded <- "filesUploaded=" *> strP <* A.endOfLine
-    _filesExpired <- "filesExpired=" *> strP <* A.endOfLine <|> pure 0
    _filesDeleted <- "filesDeleted=" *> strP <* A.endOfLine
-    _filesCount <- "filesCount=" *> strP <* A.endOfLine <|> pure 0
-    _filesSize <- "filesSize=" *> strP <* A.endOfLine <|> pure 0
    _filesDownloaded <- "filesDownloaded:" *> A.endOfLine *> strP <* A.endOfLine
    _fileDownloads <- "fileDownloads=" *> strP <* A.endOfLine
    _fileDownloadAcks <- "fileDownloadAcks=" *> strP <* A.endOfLine
-    pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
+    pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount = 0, _filesSize = 0}
@@ -121,12 +121,12 @@ getFile st party fId = case party of
      Just (sId, rKey) -> withFile st sId $ pure . Right . (,rKey)
      _ -> pure $ Left AUTH

-expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe (Maybe FilePath))
+expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe FilePath)
 expiredFilePath FileStore {files} sId old =
  TM.lookup sId files
    $>>= \FileRec {filePath, createdAt} ->
      if systemSeconds createdAt < old
-        then Just <$> readTVar filePath
+        then readTVar filePath
        else pure Nothing

 ackFile :: FileStore -> RecipientId -> STM (Either XFTPErrorType ())
@@ -6,11 +6,9 @@
 module Simplex.FileTransfer.Transport
  ( supportedFileServerVRange,
    XFTPRcvChunkSpec (..),
-    ReceiveFileError (..),
    receiveFile,
    sendEncFile,
    receiveEncFile,
-    receiveSbFile,
  )
 where

@@ -18,7 +16,6 @@ import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Data.Bifunctor (first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
@@ -62,34 +59,25 @@ receiveFile getBody = receiveFile_ receive
 receiveEncFile :: (Int -> IO ByteString) -> LC.SbState -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
 receiveEncFile getBody = receiveFile_ . receive
  where
-    receive sbState h sz = first err <$> receiveSbFile getBody h sbState sz
-    err RFESize = SIZE
-    err RFECrypto = CRYPTO
-
-data ReceiveFileError = RFESize | RFECrypto
-
-receiveSbFile :: (Int -> IO ByteString) -> Handle -> LC.SbState -> Word32 -> IO (Either ReceiveFileError ())
-receiveSbFile getBody h = receive
-  where
-    receive sbState sz = do
+    receive sbState h sz = do
      ch <- getBody fileBlockSize
      let chSize = fromIntegral $ B.length ch
      if
-        | chSize > sz + authSz -> pure $ Left RFESize
+        | chSize > sz + authSz -> pure $ Left SIZE
        | chSize > 0 -> do
            let (ch', rest) = B.splitAt (fromIntegral sz) ch
                (decCh, sbState') = LC.sbDecryptChunk sbState ch'
                sz' = sz - fromIntegral (B.length ch')
            B.hPut h decCh
            if sz' > 0
-              then receive sbState' sz'
+              then receive sbState' h sz'
              else do
                let tag' = B.take C.authTagSize rest
                    tagSz = B.length tag'
                    tag = LC.sbAuth sbState'
                tag'' <- if tagSz == C.authTagSize then pure tag' else (tag' <>) <$> getBody (C.authTagSize - tagSz)
-                pure $ if BA.constEq tag'' tag then Right () else Left RFECrypto
-        | otherwise -> pure $ Left RFESize
+                pure $ if BA.constEq tag'' tag then Right () else Left CRYPTO
+        | otherwise -> pure $ Left SIZE
    authSz = fromIntegral C.authTagSize

 receiveFile_ :: (Handle -> Word32 -> IO (Either XFTPErrorType ())) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
@@ -10,6 +10,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -24,7 +25,6 @@ module Simplex.Messaging.Agent.Client
    ProtocolTestStep (..),
    newAgentClient,
    withConnLock,
-    withConnLocks,
    withInvLock,
    closeAgentClient,
    closeProtocolServerClients,
@@ -73,11 +73,8 @@ module Simplex.Messaging.Agent.Client
    logSecret,
    removeSubscription,
    hasActiveSubscription,
-    hasGetLock,
    agentClientStore,
-    agentDRG,
    getAgentSubscriptions,
-    Worker (..),
    SubscriptionsInfo (..),
    SubInfo (..),
    AgentOperation (..),
@@ -85,13 +82,6 @@ module Simplex.Messaging.Agent.Client
    AgentState (..),
    AgentLocks (..),
    AgentStatsKey (..),
-    getAgentWorker,
-    getAgentWorker',
-    cancelWorker,
-    waitForWork,
-    hasWorkToDo,
-    hasWorkToDo',
-    withWork,
    agentOperations,
    agentOperationBracket,
    waitUntilActive,
@@ -108,8 +98,6 @@ module Simplex.Messaging.Agent.Client
    withStore',
    withStoreCtx,
    withStoreCtx',
-    withStoreBatch,
-    withStoreBatch',
    storeError,
    userServers,
    pickServer,
@@ -129,7 +117,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import Crypto.Random (ChaChaDRG)
+import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson.TH as J
 import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Base64
@@ -142,13 +130,12 @@ 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 (isNothing, listToMaybe)
+import Data.Maybe (isJust, listToMaybe)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Text.Encoding
 import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime)
-import Data.Time.Clock.System (getSystemTime)
 import Data.Word (Word16)
 import Network.Socket (HostName)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..), XFTPClient, XFTPClientConfig (..), XFTPClientError)
@@ -210,10 +197,9 @@ import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Random (randomR)
-import UnliftIO (mapConcurrently, timeout)
-import UnliftIO.Async (async)
+import System.Timeout (timeout)
+import UnliftIO (mapConcurrently)
 import UnliftIO.Directory (getTemporaryDirectory)
-import UnliftIO.Exception (bracket)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

@@ -247,10 +233,12 @@ data AgentClient = AgentClient
    activeSubs :: TRcvQueues,
    pendingSubs :: TRcvQueues,
    removedSubs :: TMap (UserId, SMPServer, SMP.RecipientId) SMPClientError,
-    workerSeq :: TVar Int,
-    smpDeliveryWorkers :: TMap SndQAddr (Worker, TMVar ()),
-    asyncCmdWorkers :: TMap (Maybe SMPServer) Worker,
+    pendingMsgsQueued :: TMap SndQAddr Bool,
+    smpQueueMsgQueues :: TMap SndQAddr (TQueue InternalId, TMVar ()),
+    smpQueueMsgDeliveries :: TMap SndQAddr (Async ()),
    connCmdsQueued :: TMap ConnId Bool,
+    asyncCmdQueues :: TMap (Maybe SMPServer) (TQueue AsyncCmdId),
+    asyncCmdProcesses :: TMap (Maybe SMPServer) (Async ()),
    ntfNetworkOp :: TVar AgentOpState,
    rcvNetworkOp :: TVar AgentOpState,
    msgDeliveryOp :: TVar AgentOpState,
@@ -273,72 +261,6 @@ data AgentClient = AgentClient
    agentEnv :: Env
  }

-getAgentWorker :: (AgentMonad' m, Ord k, Show k) => String -> Bool -> AgentClient -> k -> TMap k Worker -> (Worker -> ExceptT AgentErrorType m ()) -> m Worker
-getAgentWorker = getAgentWorker' id pure
-
-getAgentWorker' :: forall a k m. (AgentMonad' m, Ord k, Show k) => (a -> Worker) -> (Worker -> STM a) -> String -> Bool -> AgentClient -> k -> TMap k a -> (a -> ExceptT AgentErrorType m ()) -> m a
-getAgentWorker' toW fromW name hasWork c key ws work = do
-  atomically (getWorker >>= maybe createWorker whenExists) >>= \w -> runWorker w $> w
-  where
-    getWorker = TM.lookup key ws
-    createWorker = do
-      w <- fromW =<< newWorker c
-      TM.insert key w ws
-      pure w
-    whenExists w
-      | hasWork = hasWorkToDo (toW w) $> w
-      | otherwise = pure w
-    runWorker w = runWorkerAsync (toW w) . void $ runExceptT runWork
-      where
-        runWork :: ExceptT AgentErrorType m ()
-        runWork = tryAgentError (work w) >>= restartOrDelete
-        restartOrDelete :: Either AgentErrorType () -> ExceptT AgentErrorType m ()
-        restartOrDelete e_ = do
-          t <- liftIO getSystemTime
-          maxRestarts <- asks $ maxWorkerRestartsPerMin . config
-          -- worker may terminate because it was deleted from the map (getWorker returns Nothing), then it won't restart
-          restart <- atomically $ getWorker >>= maybe (pure False) (shouldRestart e_ (toW w) t maxRestarts)
-          when restart runWork
-        shouldRestart e_ Worker {workerId = wId, doWork, action, restarts} t maxRestarts w'
-          | wId == workerId (toW w') =
-              checkRestarts . updateRestartCount t =<< readTVar restarts
-          | otherwise =
-              pure False -- there is a new worker in the map, no action
-          where
-            checkRestarts rc
-              | restartCount rc < maxRestarts = do
-                  writeTVar restarts rc
-                  hasWorkToDo' doWork
-                  void $ tryPutTMVar action Nothing
-                  notifyErr INTERNAL
-                  pure True
-              | otherwise = do
-                  TM.delete key ws
-                  notifyErr $ CRITICAL True
-                  pure False
-              where
-                notifyErr err = do
-                  let e = either ((", error: " <>) . show) (\_ -> ", no error") e_
-                      msg = "Worker " <> name <> " for " <> show key <> " terminated " <> show (restartCount rc) <> " times" <> e
-                  writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ err msg)
-
-newWorker :: AgentClient -> STM Worker
-newWorker c = do
-  workerId <- stateTVar (workerSeq c) $ \next -> (next, next + 1)
-  doWork <- newTMVar ()
-  action <- newTMVar Nothing
-  restarts <- newTVar $ RestartCount 0 0
-  pure Worker {workerId, doWork, action, restarts}
-
-runWorkerAsync :: AgentMonad' m => Worker -> m () -> m ()
-runWorkerAsync Worker {action} work =
-  bracket
-    (atomically $ takeTMVar action) -- get current action, locking to avoid race conditions
-    (atomically . tryPutTMVar action) -- if it was running (or if start crashes), put it back and unlock (don't lock if it was just started)
-    (\a -> when (isNothing a) start) -- start worker if it's not running
-  where
-    start = atomically . putTMVar action . Just =<< async work
-
 data AgentOperation = AONtfNetwork | AORcvNetwork | AOMsgDelivery | AOSndNetwork | AODatabase
  deriving (Eq, Show)

@@ -353,7 +275,7 @@ agentOpSel = \case
 agentOperations :: [AgentClient -> TVar AgentOpState]
 agentOperations = [ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp]

-data AgentOpState = AgentOpState {opSuspended :: !Bool, opsInProgress :: !Int}
+data AgentOpState = AgentOpState {opSuspended :: Bool, opsInProgress :: Int}

 data AgentState = ASForeground | ASSuspending | ASSuspended
  deriving (Eq, Show)
@@ -393,10 +315,12 @@ newAgentClient InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv = do
  activeSubs <- RQ.empty
  pendingSubs <- RQ.empty
  removedSubs <- TM.empty
-  workerSeq <- newTVar 0
-  smpDeliveryWorkers <- TM.empty
-  asyncCmdWorkers <- TM.empty
+  pendingMsgsQueued <- TM.empty
+  smpQueueMsgQueues <- TM.empty
+  smpQueueMsgDeliveries <- TM.empty
  connCmdsQueued <- TM.empty
+  asyncCmdQueues <- TM.empty
+  asyncCmdProcesses <- TM.empty
  ntfNetworkOp <- newTVar $ AgentOpState False 0
  rcvNetworkOp <- newTVar $ AgentOpState False 0
  msgDeliveryOp <- newTVar $ AgentOpState False 0
@@ -429,10 +353,12 @@ newAgentClient InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv = do
        activeSubs,
        pendingSubs,
        removedSubs,
-        workerSeq,
-        smpDeliveryWorkers,
-        asyncCmdWorkers,
+        pendingMsgsQueued,
+        smpQueueMsgQueues,
+        smpQueueMsgDeliveries,
        connCmdsQueued,
+        asyncCmdQueues,
+        asyncCmdProcesses,
        ntfNetworkOp,
        rcvNetworkOp,
        msgDeliveryOp,
@@ -454,9 +380,6 @@ newAgentClient InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv = do
 agentClientStore :: AgentClient -> SQLiteStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store

-agentDRG :: AgentClient -> TVar ChaChaDRG
-agentDRG AgentClient {agentEnv = Env {random}} = random
-
 class (Encoding err, Show err) => ProtocolServerClient err msg | msg -> err where
  type Client msg = c | c -> msg
  getProtocolServerClient :: AgentMonad m => AgentClient -> TransportSession msg -> m (Client msg)
@@ -497,11 +420,10 @@ getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPTransportSessi
 getSMPServerClient c@AgentClient {active, smpClients, msgQ} tSess@(userId, srv, _) = do
  unlessM (readTVarIO active) . throwError $ INACTIVE
  atomically (getClientVar tSess smpClients)
-    >>= either newClient (waitForProtocolClient c tSess)
+    >>= either
+      (newProtocolClient c tSess smpClients connectClient reconnectSMPClient)
+      (waitForProtocolClient c tSess)
  where
-    newClient v = do
-      tc <- newTVarIO 0
-      newProtocolClient c tSess smpClients connectClient (reconnectSMPClient 0 tc) v
    connectClient :: m SMPClient
    connectClient = do
      cfg <- getClientConfig c smpCfg
@@ -518,7 +440,7 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} tSess@(userId, srv,
          TM.delete tSess smpClients
          qs <- RQ.getDelSessQueues tSess $ activeSubs c
          mapM_ (`RQ.addQueue` pendingSubs c) qs
-          let cs = S.fromList $ map qConnId qs
+          let cs = S.fromList $ map (\q -> q.connId) qs
          cs' <- RQ.getConns $ activeSubs c
          pure (qs, S.toList $ cs `S.difference` cs')

@@ -539,28 +461,14 @@ reconnectServer c tSess = newAsyncAction tryReconnectSMPClient $ reconnections c
  where
    tryReconnectSMPClient aId = do
      ri <- asks $ reconnectInterval . config
-      timeoutCounts <- newTVarIO 0
-      withRetryIntervalCount ri $ \n _ loop ->
-        reconnectSMPClient n timeoutCounts c tSess `catchAgentError` const loop
+      withRetryInterval ri $ \_ loop ->
+        reconnectSMPClient c tSess `catchAgentError` const loop
      atomically . removeAsyncAction aId $ reconnections c

-reconnectSMPClient :: forall m. AgentMonad m => Int -> TVar Int -> AgentClient -> SMPTransportSession -> m ()
-reconnectSMPClient n tc c tSess@(_, srv, _) = do
-  ts <- liftIO getCurrentTime
-  let label = unwords ["reconnect", show n, show ts]
-  withLockMap_ (reconnectLocks c) tSess label $ do
-    qs <- atomically (RQ.getSessQueues tSess $ pendingSubs c)
-    NetworkConfig {tcpTimeout} <- readTVarIO $ useNetworkConfig c
-    -- this allows 3x of timeout per batch of subscription (90 queues per batch empirically)
-    let t = (length qs `div` 90 + 1) * tcpTimeout * 3
-    t `timeout` mapM_ resubscribe (L.nonEmpty qs) >>= \case
-      Just _ -> atomically $ writeTVar tc 0
-      Nothing -> do
-        tc' <- atomically $ stateTVar tc $ \i -> (i + 1, i + 1)
-        maxTC <- asks $ maxSubscriptionTimeouts . config
-        let err = if tc' >= maxTC then CRITICAL True else INTERNAL
-            msg = show tc' <> " consecutive subscription timeouts: " <> show (length qs) <> " queues, transport session: " <> show tSess
-        atomically $ writeTBQueue (subQ c) ("", "", APC SAEConn $ ERR $ err msg)
+reconnectSMPClient :: forall m. AgentMonad m => AgentClient -> SMPTransportSession -> m ()
+reconnectSMPClient c tSess@(_, srv, _) =
+  withLockMap_ (reconnectLocks c) tSess "reconnect" $
+    atomically (RQ.getSessQueues tSess $ pendingSubs c) >>= mapM_ resubscribe . L.nonEmpty
  where
    resubscribe :: NonEmpty RcvQueue -> m ()
    resubscribe qs = do
@@ -689,35 +597,33 @@ closeAgentClient c = liftIO $ do
  closeProtocolServerClients c xftpClients
  cancelActions . actions $ reconnections c
  cancelActions . actions $ asyncClients c
-  clearWorkers smpDeliveryWorkers >>= mapM_ (cancelWorker . fst)
-  clearWorkers asyncCmdWorkers >>= mapM_ cancelWorker
-  clear connCmdsQueued
+  cancelActions $ smpQueueMsgDeliveries c
+  cancelActions $ asyncCmdProcesses c
  atomically . RQ.clear $ activeSubs c
  atomically . RQ.clear $ pendingSubs c
  clear subscrConns
+  clear pendingMsgsQueued
+  clear smpQueueMsgQueues
+  clear connCmdsQueued
+  clear asyncCmdQueues
  clear getMsgLocks
  where
-    clearWorkers :: Ord k => (AgentClient -> TMap k a) -> IO (Map k a)
-    clearWorkers workers = atomically $ swapTVar (workers c) mempty
    clear :: Monoid m => (AgentClient -> TVar m) -> IO ()
    clear sel = atomically $ writeTVar (sel c) mempty

-cancelWorker :: Worker -> IO ()
-cancelWorker Worker {doWork, action} = do
-  noWorkToDo doWork
-  atomically (tryTakeTMVar action) >>= mapM_ (mapM_ uninterruptibleCancel)
-
 waitUntilActive :: AgentClient -> STM ()
 waitUntilActive c = unlessM (readTVar $ active c) retry

 throwWhenInactive :: AgentClient -> STM ()
 throwWhenInactive c = unlessM (readTVar $ active c) $ throwSTM ThreadKilled

-- this function is used to remove workers once delivery is complete, not when it is removed from the map
 throwWhenNoDelivery :: AgentClient -> SndQueue -> STM ()
-throwWhenNoDelivery c sq =
-  unlessM (TM.member (qAddress sq) $ smpDeliveryWorkers c) $
+throwWhenNoDelivery c SndQueue {server, sndId} =
+  unlessM (isJust <$> TM.lookup k (smpQueueMsgQueues c)) $ do
+    TM.delete k $ smpQueueMsgDeliveries c
    throwSTM ThreadKilled
+  where
+    k = (server, sndId)

 closeProtocolServerClients :: ProtocolServerClient err msg => AgentClient -> (AgentClient -> TMap (TransportSession msg) (ClientVar msg)) -> IO ()
 closeProtocolServerClients c clientsSel =
@@ -748,17 +654,8 @@ withConnLock AgentClient {connLocks} connId name = withLockMap_ connLocks connId
 withInvLock :: MonadUnliftIO m => AgentClient -> ByteString -> String -> m a -> m a
 withInvLock AgentClient {invLocks} = withLockMap_ invLocks

-withConnLocks :: MonadUnliftIO m => AgentClient -> [ConnId] -> String -> m a -> m a
-withConnLocks AgentClient {connLocks} = withLocksMap_ connLocks . filter (not . B.null)
-
 withLockMap_ :: (Ord k, MonadUnliftIO m) => TMap k Lock -> k -> String -> m a -> m a
-withLockMap_ = withGetLock . getMapLock
-
-withLocksMap_ :: (Ord k, MonadUnliftIO m) => TMap k Lock -> [k] -> String -> m a -> m a
-withLocksMap_ = withGetLocks . getMapLock
-
-getMapLock :: Ord k => TMap k Lock -> k -> STM Lock
-getMapLock locks key = TM.lookup key locks >>= maybe newLock pure
+withLockMap_ locks key = withGetLock $ TM.lookup key locks >>= maybe newLock pure
  where
    newLock = createLock >>= \l -> TM.insert key l locks $> l

@@ -849,14 +746,13 @@ runSMPServerTest :: AgentMonad m => AgentClient -> UserId -> SMPServerWithAuth -
 runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
  cfg <- getClientConfig c smpCfg
  C.SignAlg a <- asks $ cmdSignAlg . config
-  g <- asks random
  liftIO $ do
    let tSess = (userId, srv, Nothing)
    getProtocolClient tSess cfg Nothing (\_ -> pure ()) >>= \case
      Right smp -> do
-        (rKey, rpKey) <- atomically $ C.generateSignatureKeyPair a g
-        (sKey, _) <- atomically $ C.generateSignatureKeyPair a g
-        (dhKey, _) <- atomically $ C.generateKeyPair g
+        (rKey, rpKey) <- C.generateSignatureKeyPair a
+        (sKey, _) <- C.generateSignatureKeyPair a
+        (dhKey, _) <- C.generateKeyPair'
        r <- runExceptT $ do
          SMP.QIK {rcvId} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rpKey rKey dhKey auth SMSubscribe
          liftError (testErr TSSecureQueue) $ secureSMPQueue smp rpKey rcvId sKey
@@ -873,7 +769,6 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
 runXFTPServerTest :: forall m. AgentMonad m => AgentClient -> UserId -> XFTPServerWithAuth -> m (Maybe ProtocolTestFailure)
 runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
  cfg <- asks $ xftpCfg . config
-  g <- asks random
  xftpNetworkConfig <- readTVarIO $ useNetworkConfig c
  workDir <- getXFTPWorkPath
  filePath <- getTempFilePath workDir
@@ -882,8 +777,8 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
    let tSess = (userId, srv, Nothing)
    X.getXFTPClient tSess cfg {xftpNetworkConfig} (\_ -> pure ()) >>= \case
      Right xftp -> do
-        (sndKey, spKey) <- atomically $ C.generateSignatureKeyPair C.SEd25519 g
-        (rcvKey, rpKey) <- atomically $ C.generateSignatureKeyPair C.SEd25519 g
+        (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519
+        (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519
        createTestChunk filePath
        digest <- liftIO $ C.sha256Hash <$> B.readFile filePath
        let file = FileInfo {sndKey, size = chSize, digest}
@@ -891,7 +786,7 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
        r <- runExceptT $ do
          (sId, [rId]) <- liftError (testErr TSCreateFile) $ X.createXFTPChunk xftp spKey file [rcvKey] auth
          liftError (testErr TSUploadFile) $ X.uploadXFTPChunk xftp spKey sId chunkSpec
-          liftError (testErr TSDownloadFile) $ X.downloadXFTPChunk g xftp rpKey rId $ XFTPRcvChunkSpec rcvPath chSize digest
+          liftError (testErr TSDownloadFile) $ X.downloadXFTPChunk xftp rpKey rId $ XFTPRcvChunkSpec rcvPath chSize digest
          rcvDigest <- liftIO $ C.sha256Hash <$> B.readFile rcvPath
          unless (digest == rcvDigest) $ throwError $ ProtocolTestFailure TSCompareFile $ XFTP DIGEST
          liftError (testErr TSDeleteFile) $ X.deleteXFTPChunk xftp spKey sId
@@ -910,9 +805,8 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
      ts <- liftIO getCurrentTime
      let isoTime = formatTime defaultTimeLocale "%Y-%m-%dT%H%M%S.%6q" ts
      uniqueCombine workPath isoTime
-    -- this creates a new DRG on purpose to avoid blocking the one used in the agent
    createTestChunk :: FilePath -> IO ()
-    createTestChunk fp = B.writeFile fp =<< atomically . C.randomBytes chSize =<< C.newRandom
+    createTestChunk fp = B.writeFile fp =<< getRandomBytes chSize

 getXFTPWorkPath :: AgentMonad m => m FilePath
 getXFTPWorkPath = do
@@ -929,18 +823,17 @@ mkSMPTransportSession :: (AgentMonad' m, SMPQueueRec q) => AgentClient -> q -> m
 mkSMPTransportSession c q = mkSMPTSession q <$> getSessionMode c

 mkSMPTSession :: SMPQueueRec q => q -> TransportSessionMode -> SMPTransportSession
-mkSMPTSession q = mkTSession (qUserId q) (qServer q) (qConnId q)
+mkSMPTSession q = mkTSession q.userId (qServer q) q.connId

 getSessionMode :: AgentMonad' m => AgentClient -> m TransportSessionMode
 getSessionMode = fmap sessionMode . readTVarIO . useNetworkConfig

-newRcvQueue :: AgentMonad m => AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRange -> SubscriptionMode -> m (NewRcvQueue, SMPQueueUri)
+newRcvQueue :: AgentMonad m => AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRange -> SubscriptionMode -> m (RcvQueue, SMPQueueUri)
 newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
  C.SignAlg a <- asks (cmdSignAlg . config)
-  g <- asks random
-  (recipientKey, rcvPrivateKey) <- atomically $ C.generateSignatureKeyPair a g
-  (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
-  (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
+  (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+  (dhKey, privDhKey) <- liftIO C.generateKeyPair'
+  (e2eDhKey, e2ePrivKey) <- liftIO C.generateKeyPair'
  logServer "-->" c srv "" "NEW"
  tSess <- mkTransportSession c userId srv connId
  QIK {rcvId, sndId, rcvPublicDhKey} <-
@@ -958,7 +851,7 @@ newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode = do
            e2eDhSecret = Nothing,
            sndId,
            status = New,
-            dbQueueId = DBNewQueue,
+            dbQueueId = 0,
            primary = True,
            dbReplaceQueueId = Nothing,
            rcvSwchStatus = Nothing,
@@ -1001,8 +894,8 @@ subscribeQueues c qs = do
  -- only "checked" queues are subscribed
  (errs <>) <$> sendTSessionBatches "SUB" 90 id (subscribeQueues_ u) c qs'
  where
-    checkQueue rq = do
-      prohibited <- atomically $ hasGetLock c rq
+    checkQueue rq@RcvQueue {rcvId, server} = do
+      prohibited <- atomically . TM.member (server, rcvId) $ getMsgLocks c
      pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED) else Right rq
    subscribeQueues_ :: UnliftIO m -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
    subscribeQueues_ u smp qs' = do
@@ -1149,14 +1042,10 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" 90 id $ sendBatch disableSMPQueue

 sendAck :: AgentMonad m => AgentClient -> RcvQueue -> MsgId -> m ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
-  withSMPClient c rq ("ACK:" <> logSecret msgId) $ \smp ->
+  withSMPClient c rq "ACK" $ \smp ->
    ackSMPMessage smp rcvPrivateKey rcvId msgId
  atomically $ releaseGetLock c rq

-hasGetLock :: AgentClient -> RcvQueue -> STM Bool
-hasGetLock c RcvQueue {server, rcvId} =
-  TM.member (server, rcvId) $ getMsgLocks c
-
 releaseGetLock :: AgentClient -> RcvQueue -> STM ()
 releaseGetLock c RcvQueue {server, rcvId} =
  TM.lookup (server, rcvId) (getMsgLocks c) >>= mapM_ (`tryPutTMVar` ())
@@ -1218,14 +1107,13 @@ agentNtfDeleteSubscription c subId NtfToken {ntfServer, ntfPrivKey} =
  withNtfClient c ntfServer subId "SDEL" $ \ntf -> ntfDeleteSubscription ntf ntfPrivKey subId

 agentXFTPDownloadChunk :: AgentMonad m => AgentClient -> UserId -> FileDigest -> RcvFileChunkReplica -> XFTPRcvChunkSpec -> m ()
-agentXFTPDownloadChunk c userId (FileDigest chunkDigest) RcvFileChunkReplica {server, replicaId = ChunkReplicaId fId, replicaKey} chunkSpec = do
-  g <- asks random
-  withXFTPClient c (userId, server, chunkDigest) "FGET" $ \xftp -> X.downloadXFTPChunk g xftp replicaKey fId chunkSpec
+agentXFTPDownloadChunk c userId (FileDigest chunkDigest) RcvFileChunkReplica {server, replicaId = ChunkReplicaId fId, replicaKey} chunkSpec =
+  withXFTPClient c (userId, server, chunkDigest) "FGET" $ \xftp -> X.downloadXFTPChunk xftp replicaKey fId chunkSpec

 agentXFTPNewChunk :: AgentMonad m => AgentClient -> SndFileChunk -> Int -> XFTPServerWithAuth -> m NewSndChunkReplica
 agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize}, digest = FileDigest chunkDigest} n (ProtoServerWithAuth srv auth) = do
  rKeys <- xftpRcvKeys n
-  (sndKey, replicaKey) <- atomically . C.generateSignatureKeyPair C.SEd25519 =<< asks random
+  (sndKey, replicaKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519
  let fileInfo = FileInfo {sndKey, size = fromIntegral chunkSize, digest = chunkDigest}
  logServer "-->" c srv "" "FNEW"
  tSess <- mkTransportSession c userId srv chunkDigest
@@ -1249,7 +1137,7 @@ agentXFTPDeleteChunk c userId DeletedSndChunkReplica {server, replicaId = ChunkR

 xftpRcvKeys :: AgentMonad m => Int -> m (NonEmpty C.ASignatureKeyPair)
 xftpRcvKeys n = do
-  rKeys <- atomically . replicateM n . C.generateSignatureKeyPair C.SEd25519 =<< asks random
+  rKeys <- liftIO $ replicateM n $ C.generateSignatureKeyPair C.SEd25519
  case L.nonEmpty rKeys of
    Just rKeys' -> pure rKeys'
    _ -> throwError $ INTERNAL "non-positive number of recipients"
@@ -1259,7 +1147,7 @@ xftpRcvIdsKeys rIds rKeys = L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys

 agentCbEncrypt :: AgentMonad m => SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> m ByteString
 agentCbEncrypt SndQueue {e2eDhSecret, smpClientVersion} e2ePubKey msg = do
-  cmNonce <- atomically . C.randomCbNonce =<< asks random
+  cmNonce <- liftIO C.randomCbNonce
  let paddedLen = maybe SMP.e2eEncMessageLength (const SMP.e2eEncConfirmationLength) e2ePubKey
  cmEncBody <-
    liftEither . first cryptoError $
@@ -1270,10 +1158,9 @@ agentCbEncrypt SndQueue {e2eDhSecret, smpClientVersion} e2ePubKey msg = do
 -- add encoding as AgentInvitation'?
 agentCbEncryptOnce :: AgentMonad m => Version -> C.PublicKeyX25519 -> ByteString -> m ByteString
 agentCbEncryptOnce clientVersion dhRcvPubKey msg = do
-  g <- asks random
-  (dhSndPubKey, dhSndPrivKey) <- atomically $ C.generateKeyPair g
+  (dhSndPubKey, dhSndPrivKey) <- liftIO C.generateKeyPair'
  let e2eDhSecret = C.dh' dhRcvPubKey dhSndPrivKey
-  cmNonce <- atomically $ C.randomCbNonce g
+  cmNonce <- liftIO C.randomCbNonce
  cmEncBody <-
    liftEither . first cryptoError $
      C.cbEncrypt e2eDhSecret cmNonce msg SMP.e2eEncConfirmationLength
@@ -1301,29 +1188,6 @@ cryptoError = \case
  where
    c = AGENT . A_CRYPTO

-waitForWork :: AgentMonad' m => TMVar () -> m ()
-waitForWork = void . atomically . readTMVar
-
-withWork :: AgentMonad m => AgentClient -> TMVar () -> (DB.Connection -> IO (Either StoreError (Maybe a))) -> (a -> m ()) -> m ()
-withWork c doWork getWork action =
-  withStore' c getWork >>= \case
-    Right (Just r) -> action r
-    Right Nothing -> noWork
-    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) ("", "", APC SAEConn $ ERR $ err $ show e)
-
-noWorkToDo :: TMVar () -> IO ()
-noWorkToDo = void . atomically . tryTakeTMVar
-
-hasWorkToDo :: Worker -> STM ()
-hasWorkToDo = hasWorkToDo' . doWork
-
-hasWorkToDo' :: TMVar () -> STM ()
-hasWorkToDo' = void . (`tryPutTMVar` ())
-
 endAgentOperation :: AgentClient -> AgentOperation -> STM ()
 endAgentOperation c op = endOperation c op $ case op of
  AONtfNetwork -> pure ()
@@ -1419,19 +1283,6 @@ withStoreCtx_ ctx_ c action = do
    handleInternal :: String -> E.SomeException -> IO (Either StoreError a)
    handleInternal ctxStr e = pure . Left . SEInternal . B.pack $ show e <> ctxStr

-withStoreBatch :: (AgentMonad' m, Traversable t) => AgentClient -> (DB.Connection -> t (IO (Either AgentErrorType a))) -> m (t (Either AgentErrorType a))
-withStoreBatch c actions = do
-  st <- asks store
-  liftIO . agentOperationBracket c AODatabase (\_ -> pure ()) $
-    withTransaction st $
-      mapM (`E.catch` handleInternal) . actions
-  where
-    handleInternal :: E.SomeException -> IO (Either AgentErrorType a)
-    handleInternal = pure . Left . INTERNAL . show
-
-withStoreBatch' :: (AgentMonad' m, Traversable t) => AgentClient -> (DB.Connection -> t (IO a)) -> m (t (Either AgentErrorType a))
-withStoreBatch' c actions = withStoreBatch c (fmap (fmap Right) . actions)
-
 storeError :: StoreError -> AgentErrorType
 storeError = \case
  SEConnNotFound -> CONN NOT_FOUND
@@ -27,22 +27,21 @@ module Simplex.Messaging.Agent.Env.SQLite
    NtfSupervisor (..),
    NtfSupervisorCommand (..),
    XFTPAgent (..),
-    Worker (..),
-    RestartCount (..),
-    updateRestartCount,
  )
 where

+-- iOS FunPtr smoke test
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
+
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
-import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map (Map)
 import Data.Time.Clock (NominalDiffTime, nominalDay)
-import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16)
 import Network.Socket
 import Numeric.Natural
@@ -93,13 +92,10 @@ data AgentConfig = AgentConfig
    initialCleanupDelay :: Int64,
    cleanupInterval :: Int64,
    cleanupStepInterval :: Int,
-    maxWorkerRestartsPerMin :: Int,
-    maxSubscriptionTimeouts :: Int,
    storedMsgDataTTL :: NominalDiffTime,
    rcvFilesTTL :: NominalDiffTime,
    sndFilesTTL :: NominalDiffTime,
    xftpNotifyErrsOnRetry :: Bool,
-    xftpConsecutiveRetries :: Int,
    xftpMaxRecipientsPerRequest :: Int,
    deleteErrorCount :: Int,
    ntfCron :: Word16,
@@ -161,22 +157,17 @@ defaultAgentConfig =
      initialCleanupDelay = 30 * 1000000, -- 30 seconds
      cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
      cleanupStepInterval = 200000, -- 200ms
-      maxWorkerRestartsPerMin = 5,
-      -- 3 consecutive subscription timeouts will result in alert to the user
-      -- this is a fallback, as the timeout set to 3x of expected timeout, to avoid potential locking.
-      maxSubscriptionTimeouts = 3,
      storedMsgDataTTL = 21 * nominalDay,
      rcvFilesTTL = 2 * nominalDay,
      sndFilesTTL = nominalDay,
      xftpNotifyErrsOnRetry = True,
-      xftpConsecutiveRetries = 3,
      xftpMaxRecipientsPerRequest = 200,
      deleteErrorCount = 10,
      ntfCron = 20, -- minutes
      ntfWorkerDelay = 100000, -- microseconds
      ntfSMPWorkerDelay = 500000, -- microseconds
      ntfSubCheckInterval = nominalDay,
-      ntfMaxMessages = 3,
+      ntfMaxMessages = 4,
      -- CA certificate private key is not needed for initialization
      -- ! we do not generate these
      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
@@ -191,32 +182,41 @@ defaultAgentConfig =
 data Env = Env
  { config :: AgentConfig,
    store :: SQLiteStore,
-    random :: TVar ChaChaDRG,
+    idsDrg :: TVar ChaChaDRG,
    clientCounter :: TVar Int,
    randomServer :: TVar StdGen,
    ntfSupervisor :: NtfSupervisor,
-    xftpAgent :: XFTPAgent,
-    multicastSubscribers :: TMVar Int
+    xftpAgent :: XFTPAgent
  }

 newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
 newSMPAgentEnv config@AgentConfig {initialClientId} store = do
-  random <- C.newRandom
+  idsDrg <- newTVarIO =<< liftIO drgNew
  clientCounter <- newTVarIO initialClientId
  randomServer <- newTVarIO =<< liftIO newStdGen
  ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config
  xftpAgent <- atomically newXFTPAgent
-  multicastSubscribers <- newTMVarIO 0
-  pure Env {config, store, random, clientCounter, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}
+  pure Env {config, store, idsDrg, clientCounter, randomServer, ntfSupervisor, xftpAgent}
+
+createAgentStore :: FilePath -> String -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createAgentStore dbFilePath dbKey cfg = do
+  withHaskellRNG $ \rng -> do
+    (pk, sk) <- sntrup761KeypairWith rng
+    (c, k) <- sntrup761EncWith rng pk
+    k' <- sntrup761Dec c sk
+    if k /= k' then
+      fail "sntrup761 smoke test failed"
+    else
+      putStrLn "sntrup761 smoke test passed"
+
+  createSQLiteStore dbFilePath dbKey Migrations.app cfg

-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 (ConnId, NtfSupervisorCommand),
-    ntfWorkers :: TMap NtfServer Worker,
-    ntfSMPWorkers :: TMap SMPServer Worker
+    ntfWorkers :: TMap NtfServer (TMVar (), Async ()),
+    ntfSMPWorkers :: TMap SMPServer (TMVar (), Async ())
  }

 data NtfSupervisorCommand = NSCCreate | NSCDelete | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer
@@ -233,9 +233,9 @@ newNtfSubSupervisor qSize = do
 data XFTPAgent = XFTPAgent
  { -- if set, XFTP file paths will be considered as relative to this directory
    xftpWorkDir :: TVar (Maybe FilePath),
-    xftpRcvWorkers :: TMap (Maybe XFTPServer) Worker,
-    xftpSndWorkers :: TMap (Maybe XFTPServer) Worker,
-    xftpDelWorkers :: TMap XFTPServer Worker
+    xftpRcvWorkers :: TMap (Maybe XFTPServer) (TMVar (), Async ()),
+    xftpSndWorkers :: TMap (Maybe XFTPServer) (TMVar (), Async ()),
+    xftpDelWorkers :: TMap XFTPServer (TMVar (), Async ())
  }

 newXFTPAgent :: STM XFTPAgent
@@ -261,20 +261,3 @@ agentFinally = allFinally mkInternal
 mkInternal :: SomeException -> AgentErrorType
 mkInternal = INTERNAL . show
 {-# INLINE mkInternal #-}
-
-data Worker = Worker
-  { workerId :: Int,
-    doWork :: TMVar (),
-    action :: TMVar (Maybe (Async ())),
-    restarts :: TVar RestartCount
-  }
-
-data RestartCount = RestartCount
-  { restartMinute :: Int64,
-    restartCount :: Int
-  }
-
-updateRestartCount :: SystemTime -> RestartCount -> RestartCount
-updateRestartCount t (RestartCount minute count) = do
-  let min' = systemSeconds t `div` 60
-   in RestartCount min' $ if minute == min' then count + 1 else 1
@@ -1,18 +1,8 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
-module Simplex.Messaging.Agent.Lock
-  ( Lock,
-    createLock,
-    withLock,
-    withGetLock,
-    withGetLocks,
-  )
-where
+module Simplex.Messaging.Agent.Lock where

 import Control.Monad (void)
 import Control.Monad.IO.Unlift
 import Data.Functor (($>))
-import UnliftIO.Async (forConcurrently)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

@@ -28,22 +18,9 @@ withLock lock name =
    (atomically $ putTMVar lock name)
    (void . atomically $ takeTMVar lock)

-withGetLock :: MonadUnliftIO m => (k -> STM Lock) -> k -> String -> m a -> m a
-withGetLock getLock key name a =
+withGetLock :: MonadUnliftIO m => STM Lock -> String -> m a -> m a
+withGetLock getLock name a =
  E.bracket
-    (atomically $ getPutLock getLock key name)
+    (atomically $ getLock >>= \l -> putTMVar l name $> l)
    (atomically . takeTMVar)
    (const a)
-
-withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> [k] -> String -> m a -> m a
-withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const
-  where
-    holdLocks = forConcurrently keys $ \key -> atomically $ getPutLock getLock key name
-    -- only this withGetLocks would be holding the locks,
-    -- so it's safe to combine all lock releases into one transaction
-    releaseLocks = atomically . mapM_ takeTMVar
-
-- getLock and putTMVar can be in one transaction on the assumption that getLock doesn't write in case the lock already exists,
-- and in case it is created and added to some shared resource (we use TMap) it also helps avoid contention for the newly created lock.
-getPutLock :: (k -> STM Lock) -> k -> String -> STM Lock
-getPutLock getLock key name = getLock key >>= \l -> putTMVar l name $> l
@@ -37,7 +37,9 @@ import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..))
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Protocol (NtfServer, SMPServer, sameSrvAddr)
+import Simplex.Messaging.Protocol (NtfServer, ProtocolServer, SMPServer, sameSrvAddr)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
@@ -77,11 +79,11 @@ processNtfSub c (connId, cmd) = do
              Just ClientNtfCreds {notifierId} -> do
                let newSub = newNtfSubscription connId smpServer (Just notifierId) ntfServer NASKey
                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubNTFAction NSACreate
-                void $ getNtfNTFWorker True c ntfServer
+                addNtfNTFWorker ntfServer
              Nothing -> do
                let newSub = newNtfSubscription connId smpServer Nothing ntfServer NASNew
                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubSMPAction NSASmpKey
-                void $ getNtfSMPWorker True c smpServer
+                addNtfSMPWorker smpServer
        (Just (sub@NtfSubscription {ntfSubStatus, ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
          case (clientNtfCreds, ntfQueueId) of
            (Just ClientNtfCreds {notifierId}, Just ntfQueueId')
@@ -101,70 +103,80 @@ processNtfSub c (connId, cmd) = do
                      then resetSubscription
                      else withNtfServer c $ \ntfServer -> do
                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NtfSubNTFAction NSACreate)
-                        void $ getNtfNTFWorker True c ntfServer
+                        addNtfNTFWorker ntfServer
                | otherwise -> case action of
-                    NtfSubNTFAction _ -> void $ getNtfNTFWorker True c subNtfServer
-                    NtfSubSMPAction _ -> void $ getNtfSMPWorker True c smpServer
+                    NtfSubNTFAction _ -> addNtfNTFWorker subNtfServer
+                    NtfSubSMPAction _ -> addNtfSMPWorker smpServer
            rotate :: m ()
            rotate = do
              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NtfSubNTFAction NSARotate)
-              void $ getNtfNTFWorker True c subNtfServer
+              addNtfNTFWorker subNtfServer
            resetSubscription :: m ()
            resetSubscription =
              withNtfServer c $ \ntfServer -> do
                let sub' = sub {ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NtfSubSMPAction NSASmpKey)
-                void $ getNtfSMPWorker True c smpServer
+                addNtfSMPWorker smpServer
    NSCDelete -> do
      sub_ <- withStore' c $ \db -> do
        supervisorUpdateNtfAction db connId (NtfSubNTFAction NSADelete)
        getNtfSubscription db connId
      logInfo $ "processNtfSub, NSCDelete - sub_ = " <> tshow sub_
      case sub_ of
-        (Just (NtfSubscription {ntfServer}, _)) -> void $ getNtfNTFWorker True c ntfServer
+        (Just (NtfSubscription {ntfServer}, _)) -> addNtfNTFWorker ntfServer
        _ -> pure () -- err "NSCDelete - no subscription"
    NSCSmpDelete -> do
      withStore' c (`getPrimaryRcvQueue` connId) >>= \case
        Right rq@RcvQueue {server = smpServer} -> do
          logInfo $ "processNtfSub, NSCSmpDelete - rq = " <> tshow rq
          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NtfSubSMPAction NSASmpDelete)
-          void $ getNtfSMPWorker True c smpServer
+          addNtfSMPWorker smpServer
        _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
-    NSCNtfWorker ntfServer -> void $ getNtfNTFWorker True c ntfServer
-    NSCNtfSMPWorker smpServer -> void $ getNtfSMPWorker True c smpServer
-
-getNtfNTFWorker :: AgentMonad' m => Bool -> AgentClient -> NtfServer -> m Worker
-getNtfNTFWorker hasWork c server = do
-  ws <- asks $ ntfWorkers . ntfSupervisor
-  getAgentWorker "ntf_ntf" hasWork c server ws $ runNtfWorker c server
-
-getNtfSMPWorker :: AgentMonad' m => Bool -> AgentClient -> SMPServer -> m Worker
-getNtfSMPWorker hasWork c server = do
-  ws <- asks $ ntfSMPWorkers . ntfSupervisor
-  getAgentWorker "ntf_smp" hasWork c server ws $ runNtfSMPWorker c server
+    NSCNtfWorker ntfServer -> addNtfNTFWorker ntfServer
+    NSCNtfSMPWorker smpServer -> addNtfSMPWorker smpServer
+  where
+    addNtfNTFWorker = addWorker ntfWorkers runNtfWorker
+    addNtfSMPWorker = addWorker ntfSMPWorkers runNtfSMPWorker
+    addWorker ::
+      (NtfSupervisor -> TMap (ProtocolServer s) (TMVar (), Async ())) ->
+      (AgentClient -> ProtocolServer s -> TMVar () -> m ()) ->
+      ProtocolServer s ->
+      m ()
+    addWorker wsSel runWorker srv = do
+      ws <- asks $ wsSel . ntfSupervisor
+      atomically (TM.lookup srv ws) >>= \case
+        Nothing -> do
+          doWork <- newTMVarIO ()
+          worker <- async $ runWorker c srv doWork `agentFinally` atomically (TM.delete srv ws)
+          atomically $ TM.insert srv (doWork, worker) ws
+        Just (doWork, _) ->
+          void . atomically $ tryPutTMVar doWork ()

 withNtfServer :: AgentMonad' m => AgentClient -> (NtfServer -> m ()) -> m ()
 withNtfServer c action = getNtfServer c >>= mapM_ action

-runNtfWorker :: forall m. AgentMonad m => AgentClient -> NtfServer -> Worker -> m ()
-runNtfWorker c srv Worker {doWork} = do
+runNtfWorker :: forall m. AgentMonad m => AgentClient -> NtfServer -> TMVar () -> m ()
+runNtfWorker c srv doWork = do
  delay <- asks $ ntfWorkerDelay . config
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    agentOperationBracket c AONtfNetwork throwWhenInactive runNtfOperation
    threadDelay delay
  where
    runNtfOperation :: m ()
-    runNtfOperation =
-      withWork c doWork (`getNextNtfSubNTFAction` srv) $
-        \nextSub@(NtfSubscription {connId}, _, _) -> do
-          logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
+    runNtfOperation = do
+      nextSub_ <- withStore' c (`getNextNtfSubNTFAction` srv)
+      logInfo $ "runNtfWorker, nextSub_ " <> tshow nextSub_
+      case nextSub_ of
+        Nothing -> noWorkToDo
+        Just a@(NtfSubscription {connId}, _, _) -> do
          ri <- asks $ reconnectInterval . config
          withRetryInterval ri $ \_ loop ->
-            processSub nextSub
+            processAction a
              `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
-    processSub :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> m ()
-    processSub (sub@NtfSubscription {connId, smpServer, ntfSubId}, action, actionTs) = do
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
+    processAction :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> m ()
+    processAction (sub@NtfSubscription {connId, smpServer, ntfSubId}, action, actionTs) = do
      ts <- liftIO getCurrentTime
      unlessM (rescheduleAction doWork ts actionTs) $
        case action of
@@ -228,24 +240,27 @@ runNtfWorker c srv Worker {doWork} = do
          withStore' c $ \db ->
            updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'

-runNtfSMPWorker :: forall m. AgentMonad m => AgentClient -> SMPServer -> Worker -> m ()
-runNtfSMPWorker c srv Worker {doWork} = do
+runNtfSMPWorker :: forall m. AgentMonad m => AgentClient -> SMPServer -> TMVar () -> m ()
+runNtfSMPWorker c srv doWork = do
  delay <- asks $ ntfSMPWorkerDelay . config
  forever $ do
-    waitForWork doWork
+    void . atomically $ readTMVar doWork
    agentOperationBracket c AONtfNetwork throwWhenInactive runNtfSMPOperation
    threadDelay delay
  where
-    runNtfSMPOperation =
-      withWork c doWork (`getNextNtfSubSMPAction` srv) $
-        \nextSub@(NtfSubscription {connId}, _, _) -> do
-          logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
+    runNtfSMPOperation = do
+      nextSub_ <- withStore' c (`getNextNtfSubSMPAction` srv)
+      logInfo $ "runNtfSMPWorker, nextSub_ " <> tshow nextSub_
+      case nextSub_ of
+        Nothing -> noWorkToDo
+        Just a@(NtfSubscription {connId}, _, _) -> do
          ri <- asks $ reconnectInterval . config
          withRetryInterval ri $ \_ loop ->
-            processSub nextSub
+            processAction a
              `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
-    processSub :: (NtfSubscription, NtfSubSMPAction, NtfActionTs) -> m ()
-    processSub (sub@NtfSubscription {connId, ntfServer}, smpAction, actionTs) = do
+    noWorkToDo = void . atomically $ tryTakeTMVar doWork
+    processAction :: (NtfSubscription, NtfSubSMPAction, NtfActionTs) -> m ()
+    processAction (sub@NtfSubscription {connId, ntfServer}, smpAction, actionTs) = do
      ts <- liftIO getCurrentTime
      unlessM (rescheduleAction doWork ts actionTs) $
        case smpAction of
@@ -254,9 +269,8 @@ runNtfSMPWorker c srv Worker {doWork} = do
              Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
                rq <- withStore c (`getPrimaryRcvQueue` connId)
                C.SignAlg a <- asks (cmdSignAlg . config)
-                g <- asks random
-                (ntfPublicKey, ntfPrivateKey) <- atomically $ C.generateSignatureKeyPair a g
-                (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
+                (ntfPublicKey, ntfPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
+                (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- liftIO C.generateKeyPair'
                (notifierId, rcvNtfSrvPubDhKey) <- enableQueueNotifications c rq ntfPublicKey rcvNtfPubDhKey
                let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
                withStore' c $ \db -> do
@@ -279,7 +293,7 @@ rescheduleAction doWork ts actionTs
      void . atomically $ tryTakeTMVar doWork
      void . forkIO $ do
        liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime actionTs ts
-        atomically $ hasWorkToDo' doWork
+        void . atomically $ tryPutTMVar doWork ()
      pure True

 retryOnError :: AgentMonad' m => AgentClient -> Text -> m () -> (AgentErrorType -> m ()) -> AgentErrorType -> m ()
@@ -328,10 +342,13 @@ instantNotifications = \case

 closeNtfSupervisor :: MonadUnliftIO m => NtfSupervisor -> m ()
 closeNtfSupervisor ns = do
-  stopWorkers $ ntfWorkers ns
-  stopWorkers $ ntfSMPWorkers ns
-  where
-    stopWorkers workers = atomically (swapTVar workers M.empty) >>= mapM_ (liftIO . cancelWorker)
+  cancelNtfWorkers_ $ ntfWorkers ns
+  cancelNtfWorkers_ $ ntfSMPWorkers ns
+
+cancelNtfWorkers_ :: MonadUnliftIO m => TMap (ProtocolServer s) (TMVar (), Async ()) -> m ()
+cancelNtfWorkers_ wsVar = do
+  ws <- atomically $ stateTVar wsVar (,M.empty)
+  mapM_ (uninterruptibleCancel . snd) ws

 getNtfServer :: AgentMonad' m => AgentClient -> m (Maybe NtfServer)
 getNtfServer c = do
@@ -193,7 +193,6 @@ import Simplex.Messaging.Protocol
    MsgId,
    NMsgMeta,
    ProtocolServer (..),
-    SMPMsgMeta,
    SMPServer,
    SMPServerWithAuth,
    SndPublicVerifyKey,
@@ -212,7 +211,6 @@ import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTra
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..))
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
-import Simplex.RemoteControl.Types
 import Text.Read
 import UnliftIO.Exception (Exception)

@@ -338,7 +336,6 @@ data ACommand (p :: AParty) (e :: AEntity) where
  SENT :: AgentMsgId -> ACommand Agent AEConn
  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
  MSG :: MsgMeta -> MsgFlags -> MsgBody -> ACommand Agent AEConn
-  MSGNTF :: SMPMsgMeta -> ACommand Agent AEConn
  ACK :: AgentMsgId -> Maybe MsgReceiptInfo -> ACommand Client AEConn
  RCVD :: MsgMeta -> NonEmpty MsgReceipt -> ACommand Agent AEConn
  SWCH :: ACommand Client AEConn
@@ -399,7 +396,6 @@ data ACommandTag (p :: AParty) (e :: AEntity) where
  SENT_ :: ACommandTag Agent AEConn
  MERR_ :: ACommandTag Agent AEConn
  MSG_ :: ACommandTag Agent AEConn
-  MSGNTF_ :: ACommandTag Agent AEConn
  ACK_ :: ACommandTag Client AEConn
  RCVD_ :: ACommandTag Agent AEConn
  SWCH_ :: ACommandTag Client AEConn
@@ -453,7 +449,6 @@ aCommandTag = \case
  SENT _ -> SENT_
  MERR {} -> MERR_
  MSG {} -> MSG_
-  MSGNTF {} -> MSGNTF_
  ACK {} -> ACK_
  RCVD {} -> RCVD_
  SWCH -> SWCH_
@@ -1424,16 +1419,12 @@ data AgentErrorType
    NTF {ntfErr :: ErrorType}
  | -- | XFTP protocol errors forwarded to agent clients
    XFTP {xftpErr :: XFTPErrorType}
-  | -- | XRCP protocol errors forwarded to agent clients
-    RCP {rcpErr :: RCErrorType}
  | -- | SMP server errors
    BROKER {brokerAddress :: String, brokerErr :: BrokerErrorType}
  | -- | errors of other agents
    AGENT {agentErr :: SMPAgentError}
  | -- | agent implementation or dependency errors
    INTERNAL {internalErr :: String}
-  | -- | critical agent errors that should be shown to the user, optionally with restart button
-    CRITICAL {offerRestart :: Bool, criticalErr :: String}
  | -- | agent inactive
    INACTIVE
  deriving (Eq, Show, Exception)
@@ -1510,8 +1501,6 @@ data AgentCryptoError
    RATCHET_EARLIER Word32
  | -- | too many skipped messages
    RATCHET_SKIPPED Word32
-  | -- | ratchet synchronization error
-    RATCHET_SYNC
  deriving (Eq, Read, Show, Exception)

 instance StrEncoding AgentCryptoError where
@@ -1521,14 +1510,12 @@ instance StrEncoding AgentCryptoError where
      <|> "RATCHET_HEADER" $> RATCHET_HEADER
      <|> "RATCHET_EARLIER " *> (RATCHET_EARLIER <$> strP)
      <|> "RATCHET_SKIPPED " *> (RATCHET_SKIPPED <$> strP)
-      <|> "RATCHET_SYNC" $> RATCHET_SYNC
  strEncode = \case
    DECRYPT_AES -> "DECRYPT_AES"
    DECRYPT_CB -> "DECRYPT_CB"
    RATCHET_HEADER -> "RATCHET_HEADER"
    RATCHET_EARLIER n -> "RATCHET_EARLIER " <> strEncode n
    RATCHET_SKIPPED n -> "RATCHET_SKIPPED " <> strEncode n
-    RATCHET_SYNC -> "RATCHET_SYNC"

 instance StrEncoding AgentErrorType where
  strP =
@@ -1537,7 +1524,6 @@ instance StrEncoding AgentErrorType where
      <|> "SMP " *> (SMP <$> strP)
      <|> "NTF " *> (NTF <$> strP)
      <|> "XFTP " *> (XFTP <$> strP)
-      <|> "RCP " *> (RCP <$> strP)
      <|> "BROKER " *> (BROKER <$> textP <* " RESPONSE " <*> (RESPONSE <$> textP))
      <|> "BROKER " *> (BROKER <$> textP <* " TRANSPORT " <*> (TRANSPORT <$> transportErrorP))
      <|> "BROKER " *> (BROKER <$> textP <* A.space <*> parseRead1)
@@ -1545,7 +1531,6 @@ instance StrEncoding AgentErrorType where
      <|> "AGENT QUEUE " *> (AGENT . A_QUEUE <$> parseRead A.takeByteString)
      <|> "AGENT " *> (AGENT <$> parseRead1)
      <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString)
-      <|> "CRITICAL " *> (CRITICAL <$> parseRead1 <* A.space <*> parseRead A.takeByteString)
      <|> "INACTIVE" $> INACTIVE
    where
      textP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')
@@ -1555,7 +1540,6 @@ instance StrEncoding AgentErrorType where
    SMP e -> "SMP " <> strEncode e
    NTF e -> "NTF " <> strEncode e
    XFTP e -> "XFTP " <> strEncode e
-    RCP e -> "RCP " <> strEncode e
    BROKER srv (RESPONSE e) -> "BROKER " <> text srv <> " RESPONSE " <> text e
    BROKER srv (TRANSPORT e) -> "BROKER " <> text srv <> " TRANSPORT " <> serializeTransportError e
    BROKER srv e -> "BROKER " <> text srv <> " " <> bshow e
@@ -1563,7 +1547,6 @@ instance StrEncoding AgentErrorType where
    AGENT (A_QUEUE e) -> "AGENT QUEUE " <> bshow e
    AGENT e -> "AGENT " <> bshow e
    INTERNAL e -> "INTERNAL " <> bshow e
-    CRITICAL restart e -> "CRITICAL " <> bshow restart <> " " <> bshow e
    INACTIVE -> "INACTIVE"
    where
      text = encodeUtf8 . T.pack
@@ -1575,7 +1558,6 @@ cryptoErrToSyncState = \case
  RATCHET_HEADER -> RSRequired
  RATCHET_EARLIER _ -> RSAllowed
  RATCHET_SKIPPED _ -> RSRequired
-  RATCHET_SYNC -> RSRequired

 -- | SMP agent command and response parser for commands passed via network (only parses binary length)
 networkCommandP :: Parser ACmd
@@ -1612,7 +1594,6 @@ instance StrEncoding ACmdTag where
      "SENT" -> ct SENT_
      "MERR" -> ct MERR_
      "MSG" -> ct MSG_
-      "MSGNTF" -> ct MSGNTF_
      "ACK" -> t ACK_
      "RCVD" -> ct RCVD_
      "SWCH" -> t SWCH_
@@ -1668,7 +1649,6 @@ instance (APartyI p, AEntityI e) => StrEncoding (ACommandTag p e) where
    SENT_ -> "SENT"
    MERR_ -> "MERR"
    MSG_ -> "MSG"
-    MSGNTF_ -> "MSGNTF"
    ACK_ -> "ACK"
    RCVD_ -> "RCVD"
    SWCH_ -> "SWCH"
@@ -1707,8 +1687,8 @@ commandP binaryP =
    >>= \case
      ACmdTag SClient e cmd ->
        ACmd SClient e <$> case cmd of
-          NEW_ -> s (NEW <$> strP_ <*> strP_ <*> (strP <|> pure SMP.SMSubscribe))
-          JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
+          NEW_ -> s (NEW <$> strP_ <*> strP_ <*> strP)
+          JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> strP_ <*> binaryP)
          LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
          ACPT_ -> s (ACPT <$> A.takeTill (== ' ') <* A.space <*> binaryP)
          RJCT_ -> s (RJCT <$> A.takeByteString)
@@ -1737,7 +1717,6 @@ commandP binaryP =
          SENT_ -> s (SENT <$> A.decimal)
          MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP)
          MSG_ -> s (MSG <$> strP <* A.space <*> smpP <* A.space <*> binaryP)
-          MSGNTF_ -> s (MSGNTF <$> strP)
          RCVD_ -> s (RCVD <$> strP <* A.space <*> strP)
          DEL_RCVQ_ -> s (DEL_RCVQ <$> strP_ <*> strP_ <*> strP)
          DEL_CONN_ -> pure DEL_CONN
@@ -1792,7 +1771,6 @@ serializeCommand = \case
  SENT mId -> s (SENT_, Str $ bshow mId)
  MERR mId e -> s (MERR_, Str $ bshow mId, e)
  MSG msgMeta msgFlags msgBody -> B.unwords [s MSG_, s msgMeta, smpEncode msgFlags, serializeBinary msgBody]
-  MSGNTF smpMsgMeta -> s (MSGNTF_, smpMsgMeta)
  ACK mId rcptInfo_ -> s (ACK_, Str $ bshow mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_
  RCVD msgMeta rcpts -> s (RCVD_, msgMeta, rcpts)
  SWCH -> s SWCH_
@@ -8,7 +8,6 @@ module Simplex.Messaging.Agent.RetryInterval
    RetryIntervalMode (..),
    RI2State (..),
    withRetryInterval,
-    withRetryIntervalCount,
    withRetryLock2,
    updateRetryInterval2,
  )
@@ -49,18 +48,15 @@ data RetryIntervalMode = RISlow | RIFast
  deriving (Eq, Show)

 withRetryInterval :: forall m a. MonadIO m => RetryInterval -> (Int64 -> m a -> m a) -> m a
-withRetryInterval ri = withRetryIntervalCount ri . const
-
-withRetryIntervalCount :: forall m a. MonadIO m => RetryInterval -> (Int -> Int64 -> m a -> m a) -> m a
-withRetryIntervalCount ri action = callAction 0 0 $ initialInterval ri
+withRetryInterval ri action = callAction 0 $ initialInterval ri
  where
-    callAction :: Int -> Int64 -> Int64 -> m a
-    callAction n elapsed delay = action n delay loop
+    callAction :: Int64 -> Int64 -> m a
+    callAction elapsed delay = action delay loop
      where
        loop = do
          liftIO $ threadDelay' delay
          let elapsed' = elapsed + delay
-          callAction (n + 1) elapsed' $ nextDelay elapsed' delay ri
+          callAction elapsed' $ nextDelay elapsed' delay ri

 -- This function allows action to toggle between slow and fast retry intervals.
 withRetryLock2 :: forall m. MonadIO m => RetryInterval2 -> TMVar () -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
@@ -3,12 +3,12 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -27,6 +27,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Maybe (isJust)
 import Data.Time (UTCTime)
 import Data.Type.Equality
+import GHC.Records (HasField)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
 import qualified Simplex.Messaging.Crypto as C
@@ -50,26 +51,8 @@ import Simplex.Messaging.Version

 -- * Queue types

-data QueueStored = QSStored | QSNew
-
-data SQueueStored (q :: QueueStored) where
-  SQSStored :: SQueueStored 'QSStored
-  SQSNew :: SQueueStored 'QSNew
-
-data DBQueueId (q :: QueueStored) where
-  DBQueueId :: Int64 -> DBQueueId 'QSStored
-  DBNewQueue :: DBQueueId 'QSNew
-
-deriving instance Eq (DBQueueId q)
-
-deriving instance Show (DBQueueId q)
-
-type RcvQueue = StoredRcvQueue 'QSStored
-
-type NewRcvQueue = StoredRcvQueue 'QSNew
-
 -- | A receive queue. SMP queue through which the agent receives messages from a sender.
-data StoredRcvQueue (q :: QueueStored) = RcvQueue
+data RcvQueue = RcvQueue
  { userId :: UserId,
    connId :: ConnId,
    server :: SMPServer,
@@ -88,7 +71,7 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
    -- | queue status
    status :: QueueStatus,
    -- | database queue ID (within connection)
-    dbQueueId :: DBQueueId q,
+    dbQueueId :: Int64,
    -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
    primary :: Bool,
    -- | database queue ID to replace, Nothing if this queue is not replacing another, `Just Nothing` is used for replacing old queues
@@ -129,12 +112,8 @@ data ClientNtfCreds = ClientNtfCreds
  }
  deriving (Eq, Show)

-type SndQueue = StoredSndQueue 'QSStored
-
-type NewSndQueue = StoredSndQueue 'QSNew
-
 -- | A send queue. SMP queue through which the agent sends messages to a recipient.
-data StoredSndQueue (q :: QueueStored) = SndQueue
+data SndQueue = SndQueue
  { userId :: UserId,
    connId :: ConnId,
    server :: SMPServer,
@@ -150,7 +129,7 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
    -- | queue status
    status :: QueueStatus,
    -- | database queue ID (within connection)
-    dbQueueId :: DBQueueId q,
+    dbQueueId :: Int64,
    -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
    primary :: Bool,
    -- | ID of the queue this one is replacing
@@ -203,34 +182,16 @@ switchingRQ = find $ isJust . rcvSwchStatus
 {-# INLINE switchingRQ #-}

 updatedQs :: SMPQueueRec q => q -> NonEmpty q -> NonEmpty q
-updatedQs q = L.map $ \q' -> if dbQId q == dbQId q' then q else q'
+updatedQs q = L.map $ \q' -> if q.dbQueueId == q'.dbQueueId then q else q'
 {-# INLINE updatedQs #-}

-class SMPQueue q => SMPQueueRec q where
-  qUserId :: q -> UserId
-  qConnId :: q -> ConnId
-  dbQId :: q -> Int64
-  dbReplaceQId :: q -> Maybe Int64
-
-instance SMPQueueRec RcvQueue where
-  qUserId RcvQueue {userId} = userId
-  {-# INLINE qUserId #-}
-  qConnId RcvQueue {connId} = connId
-  {-# INLINE qConnId #-}
-  dbQId RcvQueue {dbQueueId = DBQueueId qId} = qId
-  {-# INLINE dbQId #-}
-  dbReplaceQId RcvQueue {dbReplaceQueueId} = dbReplaceQueueId
-  {-# INLINE dbReplaceQId #-}
-
-instance SMPQueueRec SndQueue where
-  qUserId SndQueue {userId} = userId
-  {-# INLINE qUserId #-}
-  qConnId SndQueue {connId} = connId
-  {-# INLINE qConnId #-}
-  dbQId SndQueue {dbQueueId = DBQueueId qId} = qId
-  {-# INLINE dbQId #-}
-  dbReplaceQId SndQueue {dbReplaceQueueId} = dbReplaceQueueId
-  {-# INLINE dbReplaceQId #-}
+type SMPQueueRec q =
+  ( SMPQueue q,
+    HasField "userId" q UserId,
+    HasField "connId" q ConnId,
+    HasField "dbQueueId" q Int64,
+    HasField "dbReplaceQueueId" q (Maybe Int64)
+  )

 -- * Connection types

@@ -339,8 +300,7 @@ ratchetSyncSendProhibited ConnData {ratchetSyncState} =
  ratchetSyncState `elem` ([RSRequired, RSStarted, RSAgreed] :: [RatchetSyncState])

 data PendingCommand = PendingCommand
-  { cmdId :: AsyncCmdId,
-    corrId :: ACorrId,
+  { corrId :: ACorrId,
    userId :: UserId,
    connId :: ConnId,
    command :: AgentCommand
@@ -645,6 +605,4 @@ data StoreError
    SEFileNotFound
  | -- | XFTP Deleted snd chunk replica not found.
    SEDeletedSndChunkReplicaNotFound
-  | -- | Error when reading work item that suspends worker - do not use!
-    SEWorkItemError ByteString
  deriving (Eq, Show, Exception)
@@ -10,13 +10,10 @@ module Simplex.Messaging.Agent.Store.SQLite.Common
    withTransaction',
    withTransactionCtx,
    dbBusyLoop,
-    storeKey,
  )
 where

 import Control.Concurrent (threadDelay)
-import Data.ByteArray (ScrubbedBytes)
-import qualified Data.ByteArray as BA
 import Data.Time.Clock (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (SQLError)
 import qualified Database.SQLite.Simple as SQL
@@ -26,12 +23,9 @@ import UnliftIO.Exception (bracket)
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

-storeKey :: ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
-storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
-
 data SQLiteStore = SQLiteStore
  { dbFilePath :: FilePath,
-    dbKey :: TVar (Maybe ScrubbedBytes),
+    dbEncrypted :: TVar Bool,
    dbConnection :: TMVar DB.Connection,
    dbClosed :: TVar Bool,
    dbNew :: Bool
@@ -48,7 +48,7 @@ timeIt slow sql a = do
  r <- a
  t' <- getCurrentTime
  let diff = diffToMilliseconds $ diffUTCTime t' t
-  atomically $ when (diff > 5) $ TM.alter (updateQueryStats diff) sql slow
+  atomically $ when (diff > 50) $ TM.alter (updateQueryStats diff) sql slow
  pure r
  where
    updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
@@ -65,8 +65,6 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_
 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.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -100,9 +98,7 @@ schemaMigrations =
    ("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)
+    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files)
  ]

 -- | The list of migrations in ascending order by date
@@ -1,20 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20231222_command_created_at :: Query
-m20231222_command_created_at =
-  [sql|
-ALTER TABLE commands ADD COLUMN created_at TEXT NOT NULL DEFAULT('1970-01-01 00:00:00');
-CREATE INDEX idx_commands_server_commands ON commands(host, port, created_at, command_id);
-|]
-
-down_m20231222_command_created_at :: Query
-down_m20231222_command_created_at =
-  [sql|
-DROP INDEX idx_commands_server_commands;
-ALTER TABLE commands DROP COLUMN created_at;
-|]
@@ -1,38 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20231225_failed_work_items :: Query
-m20231225_failed_work_items =
-    [sql|
-ALTER TABLE snd_message_deliveries ADD COLUMN failed INTEGER DEFAULT 0;
-ALTER TABLE commands ADD COLUMN failed INTEGER DEFAULT 0;
-ALTER TABLE ntf_subscriptions ADD COLUMN ntf_failed INTEGER DEFAULT 0;
-ALTER TABLE ntf_subscriptions ADD COLUMN smp_failed INTEGER DEFAULT 0;
-ALTER TABLE rcv_files ADD COLUMN failed INTEGER DEFAULT 0;
-ALTER TABLE snd_files ADD COLUMN failed INTEGER DEFAULT 0;
-ALTER TABLE deleted_snd_chunk_replicas ADD COLUMN failed INTEGER DEFAULT 0;
-
-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);
-|]
-
-down_m20231225_failed_work_items :: Query
-down_m20231225_failed_work_items =
-    [sql|
-DROP INDEX idx_rcv_files_status_created_at;
-DROP INDEX idx_snd_files_status_created_at;
-DROP INDEX idx_snd_files_snd_file_entity_id;
-
-ALTER TABLE snd_message_deliveries DROP COLUMN failed;
-ALTER TABLE commands DROP COLUMN failed;
-ALTER TABLE ntf_subscriptions DROP COLUMN ntf_failed;
-ALTER TABLE ntf_subscriptions DROP COLUMN smp_failed;
-ALTER TABLE rcv_files DROP COLUMN failed;
-ALTER TABLE snd_files DROP COLUMN failed;
-ALTER TABLE deleted_snd_chunk_replicas DROP COLUMN failed;
-|]
@@ -213,8 +213,6 @@ CREATE TABLE ntf_subscriptions(
  created_at TEXT NOT NULL DEFAULT(datetime('now')),
  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
  smp_server_key_hash BLOB,
-  ntf_failed INTEGER DEFAULT 0,
-  smp_failed INTEGER DEFAULT 0,
  PRIMARY KEY(conn_id),
  FOREIGN KEY(smp_host, smp_port) REFERENCES servers(host, port)
  ON DELETE SET NULL ON UPDATE CASCADE,
@@ -231,8 +229,6 @@ CREATE TABLE commands(
  command BLOB NOT NULL,
  agent_version INTEGER NOT NULL DEFAULT 1,
  server_key_hash BLOB,
-  created_at TEXT NOT NULL DEFAULT('1970-01-01 00:00:00'),
-  failed INTEGER DEFAULT 0,
  FOREIGN KEY(host, port) REFERENCES servers
  ON DELETE RESTRICT ON UPDATE CASCADE
 );
@@ -241,7 +237,6 @@ CREATE TABLE snd_message_deliveries(
  conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
  snd_queue_id INTEGER NOT NULL,
  internal_id INTEGER NOT NULL,
-  failed INTEGER DEFAULT 0,
  FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
 );
 CREATE TABLE sqlite_sequence(name,seq);
@@ -278,7 +273,6 @@ CREATE TABLE rcv_files(
  updated_at TEXT NOT NULL DEFAULT(datetime('now')),
  save_file_key BLOB,
  save_file_nonce BLOB,
-  failed INTEGER DEFAULT 0,
  UNIQUE(rcv_file_entity_id)
 );
 CREATE TABLE rcv_file_chunks(
@@ -321,8 +315,7 @@ CREATE TABLE snd_files(
  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
  ,
  src_file_key BLOB,
-  src_file_nonce BLOB,
-  failed INTEGER DEFAULT 0
+  src_file_nonce BLOB
 );
 CREATE TABLE snd_file_chunks(
  snd_file_chunk_id INTEGER PRIMARY KEY,
@@ -366,8 +359,6 @@ CREATE TABLE deleted_snd_chunk_replicas(
  retries INTEGER NOT NULL DEFAULT 0,
  created_at TEXT NOT NULL DEFAULT(datetime('now')),
  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-  ,
-  failed INTEGER DEFAULT 0
 );
 CREATE TABLE encrypted_rcv_message_hashes(
  encrypted_rcv_message_hash_id INTEGER PRIMARY KEY,
@@ -488,12 +479,3 @@ CREATE INDEX idx_encrypted_rcv_message_hashes_created_at ON encrypted_rcv_messag
  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);
@@ -18,7 +18,7 @@ import qualified Data.Map.Strict as M
 import Data.Set (Set)
 import qualified Data.Set as S
 import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
-import Simplex.Messaging.Agent.Store (RcvQueue, StoredRcvQueue (..))
+import Simplex.Messaging.Agent.Store (RcvQueue (..))
 import Simplex.Messaging.Protocol (RecipientId, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -1,52 +0,0 @@
-{-# LANGUAGE StrictData #-}
-
-module Simplex.Messaging.Builder
-  ( Builder (length, builder),
-    byteString,
-    lazyByteString,
-    word16BE,
-    char8,
-    toLazyByteString,
-  )
-where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Builder as BB
-import qualified Data.ByteString.Lazy as LB
-import Data.Word (Word16)
-
-
-- length-aware builder
-data Builder = Builder {length :: Int, builder :: BB.Builder}
-
-instance Semigroup Builder where
-  Builder l1 b1 <> Builder l2 b2 = Builder (l1 + l2) (b1 <> b2)
-  {-# INLINE (<>) #-}
-
-instance Monoid Builder where
-  mempty = Builder 0 mempty
-  {-# INLINE mempty #-}
-  mconcat bs = Builder (sum ls) (mconcat bbs)
-    where
-      (ls, bbs) = foldr (\(Builder l b) ~(ls', bbs') -> (l : ls', b : bbs')) ([], []) bs
-  {-# INLINE mconcat #-}
-
-byteString :: B.ByteString -> Builder
-byteString s = Builder (B.length s) (BB.byteString s)
-{-# INLINE byteString #-}
-
-lazyByteString :: LB.ByteString -> Builder
-lazyByteString s = Builder (fromIntegral $ LB.length s) (BB.lazyByteString s)
-{-# INLINE lazyByteString #-}
-
-word16BE :: Word16 -> Builder
-word16BE = Builder 2 . BB.word16BE
-{-# INLINE word16BE #-}
-
-char8 :: Char -> Builder
-char8 = Builder 1 . BB.char8
-{-# INLINE char8 #-}
-
-toLazyByteString :: Builder -> LB.ByteString
-toLazyByteString = BB.toLazyByteString . builder
-{-# INLINE toLazyByteString #-}
@@ -72,7 +72,9 @@ module Simplex.Messaging.Client
    ClientCommand,

    -- * For testing
+    ClientBatch (..),
    PCTransmission,
+    batchClientTransmissions,
    mkTransmission,
    clientStub,
  )
@@ -96,13 +98,11 @@ import Data.Maybe (fromMaybe)
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import Network.Socket (ServiceName)
 import Numeric.Natural
-import Simplex.Messaging.Builder (Builder)
-import qualified Simplex.Messaging.Builder as BB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
-import Simplex.Messaging.Protocol
+import Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
@@ -136,7 +136,7 @@ data PClient err msg = PClient
    pingErrorCount :: TVar Int,
    clientCorrId :: TVar Natural,
    sentCommands :: TMap CorrId (Request err msg),
-    sndQ :: TBQueue Builder,
+    sndQ :: TBQueue ByteString,
    rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)),
    msgQ :: Maybe (TBQueue (ServerTransmission msg))
  }
@@ -173,7 +173,7 @@ clientStub sessionId = do
            }
      }

-type SMPClient = ProtocolClient ErrorType BrokerMsg
+type SMPClient = ProtocolClient ErrorType SMP.BrokerMsg

 -- | Type for client command data
 type ClientCommand msg = (Maybe C.APrivateSignKey, EntityId, ProtoCommand msg)
@@ -226,9 +226,9 @@ defaultNetworkConfig =
      hostMode = HMOnionViaSocks,
      requiredHostMode = False,
      sessionMode = TSMUser,
-      tcpConnectTimeout = 20_000_000,
-      tcpTimeout = 15_000_000,
-      tcpTimeoutPerKb = 45_000, -- 45ms, should be less than 130ms to avoid Int overflow on 32 bit systems
+      tcpConnectTimeout = 15_000_000,
+      tcpTimeout = 10_000_000,
+      tcpTimeoutPerKb = 20_000, -- 20ms, should be less than 130ms to avoid Int overflow on 32 bit systems
      tcpKeepAlive = Just defaultKeepAliveOpts,
      smpPingInterval = 600_000_000, -- 10min
      smpPingCount = 3,
@@ -237,7 +237,7 @@ defaultNetworkConfig =

 transportClientConfig :: NetworkConfig -> TransportClientConfig
 transportClientConfig NetworkConfig {socksProxy, tcpKeepAlive, logTLSErrors} =
-  TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing}
+  TransportClientConfig {socksProxy, tcpKeepAlive, logTLSErrors}

 -- | protocol client configuration.
 data ProtocolClientConfig = ProtocolClientConfig
@@ -634,7 +634,7 @@ type PCTransmission err msg = (SentRawTransmission, Request err msg)
 -- | Send multiple commands with batching and collect responses
 sendProtocolCommands :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> NonEmpty (ClientCommand msg) -> IO (NonEmpty (Response err msg))
 sendProtocolCommands c@ProtocolClient {batch, blockSize} cs = do
-  bs <- batchTransmissions' batch blockSize <$> mapM (mkTransmission c) cs
+  bs <- batchClientTransmissions batch blockSize <$> mapM (mkTransmission c) cs
  validate . concat =<< mapM (sendBatch c) bs
  where
    validate :: [Response err msg] -> IO (NonEmpty (Response err msg))
@@ -651,22 +651,58 @@ sendProtocolCommands c@ProtocolClient {batch, blockSize} cs = do

 streamProtocolCommands :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> NonEmpty (ClientCommand msg) -> ([Response err msg] -> IO ()) -> IO ()
 streamProtocolCommands c@ProtocolClient {batch, blockSize} cs cb = do
-  bs <- batchTransmissions' batch blockSize <$> mapM (mkTransmission c) cs
+  bs <- batchClientTransmissions batch blockSize <$> mapM (mkTransmission c) cs
  mapM_ (cb <=< sendBatch c) bs

-sendBatch :: ProtocolClient err msg -> TransportBatch (Request err msg) -> IO [Response err msg]
+sendBatch :: ProtocolClient err msg -> ClientBatch err msg -> IO [Response err msg]
 sendBatch c@ProtocolClient {client_ = PClient {sndQ}} b = do
  case b of
-    TBLargeTransmission Request {entityId} -> do
+    CBLargeTransmission Request {entityId} -> do
      putStrLn "send error: large message"
      pure [Response entityId $ Left $ PCETransportError TELargeMsg]
-    TBTransmissions s n rs -> do
+    CBTransmissions s n rs -> do
      when (n > 0) $ atomically $ writeTBQueue sndQ $ tEncodeBatch n s
      mapConcurrently (getResponse c) rs
-    TBTransmission s r -> do
+    CBTransmission s r -> do
      atomically $ writeTBQueue sndQ s
      (: []) <$> getResponse c r

+data ClientBatch err msg
+  = -- ByteString in CBTransmissions does not include count byte, it is added by tEncodeBatch
+    CBTransmissions ByteString Int [Request err msg]
+  | CBTransmission ByteString (Request err msg)
+  | CBLargeTransmission (Request err msg)
+
+-- | encodes and batches transmissions into blocks
+batchClientTransmissions :: forall err msg. Bool -> Int -> NonEmpty (PCTransmission err msg) -> [ClientBatch err msg]
+batchClientTransmissions batch blkSize
+  | batch = reverse . mkBatch []
+  | otherwise = map mkBatch1 . L.toList
+  where
+    mkBatch :: [ClientBatch err msg] -> NonEmpty (PCTransmission err msg) -> [ClientBatch err msg]
+    mkBatch bs ts =
+      let (b, ts_) = encodeBatch "" 0 [] ts
+          bs' = b : bs
+       in maybe bs' (mkBatch bs') ts_
+    mkBatch1 :: PCTransmission err msg -> ClientBatch err msg
+    mkBatch1 (t, r)
+      | B.length s <= blkSize - 2 = CBTransmission s r
+      | otherwise = CBLargeTransmission r
+      where
+        s = tEncode t
+    encodeBatch :: ByteString -> Int -> [Request err msg] -> NonEmpty (PCTransmission err msg) -> (ClientBatch err msg, Maybe (NonEmpty (PCTransmission err msg)))
+    encodeBatch s n rs ts@((t, r) :| ts_)
+      | B.length s' <= blkSize - 3 && n < 255 =
+          case L.nonEmpty ts_ of
+            Just ts' -> encodeBatch s' n' rs' ts'
+            Nothing -> (CBTransmissions s' n' (reverse rs'), Nothing)
+      | n == 0 = (CBLargeTransmission r, L.nonEmpty ts_)
+      | otherwise = (CBTransmissions s n (reverse rs), Just ts)
+      where
+        s' = s <> smpEncode (Large $ tEncode t)
+        n' = n + 1
+        rs' = r : rs
+
 -- | Send Protocol command
 sendProtocolCommand :: forall err msg. ProtocolEncoding err (ProtoCommand msg) => ProtocolClient err msg -> Maybe C.APrivateSignKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
 sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ}, batch, blockSize} pKey entId cmd =
@@ -675,11 +711,11 @@ sendProtocolCommand c@ProtocolClient {client_ = PClient {sndQ}, batch, blockSize
    -- two separate "atomically" needed to avoid blocking
    sendRecv :: SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg)
    sendRecv t r
-      | BB.length s > blockSize - 2 = pure $ Left $ PCETransportError TELargeMsg
+      | B.length s > blockSize - 2 = pure $ Left $ PCETransportError TELargeMsg
      | otherwise = atomically (writeTBQueue sndQ s) >> response <$> getResponse c r
      where
        s
-          | batch = tEncodeBatch 1 . encodeLarge $ tEncode t
+          | batch = tEncodeBatch 1 . smpEncode . Large $ tEncode t
          | otherwise = tEncode t

 -- TODO switch to timeout or TimeManager that supports Int64
@@ -3,7 +3,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -61,9 +60,8 @@ module Simplex.Messaging.Crypto
    DhSecretX25519,
    ADhSecret (..),
    KeyHash (..),
-    newRandom,
-    generateAKeyPair,
    generateKeyPair,
+    generateKeyPair',
    generateSignatureKeyPair,
    generateDhKeyPair,
    privateToX509,
@@ -86,7 +84,6 @@ module Simplex.Messaging.Crypto
    SignatureAlgorithm,
    AlgorithmI (..),
    sign,
-    sign',
    verify,
    verify',
    validSignatureSize,
@@ -106,6 +103,7 @@ module Simplex.Messaging.Crypto
    decryptAESNoPad,
    authTagSize,
    randomAesKey,
+    randomIV,
    randomGCMIV,
    ivSize,
    gcmIVSize,
@@ -117,10 +115,9 @@ module Simplex.Messaging.Crypto
    cbEncrypt,
    cbEncryptMaxLenBS,
    cbDecrypt,
-    sbDecrypt_,
-    sbEncrypt_,
    cbNonce,
    randomCbNonce,
+    pseudoRandomCbNonce,

    -- * NaCl crypto_secretbox
    SbKey (unSbKey),
@@ -132,7 +129,7 @@ module Simplex.Messaging.Crypto
    randomSbKey,

    -- * pseudo-random bytes
-    randomBytes,
+    pseudoRandomBytes,

    -- * digests
    sha256Hash,
@@ -140,7 +137,6 @@ module Simplex.Messaging.Crypto

    -- * Message padding / un-padding
    pad,
-    pad',
    unPad,

    -- * X509 Certificates
@@ -180,7 +176,7 @@ import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
 import qualified Crypto.PubKey.Ed25519 as Ed25519
 import qualified Crypto.PubKey.Ed448 as Ed448
-import Crypto.Random (ChaChaDRG, MonadPseudoRandom, drgNew, randomBytesGenerate, withDRG)
+import Crypto.Random (ChaChaDRG, getRandomBytes, randomBytesGenerate)
 import Data.ASN1.BinaryEncoding
 import Data.ASN1.Encoding
 import Data.ASN1.Types
@@ -206,8 +202,6 @@ 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.Builder (Builder, byteString, word16BE)
-import qualified Simplex.Messaging.Builder as BB
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
@@ -597,23 +591,17 @@ type ASignatureKeyPair = KeyPairType APrivateSignKey

 type ADhKeyPair = KeyPairType APrivateDhKey

-newRandom :: IO (TVar ChaChaDRG)
-newRandom = newTVarIO =<< drgNew
+generateKeyPair :: AlgorithmI a => SAlgorithm a -> IO AKeyPair
+generateKeyPair a = bimap (APublicKey a) (APrivateKey a) <$> generateKeyPair'

-generateAKeyPair :: AlgorithmI a => SAlgorithm a -> TVar ChaChaDRG -> STM AKeyPair
-generateAKeyPair a g = bimap (APublicKey a) (APrivateKey a) <$> generateKeyPair g
+generateSignatureKeyPair :: (AlgorithmI a, SignatureAlgorithm a) => SAlgorithm a -> IO ASignatureKeyPair
+generateSignatureKeyPair a = bimap (APublicVerifyKey a) (APrivateSignKey a) <$> generateKeyPair'

-generateSignatureKeyPair :: (AlgorithmI a, SignatureAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM ASignatureKeyPair
-generateSignatureKeyPair a g = bimap (APublicVerifyKey a) (APrivateSignKey a) <$> generateKeyPair g
+generateDhKeyPair :: (AlgorithmI a, DhAlgorithm a) => SAlgorithm a -> IO ADhKeyPair
+generateDhKeyPair a = bimap (APublicDhKey a) (APrivateDhKey a) <$> generateKeyPair'

-generateDhKeyPair :: (AlgorithmI a, DhAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM ADhKeyPair
-generateDhKeyPair a g = bimap (APublicDhKey a) (APrivateDhKey a) <$> generateKeyPair g
-
-generateKeyPair :: forall a. AlgorithmI a => TVar ChaChaDRG -> STM (KeyPair a)
-generateKeyPair g = stateTVar g (`withDRG` generateKeyPair_)
-
-generateKeyPair_ :: forall a. AlgorithmI a => MonadPseudoRandom ChaChaDRG (KeyPair a)
-generateKeyPair_ = case sAlgorithm @a of
+generateKeyPair' :: forall a. AlgorithmI a => IO (KeyPair a)
+generateKeyPair' = case sAlgorithm @a of
  SEd25519 ->
    Ed25519.generateSecretKey >>= \pk ->
      let k = Ed25519.toPublic pk
@@ -688,10 +676,6 @@ class CryptoSignature s where
  signatureBytes :: s -> ByteString
  decodeSignature :: ByteString -> Either String s

-instance CryptoSignature (Signature s) => StrEncoding (Signature s) where
-  strEncode = serializeSignature
-  strDecode = decodeSignature
-
 instance CryptoSignature ASignature where
  signatureBytes (ASignature _ sig) = signatureBytes sig
  decodeSignature s
@@ -922,14 +906,6 @@ pad msg paddedLen
    len = B.length msg
    padLen = paddedLen - len - 2

-pad' :: Builder -> Int -> Either CryptoError Builder
-pad' msg paddedLen
-  | len <= maxMsgLen && padLen >= 0 = Right $ word16BE (fromIntegral len) <> msg <> byteString (B.replicate padLen '#')
-  | otherwise = Left CryptoLargeMsgError
-  where
-    len = BB.length msg
-    padLen = paddedLen - len - 2
-
 unPad :: ByteString -> Either CryptoError ByteString
 unPad padded
  | B.length lenWrd == 2 && B.length rest >= len = Right $ B.take len rest
@@ -990,11 +966,15 @@ initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
  AES.aeadInit AES.AEAD_GCM cipher ivBytes

 -- | Random AES256 key.
-randomAesKey :: TVar ChaChaDRG -> STM Key
-randomAesKey = fmap Key . randomBytes aesKeySize
+randomAesKey :: IO Key
+randomAesKey = Key <$> getRandomBytes aesKeySize

-randomGCMIV :: TVar ChaChaDRG -> STM GCMIV
-randomGCMIV = fmap GCMIV . randomBytes gcmIVSize
+-- | Random IV bytes for AES256 encryption.
+randomIV :: IO IV
+randomIV = IV <$> getRandomBytes (ivSize @AES256)
+
+randomGCMIV :: IO GCMIV
+randomGCMIV = GCMIV <$> getRandomBytes gcmIVSize

 ivSize :: forall c. AES.BlockCipher c => Int
 ivSize = AES.blockSize (undefined :: c)
@@ -1155,11 +1135,14 @@ cbNonce s
  where
    len = B.length s

-randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
-randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
+randomCbNonce :: IO CbNonce
+randomCbNonce = CryptoBoxNonce <$> getRandomBytes 24

-randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
-randomBytes n gVar = stateTVar gVar $ randomBytesGenerate n
+pseudoRandomCbNonce :: TVar ChaChaDRG -> STM CbNonce
+pseudoRandomCbNonce gVar = CryptoBoxNonce <$> pseudoRandomBytes 24 gVar
+
+pseudoRandomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
+pseudoRandomBytes n gVar = stateTVar gVar $ randomBytesGenerate n

 instance Encoding CbNonce where
  smpEncode = unCbNonce
@@ -1196,8 +1179,8 @@ sbKey s
 unsafeSbKey :: ByteString -> SbKey
 unsafeSbKey s = either error id $ sbKey s

-randomSbKey :: TVar ChaChaDRG -> STM SbKey
-randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar
+randomSbKey :: IO SbKey
+randomSbKey = SecretBoxKey <$> getRandomBytes 32

 xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
 xSalsa20 secret nonce msg = (rs, msg')
@@ -23,7 +23,6 @@ where
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
-import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
@@ -110,8 +109,8 @@ data FTCryptoError
 plain :: FilePath -> CryptoFile
 plain = (`CryptoFile` Nothing)

-randomArgs :: TVar ChaChaDRG -> STM CryptoFileArgs
-randomArgs g = CFArgs <$> C.randomSbKey g <*> C.randomCbNonce g
+randomArgs :: IO CryptoFileArgs
+randomArgs = CFArgs <$> C.randomSbKey <*> C.randomCbNonce

 getFileContentsSize :: CryptoFile -> IO Integer
 getFileContentsSize (CryptoFile path cfArgs) = do
@@ -14,16 +14,13 @@ module Simplex.Messaging.Crypto.Lazy
    sbEncrypt,
    sbDecrypt,
    sbEncryptTailTag,
-    kcbEncryptTailTag,
    sbDecryptTailTag,
-    kcbDecryptTailTag,
    fastReplicate,
    secretBox,
    secretBoxTailTag,
    SbState,
    cbInit,
    sbInit,
-    kcbInit,
    sbEncryptChunk,
    sbDecryptChunk,
    sbEncryptChunkLazy,
@@ -41,6 +38,7 @@ import qualified Crypto.MAC.Poly1305 as Poly1305
 import Data.Bifunctor (first)
 import Data.ByteArray (ByteArrayAccess)
 import qualified Data.ByteArray as BA
+import qualified Data.ByteString as S
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -50,7 +48,6 @@ import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Foreign (sizeOf)
 import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, pattern CbNonce, pattern SbKey)
-import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret (..))
 import Simplex.Messaging.Encoding

 type LazyByteString = LB.ByteString
@@ -130,33 +127,13 @@ secretBox sbProcess secret nonce msg = run <$> sbInit_ secret nonce

 -- | NaCl @secret_box@ lazy encrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
 sbEncryptTailTag :: SbKey -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
-sbEncryptTailTag (SbKey key) = sbEncryptTailTag_ key
-{-# INLINE sbEncryptTailTag #-}
-
-- | NaCl @crypto_box@ lazy encrypt with with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
-kcbEncryptTailTag :: KEMHybridSecret -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
-kcbEncryptTailTag (KEMHybridSecret key) = sbEncryptTailTag_ key
-{-# INLINE kcbEncryptTailTag #-}
-
-sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
-sbEncryptTailTag_ key (CbNonce nonce) msg len paddedLen =
+sbEncryptTailTag (SbKey key) (CbNonce nonce) msg len paddedLen =
  LB.fromChunks <$> (secretBoxTailTag sbEncryptChunk key nonce =<< pad msg len paddedLen)

 -- | 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)
-sbDecryptTailTag (SbKey key) = sbDecryptTailTag_ key
-{-# INLINE sbDecryptTailTag #-}
-
-- | NaCl @crypto_box@ lazy decrypt with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
-kcbDecryptTailTag :: KEMHybridSecret -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
-kcbDecryptTailTag (KEMHybridSecret key) = sbDecryptTailTag_ key
-{-# INLINE kcbDecryptTailTag #-}
-
-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
-sbDecryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
-sbDecryptTailTag_ key (CbNonce nonce) paddedLen packet =
+sbDecryptTailTag (SbKey key) (CbNonce nonce) paddedLen packet =
  case secretBox sbDecryptChunk key nonce c of
    Right (tag :| cs) ->
      let valid = LB.length tag' == 16 && BA.constEq (LB.toStrict tag') tag
@@ -174,7 +151,7 @@ secretBoxTailTag sbProcess secret nonce msg = run <$> sbInit_ secret nonce

 -- passes lazy bytestring via initialized secret box returning the reversed list of chunks
 secretBoxLazy_ :: (SbState -> ByteString -> (ByteString, SbState)) -> SbState -> LazyByteString -> ([ByteString], SbState)
-secretBoxLazy_ sbProcess state = LB.foldlChunks update ([], state)
+secretBoxLazy_ sbProcess state = foldlChunks update ([], state)
  where
    update (cs, st) chunk = let (!c, !st') = sbProcess st chunk in (c : cs, st')

@@ -188,10 +165,6 @@ sbInit :: SbKey -> CbNonce -> Either CryptoError SbState
 sbInit (SbKey secret) (CbNonce nonce) = sbInit_ secret nonce
 {-# INLINE sbInit #-}

-kcbInit :: KEMHybridSecret -> CbNonce -> Either CryptoError SbState
-kcbInit (KEMHybridSecret k) (CbNonce nonce) = sbInit_ k nonce
-{-# INLINE kcbInit #-}
-
 sbInit_ :: ByteArrayAccess key => key -> ByteString -> Either CryptoError SbState
 sbInit_ secret nonce = (state2,) <$> cryptoPassed (Poly1305.initialize rs)
  where
@@ -230,3 +203,10 @@ cryptoPassed :: CE.CryptoFailable b -> Either CryptoError b
 cryptoPassed = \case
  CE.CryptoPassed a -> Right a
  CE.CryptoFailed e -> Left $ CryptoPoly1305Error e
+
+foldlChunks :: (a -> S.ByteString -> a) -> a -> LazyByteString -> a
+foldlChunks f = go
+  where
+    go !a LB.Empty = a
+    go !a (LB.Chunk c cs) = go (f a c) cs
+{-# INLINE foldlChunks #-}
@@ -15,11 +15,11 @@
 module Simplex.Messaging.Crypto.Ratchet where

 import Control.Monad.Except
+import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import Crypto.Hash (SHA512)
 import qualified Crypto.KDF.HKDF as H
-import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
@@ -40,7 +40,6 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
 import Simplex.Messaging.Version
-import UnliftIO.STM

 currentE2EEncryptVersion :: Version
 currentE2EEncryptVersion = 2
@@ -82,10 +81,10 @@ instance AlgorithmI a => StrEncoding (E2ERatchetParamsUri a) where
      [key1, key2] -> pure $ E2ERatchetParamsUri vs key1 key2
      _ -> fail "bad e2e params"

-generateE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> Version -> STM (PrivateKey a, PrivateKey a, E2ERatchetParams a)
-generateE2EParams g v = do
-  (k1, pk1) <- generateKeyPair g
-  (k2, pk2) <- generateKeyPair g
+generateE2EParams :: (AlgorithmI a, DhAlgorithm a) => Version -> IO (PrivateKey a, PrivateKey a, E2ERatchetParams a)
+generateE2EParams v = do
+  (k1, pk1) <- generateKeyPair'
+  (k2, pk2) <- generateKeyPair'
  pure (pk1, pk2, E2ERatchetParams v k1 k2)

 data RatchetInitParams = RatchetInitParams
@@ -346,12 +345,11 @@ maxSkip = 512
 rcDecrypt ::
  forall a.
  (AlgorithmI a, DhAlgorithm a) =>
-  TVar ChaChaDRG ->
  Ratchet a ->
  SkippedMsgKeys ->
  ByteString ->
  ExceptT CryptoError IO (DecryptResult a)
-rcDecrypt g rc@Ratchet {rcRcv, rcAD = Str rcAD} rcMKSkipped msg' = do
+rcDecrypt rc@Ratchet {rcRcv, rcAD = Str rcAD} rcMKSkipped msg' = do
  encMsg@EncRatchetMessage {emHeader} <- parseE CryptoHeaderError smpP msg'
  encHdr <- parseE CryptoHeaderError smpP emHeader
  -- plaintext = TrySkippedMessageKeysHE(state, enc_header, cipher-text, AD)
@@ -391,7 +389,7 @@ rcDecrypt g rc@Ratchet {rcRcv, rcAD = Str rcAD} rcMKSkipped msg' = do
            Left e -> throwE e
            Right (rc'@Ratchet {rcDHRs, rcRK, rcNHKs, rcNHKr}, hmks) -> do
              -- DHRatchetHE(state, header)
-              (_, rcDHRs') <- atomically $ generateKeyPair @a g
+              (_, rcDHRs') <- liftIO $ generateKeyPair' @a
              -- state.RK, state.CKr, state.NHKr = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr))
              let (rcRK', rcCKr', rcNHKr') = rootKdf rcRK msgDHRs rcDHRs
                  -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr))
@@ -1,31 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-
-module Simplex.Messaging.Crypto.SNTRUP761 where
-
-import Crypto.Hash (Digest, SHA256, hash)
-import Data.ByteArray (ScrubbedBytes)
-import qualified Data.ByteArray as BA
-import Data.ByteString (ByteString)
-import Simplex.Messaging.Crypto
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings
-
-- Hybrid shared secret for crypto_box is defined as SHA256(DHSecret || KEMSharedKey),
-- similar to https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/
-
-newtype KEMHybridSecret = KEMHybridSecret ScrubbedBytes
-
-- | NaCl @crypto_box@ decrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
-kcbDecrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Either CryptoError ByteString
-kcbDecrypt (KEMHybridSecret k) = sbDecrypt_ k
-
-- | NaCl @crypto_box@ encrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
-kcbEncrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
-kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
-
-kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
-kemHybridSecret k pk (KEMSharedKey kem) =
-  let DhSecretX25519 dh = C.dh' k pk
-   in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)
@@ -1,82 +1,38 @@
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NamedFieldPuns #-}

 module Simplex.Messaging.Crypto.SNTRUP761.Bindings where

-import Control.Concurrent.STM
-import Crypto.Random (ChaChaDRG)
-import Data.Aeson (FromJSON (..), ToJSON (..))
-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.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
-import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNG (..))

-newtype KEMPublicKey = KEMPublicKey ByteString
-  deriving (Show)
+type PublicKey = ByteString

-newtype KEMSecretKey = KEMSecretKey ScrubbedBytes
-  deriving (Show)
+type SecretKey = ScrubbedBytes

-newtype KEMCiphertext = KEMCiphertext ByteString
-  deriving (Show)
+type Ciphertext = ByteString

-newtype KEMSharedKey = KEMSharedKey ScrubbedBytes
-  deriving (Show)
+type Key = ScrubbedBytes

-type KEMKeyPair = (KEMPublicKey, KEMSecretKey)
+sntrup761KeypairWith :: RNG -> IO (PublicKey, SecretKey)
+sntrup761KeypairWith RNG{rngContext, rngFunc} = do
+  BA.allocRet c_SNTRUP761_SECRETKEY_SIZE $ \skPtr ->
+    BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
+      sntrup761_keypair pkPtr skPtr rngContext rngFunc

-sntrup761Keypair :: TVar ChaChaDRG -> IO KEMKeyPair
-sntrup761Keypair drg =
-  bimap KEMPublicKey KEMSecretKey
-    <$> BA.allocRet
-      c_SNTRUP761_SECRETKEY_SIZE
-      ( \skPtr ->
-          BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
-            withDRG drg $ c_sntrup761_keypair pkPtr skPtr nullPtr
-      )
-
-sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
-sntrup761Enc drg (KEMPublicKey pk) =
+sntrup761EncWith :: RNG -> PublicKey -> IO (Ciphertext, Key)
+sntrup761EncWith RNG {rngContext, rngFunc} pk =
  BA.withByteArray pk $ \pkPtr ->
-    bimap KEMCiphertext KEMSharedKey
-      <$> BA.allocRet
-        c_SNTRUP761_SIZE
-        ( \kPtr ->
-            BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
-              withDRG drg $ c_sntrup761_enc cPtr kPtr pkPtr nullPtr
-        )
+    BA.allocRet c_SNTRUP761_SIZE $ \kPtr ->
+      BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
+        sntrup761_enc cPtr kPtr pkPtr rngContext rngFunc

-sntrup761Dec :: KEMCiphertext -> KEMSecretKey -> IO KEMSharedKey
-sntrup761Dec (KEMCiphertext c) (KEMSecretKey sk) =
+sntrup761Dec :: Ciphertext -> SecretKey -> IO Key
+sntrup761Dec c sk =
  BA.withByteArray sk $ \skPtr ->
    BA.withByteArray c $ \cPtr ->
-      KEMSharedKey
-        <$> BA.alloc c_SNTRUP761_SIZE (\kPtr -> c_sntrup761_dec kPtr cPtr skPtr)
-
-instance StrEncoding KEMPublicKey where
-  strEncode (KEMPublicKey pk) = strEncode (BA.convert pk :: ByteString)
-  strP = KEMPublicKey . BA.convert <$> strP @ByteString
-
-instance Encoding KEMCiphertext where
-  smpEncode (KEMCiphertext c) = smpEncode . Large $ BA.convert c
-  smpP = KEMCiphertext . BA.convert . unLarge <$> smpP
-
-instance ToJSON KEMPublicKey where
-  toJSON = strToJSON
-  toEncoding = strToJEncoding
-
-instance FromJSON KEMPublicKey where
-  parseJSON = strParseJSON "KEMPublicKey"
-
-instance ToField KEMSharedKey where
-  toField (KEMSharedKey k) = toField (BA.convert k :: ByteString)
-
-instance FromField KEMSharedKey where
-  fromField f = KEMSharedKey . BA.convert @ByteString <$> fromField f
+      BA.alloc c_SNTRUP761_SIZE $ \kPtr ->
+        sntrup761_dec kPtr cPtr skPtr
@@ -1,5 +1,7 @@
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines where

+import Foreign.C
+
 #include "sntrup761.h"

 c_SNTRUP761_SECRETKEY_SIZE :: Int
@@ -1,10 +1,10 @@
 {-# LANGUAGE ForeignFunctionInterface #-}

-module Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
-  ( c_sntrup761_keypair,
-    c_sntrup761_enc,
-    c_sntrup761_dec,
-  ) where
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI (
+  sntrup761_keypair,
+  sntrup761_enc,
+  sntrup761_dec,
+) where

 import Foreign
 import Foreign.C
@@ -12,12 +12,12 @@ import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNGContext, RNGFunc)

 -- void sntrup761_keypair (uint8_t *pk, uint8_t *sk, void *random_ctx, sntrup761_random_func *random);
 foreign import ccall "sntrup761_keypair"
-  c_sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
+  sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> RNGContext -> FunPtr RNGFunc -> IO ()

 -- void sntrup761_enc (uint8_t *c, uint8_t *k, const uint8_t *pk, void *random_ctx, sntrup761_random_func *random);
 foreign import ccall "sntrup761_enc"
-  c_sntrup761_enc :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
+  sntrup761_enc :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> RNGContext -> FunPtr RNGFunc -> IO ()

 -- void sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);
 foreign import ccall "sntrup761_dec"
-  c_sntrup761_dec :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
+  sntrup761_dec :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
@@ -1,30 +1,55 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
-  ( withDRG,
+  ( RNG (..),
+    -- dummyRNG,
+    withHaskellRNG,
+    startHaskellRNG,
+    stopHaskellRNG,
    RNGContext,
    RNGFunc,
+    mkRNGFunc,
  ) where

-import Control.Concurrent.STM
-import Control.Exception (bracket)
-import Crypto.Random (ChaChaDRG)
-import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr))
 import Foreign
 import Foreign.C
-import qualified Simplex.Messaging.Crypto as C

-withDRG :: TVar ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
-withDRG drg = bracket (createRNGFunc drg) freeHaskellFunPtr
+import Crypto.Random (drgNew, randomBytesGenerate)
+import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr), Bytes)
+import Data.IORef (atomicModifyIORef', newIORef)
+import UnliftIO (bracket)

-createRNGFunc :: TVar ChaChaDRG -> IO (FunPtr RNGFunc)
-createRNGFunc drg =
-  mkRNGFunc $ \_ctx sz buf -> do
-    bs <- atomically $ C.randomBytes (fromIntegral sz) drg
+data RNG = RNG
+  { rngContext :: RNGContext,
+    rngFunc :: FunPtr RNGFunc
+  }
+
+withHaskellRNG :: (RNG -> IO c) -> IO c
+withHaskellRNG = bracket startHaskellRNG stopHaskellRNG
+
+startHaskellRNG :: IO RNG
+startHaskellRNG = do
+  chachaState <- drgNew >>= newIORef -- XXX: ctxPtr could be used to store drg state, but cryptonite doesn't provide ByteAccess for ChaChaDRG
+  rngFunc <- mkRNGFunc $ \_ctxPtr sz buf -> do
+    bs <- atomicModifyIORef' chachaState $ swap . randomBytesGenerate (fromIntegral sz) :: IO Bytes
    copyByteArrayToPtr bs buf
+  pure RNG {rngContext = nullPtr, rngFunc}
+  where
+    swap (a, b) = (b, a)

-type RNGContext = ()
+stopHaskellRNG :: RNG -> IO ()
+stopHaskellRNG RNG {rngFunc} = freeHaskellFunPtr rngFunc
+
+type RNGContext = Ptr RNG

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

 foreign import ccall "wrapper"
  mkRNGFunc :: RNGFunc -> IO (FunPtr RNGFunc)
+
+-- dummyRNG :: RNG
+-- dummyRNG = RNG {rngContext = nullPtr, rngFunc = randomDummy}
+
+-- foreign import ccall "&sxcrandom_dummy"
+--   randomDummy :: FunPtr RNGFunc
@@ -11,8 +11,6 @@ module Simplex.Messaging.Encoding
  ( Encoding (..),
    Tail (..),
    Large (..),
-    encodeLarge,
-    _smpP,
    smpEncodeList,
    smpListP,
    lenEncode,
@@ -30,8 +28,6 @@ import qualified Data.List.NonEmpty as L
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16, Word32)
 import Network.Transport.Internal (decodeWord16, decodeWord32, encodeWord16, encodeWord32)
-import Simplex.Messaging.Builder (Builder, word16BE)
-import qualified Simplex.Messaging.Builder as BB
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Util ((<$?>))

@@ -141,19 +137,12 @@ instance Encoding Large where
    Large <$> A.take len
  {-# INLINE smpP #-}

-encodeLarge :: Builder -> Builder
-encodeLarge s = word16BE (fromIntegral $ BB.length s) <> s
-{-# INLINE encodeLarge #-}
-
 instance Encoding SystemTime where
  smpEncode = smpEncode . systemSeconds
  {-# INLINE smpEncode #-}
  smpP = MkSystemTime <$> smpP <*> pure 0
  {-# INLINE smpP #-}

-_smpP :: Encoding a => Parser a
-_smpP = A.space *> smpP
-
 -- lists encode/parse as a sequence of items prefixed with list length (as 1 byte)
 smpEncodeList :: Encoding a => [a] -> ByteString
 smpEncodeList xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs
@@ -181,37 +170,37 @@ instance (Encoding a, Encoding b) => Encoding (a, b) where
  {-# INLINE smpP #-}

 instance (Encoding a, Encoding b, Encoding c) => Encoding (a, b, c) where
-  smpEncode (a, b, c) = B.concat [smpEncode a, smpEncode b, smpEncode c]
+  smpEncode (a, b, c) = smpEncode a <> smpEncode b <> smpEncode c
  {-# INLINE smpEncode #-}
  smpP = (,,) <$> smpP <*> smpP <*> smpP
  {-# INLINE smpP #-}

 instance (Encoding a, Encoding b, Encoding c, Encoding d) => Encoding (a, b, c, d) where
-  smpEncode (a, b, c, d) = B.concat [smpEncode a, smpEncode b, smpEncode c, smpEncode d]
+  smpEncode (a, b, c, d) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d
  {-# INLINE smpEncode #-}
  smpP = (,,,) <$> smpP <*> smpP <*> smpP <*> smpP
  {-# INLINE smpP #-}

 instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e) => Encoding (a, b, c, d, e) where
-  smpEncode (a, b, c, d, e) = B.concat [smpEncode a, smpEncode b, smpEncode c, smpEncode d, smpEncode e]
+  smpEncode (a, b, c, d, e) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e
  {-# INLINE smpEncode #-}
  smpP = (,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP
  {-# INLINE smpP #-}

 instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f) => Encoding (a, b, c, d, e, f) where
-  smpEncode (a, b, c, d, e, f) = B.concat [smpEncode a, smpEncode b, smpEncode c, smpEncode d, smpEncode e, smpEncode f]
+  smpEncode (a, b, c, d, e, f) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e <> smpEncode f
  {-# INLINE smpEncode #-}
  smpP = (,,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
  {-# INLINE smpP #-}

 instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f, Encoding g) => Encoding (a, b, c, d, e, f, g) where
-  smpEncode (a, b, c, d, e, f, g) = B.concat [smpEncode a, smpEncode b, smpEncode c, smpEncode d, smpEncode e, smpEncode f, smpEncode g]
+  smpEncode (a, b, c, d, e, f, g) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e <> smpEncode f <> smpEncode g
  {-# INLINE smpEncode #-}
  smpP = (,,,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
  {-# INLINE smpP #-}

 instance (Encoding a, Encoding b, Encoding c, Encoding d, Encoding e, Encoding f, Encoding g, Encoding h) => Encoding (a, b, c, d, e, f, g, h) where
-  smpEncode (a, b, c, d, e, f, g, h) = B.concat [smpEncode a, smpEncode b, smpEncode c, smpEncode d, smpEncode e, smpEncode f, smpEncode g, smpEncode h]
+  smpEncode (a, b, c, d, e, f, g, h) = smpEncode a <> smpEncode b <> smpEncode c <> smpEncode d <> smpEncode e <> smpEncode f <> smpEncode g <> smpEncode h
  {-# INLINE smpEncode #-}
  smpP = (,,,,,,,) <$> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP <*> smpP
  {-# INLINE smpP #-}
@@ -345,17 +345,17 @@ runNtfClientTransport th@THandle {sessionId} = do
  raceAny_ ([liftIO $ send th c, client c s ps, receive th c] <> disconnectThread_ c expCfg)
    `finally` liftIO (clientDisconnected c)
  where
-    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport th (rcvActiveAt c) (sndActiveAt c) expCfg (pure True)]
+    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport th c activeAt expCfg]
    disconnectThread_ _ _ = []

 clientDisconnected :: NtfServerClient -> IO ()
 clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connected False

 receive :: Transport c => THandle c -> NtfServerClient -> M ()
-receive th NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
+receive th NtfServerClient {rcvQ, sndQ, activeAt} = forever $ do
  ts <- liftIO $ tGet th
  forM_ ts $ \t@(_, _, (corrId, entId, cmdOrError)) -> do
-    atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
+    atomically . writeTVar activeAt =<< liftIO getSystemTime
    logDebug "received transmission"
    case cmdOrError of
      Left e -> write sndQ (corrId, entId, NRErr e)
@@ -367,10 +367,10 @@ receive th NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
    write q t = atomically $ writeTBQueue q t

 send :: Transport c => THandle c -> NtfServerClient -> IO ()
-send h@THandle {thVersion = v} NtfServerClient {sndQ, sessionId, sndActiveAt} = forever $ do
+send h@THandle {thVersion = v} NtfServerClient {sndQ, sessionId, activeAt} = forever $ do
  t <- atomically $ readTBQueue sndQ
  void . liftIO $ tPut h Nothing [(Nothing, encodeTransmission v sessionId t)]
-  atomically . writeTVar sndActiveAt =<< liftIO getSystemTime
+  atomically . writeTVar activeAt =<< liftIO getSystemTime

 -- instance Show a => Show (TVar a) where
 --   show x = unsafePerformIO $ show <$> readTVarIO x
@@ -440,7 +440,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
      NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn _ _ dhPubKey)) -> do
        logDebug "TNEW - new token"
        st <- asks store
-        ks@(srvDhPubKey, srvDhPrivKey) <- atomically . C.generateKeyPair =<< asks random
+        ks@(srvDhPubKey, srvDhPrivKey) <- liftIO C.generateKeyPair'
        let dhSecret = C.dh' dhPubKey srvDhPrivKey
        tknId <- getId
        regCode <- getRegCode
@@ -565,11 +565,13 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
          PING -> pure NRPong
      NtfReqPing corrId entId -> pure (corrId, entId, NRPong)
    getId :: M NtfEntityId
-    getId = randomBytes =<< asks (subIdBytes . config)
+    getId = getRandomBytes =<< asks (subIdBytes . config)
    getRegCode :: M NtfRegCode
-    getRegCode = NtfRegCode <$> (randomBytes =<< asks (regCodeBytes . config))
-    randomBytes :: Int -> M ByteString
-    randomBytes n = atomically . C.randomBytes n =<< asks random
+    getRegCode = NtfRegCode <$> (getRandomBytes =<< asks (regCodeBytes . config))
+    getRandomBytes :: Int -> M ByteString
+    getRandomBytes n = do
+      gVar <- asks idsDrg
+      atomically (C.pseudoRandomBytes n gVar)
    cancelInvervalNotifications :: NtfTokenId -> M ()
    cancelInvervalNotifications tknId =
      atomically (TM.lookupDelete tknId intervalNotifiers)
@@ -66,8 +66,8 @@ data NtfServerConfig = NtfServerConfig
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
  ExpirationConfig
-    { ttl = 43200, -- seconds, 12 hours
-      checkInterval = 3600 -- seconds, 1 hours
+    { ttl = 7200, -- 2 hours
+      checkInterval = 3600 -- seconds, 1 hour
    }

 data NtfEnv = NtfEnv
@@ -76,7 +76,7 @@ data NtfEnv = NtfEnv
    pushServer :: NtfPushServer,
    store :: NtfStore,
    storeLog :: Maybe (StoreLog 'WriteMode),
-    random :: TVar ChaChaDRG,
+    idsDrg :: TVar ChaChaDRG,
    tlsServerParams :: T.ServerParams,
    serverIdentity :: C.KeyHash,
    serverStats :: NtfServerStats
@@ -84,7 +84,7 @@ data NtfEnv = NtfEnv

 newNtfServerEnv :: (MonadUnliftIO m, MonadRandom m) => NtfServerConfig -> m NtfEnv
 newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsConfig, storeLogFile, caCertificateFile, certificateFile, privateKeyFile} = do
-  random <- liftIO C.newRandom
+  idsDrg <- newTVarIO =<< drgNew
  store <- atomically newNtfStore
  logInfo "restoring subscriptions..."
  storeLog <- liftIO $ mapM (`readWriteNtfStore` store) storeLogFile
@@ -94,7 +94,7 @@ newNtfServerEnv config@NtfServerConfig {subQSize, pushQSize, smpAgentCfg, apnsCo
  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
  serverStats <- atomically . newNtfServerStats =<< liftIO getCurrentTime
-  pure NtfEnv {config, subscriber, pushServer, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
+  pure NtfEnv {config, subscriber, pushServer, store, storeLog, idsDrg, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}

 data NtfSubscriber = NtfSubscriber
  { smpSubscribers :: TMap SMPServer SMPSubscriber,
@@ -160,8 +160,7 @@ data NtfServerClient = NtfServerClient
    sndQ :: TBQueue (Transmission NtfResponse),
    sessionId :: ByteString,
    connected :: TVar Bool,
-    rcvActiveAt :: TVar SystemTime,
-    sndActiveAt :: TVar SystemTime
+    activeAt :: TVar SystemTime
  }

 newNtfServerClient :: Natural -> ByteString -> SystemTime -> STM NtfServerClient
@@ -169,6 +168,5 @@ newNtfServerClient qSize sessionId ts = do
  rcvQ <- newTBQueue qSize
  sndQ <- newTBQueue qSize
  connected <- newTVar True
-  rcvActiveAt <- newTVar ts
-  sndActiveAt <- newTVar ts
-  return NtfServerClient {rcvQ, sndQ, sessionId, connected, rcvActiveAt, sndActiveAt}
+  activeAt <- newTVar ts
+  return NtfServerClient {rcvQ, sndQ, sessionId, connected, activeAt}
@@ -17,11 +17,10 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..))
 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.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS (defaultAPNSPushClientConfig)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
 import Simplex.Messaging.Server.CLI
-import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
@@ -30,7 +29,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)

 ntfServerVersion :: String
-ntfServerVersion = "1.7.0.4"
+ntfServerVersion = "1.6.2"

 defaultSMPBatchDelay :: Int
 defaultSMPBatchDelay = 10000
@@ -87,12 +86,7 @@ ntfServerCLI cfgPath logPath =
            <> "log_tls_errors: off\n\
               \# delay between command batches sent to SMP relays (microseconds), 0 to disable\n"
            <> ("smp_batch_delay: " <> show defaultSMPBatchDelay <> "\n")
-            <> "websockets: off\n\n\
-               \[INACTIVE_CLIENTS]\n\
-               \# TTL and interval to check inactive clients\n\
-               \disconnect: off\n"
-            <> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
-            <> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n")
+            <> "websockets: off\n"
    runServer ini = do
      hSetBuffering stdout LineBuffering
      hSetBuffering stderr LineBuffering
@@ -121,12 +115,7 @@ ntfServerCLI cfgPath logPath =
              smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {batchDelay}},
              apnsConfig = defaultAPNSPushClientConfig,
              subsBatchSize = 900,
-              inactiveClientExpiration =
-                settingIsOn "INACTIVE_CLIENTS" "disconnect" ini
-                  $> ExpirationConfig
-                    { ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
-                      checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
-                    },
+              inactiveClientExpiration = Nothing,
              storeLogFile = enableStoreLog $> storeLogFilePath,
              caCertificateFile = c caCrtFile,
              privateKeyFile = c serverKeyFile,
@@ -18,7 +18,7 @@ import Control.Monad.IO.Class
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
 import qualified Crypto.PubKey.ECC.Types as ECT
-import Crypto.Random (ChaChaDRG)
+import Crypto.Random (ChaChaDRG, drgNew)
 import qualified Crypto.Store.PKCS8 as PK
 import Data.ASN1.BinaryEncoding (DER (..))
 import Data.ASN1.Encoding
@@ -232,7 +232,7 @@ createAPNSPushClient apnsHost apnsCfg@APNSPushClientConfig {authKeyFileEnv, auth
  authKeyId <- T.pack <$> getEnv authKeyIdEnv
  let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId}
  jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey
-  nonceDrg <- C.newRandom
+  nonceDrg <- drgNew >>= newTVarIO
  pure APNSPushClient {https2Client, privateKey, jwtHeader, jwtToken, nonceDrg, apnsHost, apnsCfg}

 getApnsJWTToken :: APNSPushClient -> IO SignedJWTToken
@@ -337,7 +337,7 @@ $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
 apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken _ tknStr} pn = do
  http2 <- liftHTTPS2 $ getApnsHTTP2Client c
-  nonce <- atomically $ C.randomCbNonce nonceDrg
+  nonce <- atomically $ C.pseudoRandomCbNonce nonceDrg
  apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
  req <- liftIO $ apnsRequest c tknStr apnsNtf
  -- TODO when HTTP2 client is thread-safe, we can use sendRequestDirect
@@ -1,5 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}

 module Simplex.Messaging.Notifications.Server.Stats where
@@ -55,31 +56,31 @@ newNtfServerStats ts = do
  pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}

 getNtfServerStatsData :: NtfServerStats -> STM NtfServerStatsData
-getNtfServerStatsData s@NtfServerStats {fromTime} = do
-  _fromTime <- readTVar fromTime
-  _tknCreated <- readTVar $ tknCreated s
-  _tknVerified <- readTVar $ tknVerified s
-  _tknDeleted <- readTVar $ tknDeleted s
-  _subCreated <- readTVar $ subCreated s
-  _subDeleted <- readTVar $ subDeleted s
-  _ntfReceived <- readTVar $ ntfReceived s
-  _ntfDelivered <- readTVar $ ntfDelivered s
-  _activeTokens <- getPeriodStatsData $ activeTokens s
-  _activeSubs <- getPeriodStatsData $ activeSubs s
+getNtfServerStatsData s = do
+  _fromTime <- readTVar s.fromTime
+  _tknCreated <- readTVar s.tknCreated
+  _tknVerified <- readTVar s.tknVerified
+  _tknDeleted <- readTVar s.tknDeleted
+  _subCreated <- readTVar s.subCreated
+  _subDeleted <- readTVar s.subDeleted
+  _ntfReceived <- readTVar s.ntfReceived
+  _ntfDelivered <- readTVar s.ntfDelivered
+  _activeTokens <- getPeriodStatsData s.activeTokens
+  _activeSubs <- getPeriodStatsData s.activeSubs
  pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}

 setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> STM ()
-setNtfServerStats s@NtfServerStats {fromTime} d@NtfServerStatsData {_fromTime} = do
-  writeTVar fromTime $! _fromTime
-  writeTVar (tknCreated s) $! _tknCreated d
-  writeTVar (tknVerified s) $! _tknVerified d
-  writeTVar (tknDeleted s) $! _tknDeleted d
-  writeTVar (subCreated s) $! _subCreated d
-  writeTVar (subDeleted s) $! _subDeleted d
-  writeTVar (ntfReceived s) $! _ntfReceived d
-  writeTVar (ntfDelivered s) $! _ntfDelivered d
-  setPeriodStats (activeTokens s) (_activeTokens d)
-  setPeriodStats (activeSubs s) (_activeSubs d)
+setNtfServerStats s d = do
+  writeTVar s.fromTime $! d._fromTime
+  writeTVar s.tknCreated $! _tknCreated d
+  writeTVar s.tknVerified $! _tknVerified d
+  writeTVar s.tknDeleted $! _tknDeleted d
+  writeTVar s.subCreated $! _subCreated d
+  writeTVar s.subDeleted $! _subDeleted d
+  writeTVar s.ntfReceived $! _ntfReceived d
+  writeTVar s.ntfDelivered $! _ntfDelivered d
+  setPeriodStats s.activeTokens (_activeTokens d)
+  setPeriodStats s.activeSubs (_activeSubs d)

 instance StrEncoding NtfServerStatsData where
  strEncode NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs} =
@@ -118,8 +118,6 @@ module Simplex.Messaging.Protocol
    userProtocol,
    rcvMessageMeta,
    noMsgFlags,
-    messageId,
-    messageTs,

    -- * Parse and serialize
    ProtocolMsgTag (..),
@@ -146,7 +144,6 @@ module Simplex.Messaging.Protocol
    tEncode,
    tEncodeBatch,
    batchTransmissions,
-    batchTransmissions',

    -- * exports for tests
    CommandTag (..),
@@ -163,8 +160,6 @@ import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
-import qualified Data.ByteString.Lazy.Internal as LB
 import Data.Char (isPrint, isSpace)
 import Data.Constraint (Dict (..))
 import Data.Functor (($>))
@@ -177,8 +172,6 @@ import Data.Time.Clock.System (SystemTime (..))
 import Data.Type.Equality
 import GHC.TypeLits (ErrorMessage (..), TypeError, type (+))
 import Network.Socket (HostName, ServiceName)
-import Simplex.Messaging.Builder (Builder, char8, lazyByteString)
-import qualified Simplex.Messaging.Builder as BB
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -363,16 +356,6 @@ data Message
        msgTs :: SystemTime
      }

-messageId :: Message -> MsgId
-messageId = \case
-  Message {msgId} -> msgId
-  MessageQuota {msgId} -> msgId
-
-messageTs :: Message -> SystemTime
-messageTs = \case
-  Message {msgTs} -> msgTs
-  MessageQuota {msgTs} -> msgTs
-
 instance StrEncoding RcvMessage where
  strEncode RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} =
    B.unwords
@@ -465,14 +448,7 @@ data SMPMsgMeta = SMPMsgMeta
    msgTs :: SystemTime,
    msgFlags :: MsgFlags
  }
-  deriving (Eq, Show)
-
-instance StrEncoding SMPMsgMeta where
-  strEncode SMPMsgMeta {msgId, msgTs, msgFlags} =
-    strEncode (msgId, msgTs, msgFlags)
-  strP = do
-    (msgId, msgTs, msgFlags) <- strP
-    pure SMPMsgMeta {msgId, msgTs, msgFlags}
+  deriving (Show)

 rcvMessageMeta :: MsgId -> ClientRcvMsgBody -> SMPMsgMeta
 rcvMessageMeta msgId = \case
@@ -1227,6 +1203,9 @@ instance ProtocolEncoding ErrorType BrokerMsg where
      | B.null queueId -> Left $ CMD NO_ENTITY
      | otherwise -> Right cmd

+_smpP :: Encoding a => Parser a
+_smpP = A.space *> smpP
+
 -- | Parse SMP protocol commands and broker messages
 parseProtocol :: forall err msg. ProtocolEncoding err msg => Version -> ByteString -> Either err msg
 parseProtocol v s =
@@ -1291,13 +1270,13 @@ instance Encoding CommandError where
 tPut :: Transport c => THandle c -> Maybe Int -> NonEmpty SentRawTransmission -> IO [Either TransportError ()]
 tPut th delay_ = fmap concat . mapM tPutBatch . batchTransmissions (batch th) (blockSize th)
  where
-    tPutBatch :: TransportBatch () -> IO [Either TransportError ()]
+    tPutBatch :: TransportBatch -> IO [Either TransportError ()]
    tPutBatch = \case
-      TBLargeTransmission _ -> [Left TELargeMsg] <$ putStrLn "tPut error: large message"
-      TBTransmissions s n _ -> replicate n <$> (tPutLog th (tEncodeBatch n s) <* mapM_ threadDelay delay_)
-      TBTransmission s _ -> (: []) <$> tPutLog th s
+      TBLargeTransmission -> [Left TELargeMsg] <$ putStrLn "tPut error: large message"
+      TBTransmissions n s -> replicate n <$> (tPutLog th (tEncodeBatch n s) <* mapM_ threadDelay delay_)
+      TBTransmission s -> (: []) <$> tPutLog th s

-tPutLog :: Transport c => THandle c -> Builder -> IO (Either TransportError ())
+tPutLog :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
 tPutLog th s = do
  r <- tPutBlock th s
  case r of
@@ -1305,43 +1284,43 @@ tPutLog th s = do
    _ -> pure ()
  pure r

-- Builder in TBTransmissions does not include byte with transmissions count, it is added by tEncodeBatch
-data TransportBatch r = TBTransmissions Builder Int [r] | TBTransmission Builder r | TBLargeTransmission r
-
-batchTransmissions :: Bool -> Int -> NonEmpty SentRawTransmission -> [TransportBatch ()]
-batchTransmissions batch bSize = batchTransmissions' batch bSize . L.map (,())
+-- ByteString does not include length byte, it is added by tEncodeBatch
+data TransportBatch = TBTransmissions Int ByteString | TBTransmission ByteString | TBLargeTransmission

 -- | encodes and batches transmissions into blocks,
-batchTransmissions' :: forall r. Bool -> Int -> NonEmpty (SentRawTransmission, r) -> [TransportBatch r]
-batchTransmissions' batch bSize
-  | batch = addBatch . foldr addTransmission ([], mempty, 0, [])
-  | otherwise = map mkBatch1 . L.toList
+batchTransmissions :: Bool -> Int -> NonEmpty SentRawTransmission -> [TransportBatch]
+batchTransmissions batch bSize
+  | batch = reverse . mkBatch [] . L.map tEncode
+  | otherwise = map (mkBatch1 . tEncode) . L.toList
  where
-    mkBatch1 :: (SentRawTransmission, r) -> TransportBatch r
-    mkBatch1 (t, r)
-      -- 2 bytes are reserved for pad size
-      | BB.length s <= bSize - 2 = TBTransmission s r
-      | otherwise = TBLargeTransmission r
-      where
-        s = tEncode t
-    addTransmission :: (SentRawTransmission, r) -> ([TransportBatch r], Builder, Int, [r]) -> ([TransportBatch r], Builder, Int, [r])
-    addTransmission (t, r) acc@(bs, b, n, rs)
-      -- 3 = 2 bytes reserved for pad size + 1 for transmission count
-      | len + BB.length b <= bSize - 3 && n < 255 = (bs, s <> b, 1 + n, r : rs)
-      | len <= bSize - 3 = (addBatch acc, s, 1, [r])
-      | otherwise = (TBLargeTransmission r : addBatch acc, mempty, 0, [])
-      where
-        s = encodeLarge $ tEncode t
-        len = BB.length s
-    addBatch :: ([TransportBatch r], Builder, Int, [r]) -> [TransportBatch r]
-    addBatch (bs, b, n, rs) = if n == 0 then bs else TBTransmissions b n rs : bs
+    mkBatch :: [TransportBatch] -> NonEmpty ByteString -> [TransportBatch]
+    mkBatch rs ts =
+      let (n, s, ts_) = encodeBatch 0 "" ts
+          r = if n == 0 then TBLargeTransmission else TBTransmissions n s
+          rs' = r : rs
+       in case ts_ of
+            Just ts' -> mkBatch rs' ts'
+            _ -> rs'
+    mkBatch1 :: ByteString -> TransportBatch
+    mkBatch1 s = if B.length s > bSize - 2 then TBLargeTransmission else TBTransmission s
+    encodeBatch :: Int -> ByteString -> NonEmpty ByteString -> (Int, ByteString, Maybe (NonEmpty ByteString))
+    encodeBatch n s ts@(t :| ts_)
+      | n == 255 = (n, s, Just ts)
+      | otherwise =
+          let s' = s <> smpEncode (Large t)
+              n' = n + 1
+           in if B.length s' > bSize - 3 -- one byte is reserved for the number of messages in the batch
+                then (n,s,) $ if n == 0 then L.nonEmpty ts_ else Just ts
+                else case L.nonEmpty ts_ of
+                  Just ts' -> encodeBatch n' s' ts'
+                  _ -> (n', s', Nothing)

-tEncode :: SentRawTransmission -> Builder
-tEncode (sig, t) = lazyByteString $ LB.chunk (smpEncode $ C.signatureBytes sig) (LB.fromStrict t)
+tEncode :: SentRawTransmission -> ByteString
+tEncode (sig, t) = smpEncode (C.signatureBytes sig) <> t
 {-# INLINE tEncode #-}

-tEncodeBatch :: Int -> Builder -> Builder
-tEncodeBatch n s = char8 (lenEncode n) <> s
+tEncodeBatch :: Int -> ByteString -> ByteString
+tEncodeBatch n s = lenEncode n `B.cons` s
 {-# INLINE tEncodeBatch #-}

 encodeTransmission :: ProtocolEncoding e c => Version -> ByteString -> Transmission c -> ByteString
@@ -1,5 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -9,6 +7,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -50,16 +49,18 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (intercalate)
+import Data.List (intercalate, sort)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (isNothing)
+import Data.Maybe (fromMaybe, isNothing)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Type.Equality
+import GHC.Conc (listThreads, threadStatus)
+import GHC.Conc.Sync (threadLabel)
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
@@ -84,20 +85,13 @@ import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
 import System.Exit (exitFailure)
-import System.IO (hPrint, hPutStrLn, hSetNewlineMode, universalNewlineMode)
+import System.IO (hPutStrLn, hSetNewlineMode, universalNewlineMode)
 import System.Mem.Weak (deRefWeak)
-import UnliftIO (timeout)
 import UnliftIO.Concurrent
 import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
 import UnliftIO.IO
 import UnliftIO.STM
-#if MIN_VERSION_base(4,18,0)
-import Data.List (sort)
-import Data.Maybe (fromMaybe)
-import GHC.Conc (listThreads, threadStatus)
-import GHC.Conc.Sync (threadLabel)
-#endif

 -- | Runs an SMP server using passed configuration.
 --
@@ -119,8 +113,8 @@ type M a = ReaderT Env IO a
 smpServer :: TMVar Bool -> ServerConfig -> M ()
 smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
  s <- asks server
-  expired <- restoreServerMessages
-  restoreServerStats expired
+  restoreServerMessages
+  restoreServerStats
  raceAny_
    ( serverThread s "server subscribedQ" subscribedQ subscribers subscriptions cancelSub
        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubscriptions (\_ -> pure ())
@@ -131,8 +125,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
    runServer :: (ServiceName, ATransport) -> M ()
    runServer (tcpPort, ATransport t) = do
      serverParams <- asks tlsServerParams
-      ss <- asks sockets
-      runTransportServerState ss started tcpPort serverParams tCfg (runClient t)
+      runTransportServer started tcpPort serverParams tCfg (runClient t)

    saveServer :: Bool -> M ()
    saveServer keepMsgs = withLog closeStoreLog >> saveServerMessages keepMsgs >> saveServerStats
@@ -146,12 +139,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      (Client -> TMap QueueId s) ->
      (s -> IO ()) ->
      M ()
-    serverThread s label subQ subs clientSubs unsub = do
+    serverThread s label subQ subs clientSubs unsub = forever $ do
      labelMyThread label
-      forever $
-        atomically updateSubscribers
-          $>>= endPreviousSubscriptions
-          >>= liftIO . mapM_ unsub
+      atomically updateSubscribers
+        $>>= endPreviousSubscriptions
+        >>= liftIO . mapM_ unsub
      where
        updateSubscribers :: STM (Maybe (QueueId, Client))
        updateSubscribers = do
@@ -165,9 +157,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
          TM.lookupInsert qId clnt (subs s) $>>= clientToBeNotified
        endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
        endPreviousSubscriptions (qId, c) = do
-          void . forkIO $ do
-            labelMyThread $ label <> ".endPreviousSubscriptions"
-            atomically $ writeTBQueue (sndQ c) [(CorrId "", qId, END)]
+          labelMyThread $ label <> ".endPreviousSubscriptions"
+          void . forkIO . atomically $
+            writeTBQueue (sndQ c) [(CorrId "", qId, END)]
          atomically $ TM.lookupDelete qId (clientSubs c)

    expireMessagesThread_ :: ServerConfig -> [M ()]
@@ -179,16 +171,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      ms <- asks msgStore
      quota <- asks $ msgQueueQuota . config
      let interval = checkInterval expCfg * 1000000
-      stats <- asks serverStats
      labelMyThread "expireMessages"
      forever $ do
        liftIO $ threadDelay' interval
        old <- liftIO $ expireBeforeEpoch expCfg
        rIds <- M.keysSet <$> readTVarIO ms
-        forM_ rIds $ \rId -> do
-          q <- atomically (getMsgQueue ms rId quota)
-          deleted <- atomically $ deleteExpiredMsgs q old
-          atomically $ modifyTVar' (msgExpired stats) (+ deleted)
+        forM_ rIds $ \rId ->
+          atomically (getMsgQueue ms rId quota)
+            >>= atomically . (`deleteExpiredMsgs` old)

    serverStatsThread_ :: ServerConfig -> [M ()]
    serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
@@ -201,7 +191,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
      initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
      liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
      liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
-      ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount} <- asks serverStats
+      ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount} <- asks serverStats
      let interval = 1000000 * logInterval
      withFile statsFilePath AppendMode $ \h -> liftIO $ do
        hSetBuffering h LineBuffering
@@ -213,7 +203,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
          qDeleted' <- atomically $ swapTVar qDeleted 0
          msgSent' <- atomically $ swapTVar msgSent 0
          msgRecv' <- atomically $ swapTVar msgRecv 0
-          msgExpired' <- atomically $ swapTVar msgExpired 0
          ps <- atomically $ periodStatCounts activeQueues ts
          msgSentNtf' <- atomically $ swapTVar msgSentNtf 0
          msgRecvNtf' <- atomically $ swapTVar msgRecvNtf 0
@@ -238,19 +227,18 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                weekCount psNtf,
                monthCount psNtf,
                show qCount',
-                show msgCount',
-                show msgExpired'
+                show msgCount'
              ]
          threadDelay' interval

    runClient :: Transport c => TProxy c -> c -> M ()
    runClient tp h = do
      kh <- asks serverIdentity
-      ServerConfig {smpServerVRange, smpHandshakeTimeout} <- asks config
+      smpVRange <- asks $ smpServerVRange . config
      labelMyThread $ "smp handshake for " <> transportName tp
-      liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake h kh smpServerVRange) >>= \case
-        Just (Right th) -> runClientTransport th
-        _ -> pure ()
+      liftIO (runExceptT $ smpServerHandshake h kh smpVRange) >>= \case
+        Right th -> runClientTransport th
+        Left _ -> pure ()

    controlPortThread_ :: ServerConfig -> [M ()]
    controlPortThread_ ServerConfig {controlPort = Just port} = [runCPServer port]
@@ -284,16 +272,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
              CPSuspend -> hPutStrLn h "suspend not implemented"
              CPResume -> hPutStrLn h "resume not implemented"
              CPClients -> do
-                active <- unliftIO u (asks clients) >>= readTVarIO
-                hPutStrLn h $ "clientId,sessionId,connected,createdAt,rcvActiveAt,sndActiveAt,age,subscriptions"
-                forM_ (M.toList active) $ \(cid, Client {sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, subscriptions}) -> do
-                  connected' <- bshow <$> readTVarIO connected
-                  rcvActiveAt' <- strEncode <$> readTVarIO rcvActiveAt
-                  sndActiveAt' <- strEncode <$> readTVarIO sndActiveAt
-                  now <- liftIO getSystemTime
-                  let age = systemSeconds now - systemSeconds createdAt
-                  subscriptions' <- bshow . M.size <$> readTVarIO subscriptions
-                  hPutStrLn h . B.unpack $ B.intercalate "," [bshow cid, encode sessionId, connected', strEncode createdAt, rcvActiveAt', sndActiveAt', bshow age, subscriptions']
+                Server {subscribers} <- unliftIO u $ asks server
+                clients <- readTVarIO subscribers
+                hPutStrLn h $ "Clients: " <> show (length clients)
+                forM_ (M.toList clients) $ \(cid, Client {sessionId, connected, activeAt, subscriptions}) -> do
+                  hPutStrLn h . B.unpack $ "Client " <> encode cid <> " $" <> encode sessionId
+                  readTVarIO connected >>= hPutStrLn h . ("  connected: " <>) . show
+                  readTVarIO activeAt >>= hPutStrLn h . ("  activeAt: " <>) . B.unpack . strEncode
+                  readTVarIO subscriptions >>= hPutStrLn h . ("  subscriptions: " <>) . show . M.size
              CPStats -> do
                ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, msgSentNtf, msgRecvNtf, qCount, msgCount} <- unliftIO u $ asks serverStats
                putStat "fromTime" fromTime
@@ -309,62 +295,19 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                where
                  putStat :: Show a => String -> TVar a -> IO ()
                  putStat label var = readTVarIO var >>= \v -> hPutStrLn h $ label <> ": " <> show v
-              CPStatsRTS -> getRTSStats >>= hPrint h
+              CPStatsRTS -> getRTSStats >>= hPutStrLn h . show
              CPThreads -> do
-#if MIN_VERSION_base(4,18,0)
                threads <- liftIO listThreads
                hPutStrLn h $ "Threads: " <> show (length threads)
                forM_ (sort threads) $ \tid -> do
                  label <- threadLabel tid
                  status <- threadStatus tid
                  hPutStrLn h $ show tid <> " (" <> show status <> ") " <> fromMaybe "" label
-#else
-                hPutStrLn h "Not available on GHC 8.10"
-#endif
-              CPSockets -> do
-                (accepted', closed', active') <- unliftIO u $ asks sockets
-                (accepted, closed, active) <- atomically $ (,,) <$> readTVar accepted' <*> readTVar closed' <*> readTVar active'
-                hPutStrLn h "Sockets: "
-                hPutStrLn h $ "accepted: " <> show accepted
-                hPutStrLn h $ "closed: " <> show closed
-                hPutStrLn h $ "active: " <> show (M.size active)
-                hPutStrLn h $ "leaked: " <> show (accepted - closed - M.size active)
-              CPSocketThreads -> do
-#if MIN_VERSION_base(4,18,0)
-                (_, _, active') <- unliftIO u $ asks sockets
-                active <- readTVarIO active'
-                forM_ (M.toList active) $ \(sid, tid') ->
-                  deRefWeak tid' >>= \case
-                    Nothing -> hPutStrLn h $ intercalate "," [show sid, "", "gone", ""]
-                    Just tid -> do
-                      label <- threadLabel tid
-                      status <- threadStatus tid
-                      hPutStrLn h $ intercalate "," [show sid, show tid, show status, fromMaybe "" label]
-#else
-                hPutStrLn h "Not available on GHC 8.10"
-#endif
-              CPDelete queueId' -> unliftIO u $ do
-                st <- asks queueStore
-                ms <- asks msgStore
-                stats <- asks serverStats
-                queueId <- atomically (getQueue st SSender queueId') >>= \case
-                  Left _ -> pure queueId' -- fallback to using as recipientId directly
-                  Right QueueRec {recipientId} -> pure recipientId
-                r <- atomically $
-                  deleteQueue st queueId $>>= \() ->
-                    Right <$> delMsgQueueSize ms queueId
-                case r of
-                  Left e -> liftIO . hPutStrLn h $ "error: " <> show e
-                  Right numDeleted -> do
-                    withLog (`logDeleteQueue` queueId)
-                    atomically $ modifyTVar' (qDeleted stats) (+ 1)
-                    atomically $ modifyTVar' (qCount stats) (subtract 1)
-                    liftIO . hPutStrLn h $ "ok, " <> show numDeleted <> " messages deleted"
              CPSave -> withLock (savingLock srv) "control" $ do
                hPutStrLn h "saving server state..."
                unliftIO u $ saveServer True
                hPutStrLn h "server state saved!"
-              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, sockets, socket-threads, threads, delete, save, help, quit"
+              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, threads, save, help, quit"
              CPQuit -> pure ()
              CPSkip -> pure ()

@@ -372,32 +315,24 @@ runClientTransport :: Transport c => THandle c -> M ()
 runClientTransport th@THandle {thVersion, sessionId} = do
  q <- asks $ tbqSize . config
  ts <- liftIO getSystemTime
-  active <- asks clients
-  nextClientId <- asks clientSeq
-  c <- atomically $ do
-    new@Client {clientId} <- newClient nextClientId q thVersion sessionId ts
-    TM.insert clientId new active
-    pure new
+  c <- atomically $ newClient q thVersion sessionId ts
  s <- asks server
  expCfg <- asks $ inactiveClientExpiration . config
-  labelMyThread . B.unpack $ "client $" <> encode sessionId
+  labelMyThread . B.unpack $ "client $" <> encode c.sessionId
  raceAny_ ([liftIO $ send th c, client c s, receive th c] <> disconnectThread_ c expCfg)
    `finally` clientDisconnected c
  where
-    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport th (rcvActiveAt c) (sndActiveAt c) expCfg (noSubscriptions c)]
+    disconnectThread_ c (Just expCfg) = [liftIO $ disconnectTransport th c activeAt expCfg]
    disconnectThread_ _ _ = []
-    noSubscriptions c = atomically $ (&&) <$> TM.null (subscriptions c) <*> TM.null (ntfSubscriptions c)

 clientDisconnected :: Client -> M ()
-clientDisconnected c@Client {clientId, subscriptions, connected, sessionId} = do
-  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"
+clientDisconnected c@Client {subscriptions, connected} = do
  atomically $ writeTVar connected False
  subs <- readTVarIO subscriptions
  liftIO $ mapM_ cancelSub subs
  atomically $ writeTVar subscriptions M.empty
  cs <- asks $ subscribers . server
  atomically . mapM_ (\rId -> TM.update deleteCurrentClient rId cs) $ M.keys subs
-  asks clients >>= atomically . TM.delete clientId
  where
    deleteCurrentClient :: Client -> Maybe Client
    deleteCurrentClient c'
@@ -414,11 +349,11 @@ cancelSub sub =
    _ -> return ()

 receive :: Transport c => THandle c -> Client -> M ()
-receive th Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
+receive th Client {rcvQ, sndQ, activeAt, sessionId} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
  forever $ do
    ts <- L.toList <$> liftIO (tGet th)
-    atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
+    atomically . writeTVar activeAt =<< liftIO getSystemTime
    as <- partitionEithers <$> mapM cmdAction ts
    write sndQ $ fst as
    write rcvQ $ snd as
@@ -435,12 +370,12 @@ receive th Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty

 send :: Transport c => THandle c -> Client -> IO ()
-send h@THandle {thVersion = v} Client {sndQ, sessionId, sndActiveAt} = do
+send h@THandle {thVersion = v} Client {sndQ, sessionId, activeAt} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
  forever $ do
    ts <- atomically $ L.sortWith tOrder <$> readTBQueue sndQ
    void . liftIO . tPut h Nothing $ L.map ((Nothing,) . encodeTransmission v sessionId) ts
-    atomically . writeTVar sndActiveAt =<< liftIO getSystemTime
+    atomically . writeTVar activeAt =<< liftIO getSystemTime
  where
    tOrder :: Transmission BrokerMsg -> Int
    tOrder (_, _, cmd) = case cmd of
@@ -448,18 +383,15 @@ send h@THandle {thVersion = v} Client {sndQ, sessionId, sndActiveAt} = do
      NMSG {} -> 0
      _ -> 1

-disconnectTransport :: Transport c => THandle c -> TVar SystemTime -> TVar SystemTime -> ExpirationConfig -> IO Bool -> IO ()
-disconnectTransport THandle {connection, sessionId} rcvActiveAt sndActiveAt expCfg noSubscriptions = do
+disconnectTransport :: Transport c => THandle c -> client -> (client -> TVar SystemTime) -> ExpirationConfig -> IO ()
+disconnectTransport THandle {connection, sessionId} c activeAt expCfg = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disconnectTransport"
-  loop
-  where
-    loop = do
-      threadDelay' $ checkInterval expCfg * 1000000
-      ifM noSubscriptions checkExpired loop
-    checkExpired = do
-      old <- expireBeforeEpoch expCfg
-      ts <- max <$> readTVarIO rcvActiveAt <*> readTVarIO sndActiveAt
-      if systemSeconds ts < old then closeConnection connection else loop
+  let interval = checkInterval expCfg * 1000000
+  forever . liftIO $ do
+    threadDelay' interval
+    old <- expireBeforeEpoch expCfg
+    ts <- readTVarIO $ activeAt c
+    when (systemSeconds ts < old) $ closeConnection connection

 data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed

@@ -509,8 +441,8 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
 dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"

 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
-  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
+client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
+  labelMyThread . B.unpack $ "client $" <> encode clnt.sessionId <> " commands"
  forever $
    atomically (readTBQueue rcvQ)
      >>= mapM processCommand
@@ -547,7 +479,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess
      where
        createQueue :: QueueStore -> RcvPublicVerifyKey -> RcvPublicDhKey -> SubscriptionMode -> m (Transmission BrokerMsg)
        createQueue st recipientKey dhKey subMode = time "NEW" $ do
-          (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
+          (rcvPublicDhKey, privDhKey) <- liftIO C.generateKeyPair'
          let rcvDhSecret = C.dh' dhKey privDhKey
              qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey}
              qRec (recipientId, senderId) =
@@ -602,7 +534,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess

        addQueueNotifier_ :: QueueStore -> NtfPublicVerifyKey -> RcvNtfPublicDhKey -> m (Transmission BrokerMsg)
        addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
-          (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
+          (rcvPublicDhKey, privDhKey) <- liftIO C.generateKeyPair'
          let rcvNtfDhSecret = C.dh' dhKey privDhKey
          (corrId,queueId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
          where
@@ -748,7 +680,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess
                      Just msg -> time "SEND ok" $ do
                        stats <- asks serverStats
                        when (notification msgFlags) $ do
-                          atomically . trySendNotification msg =<< asks random
+                          atomically . trySendNotification msg =<< asks idsDrg
                          atomically $ modifyTVar' (msgSentNtf stats) (+ 1)
                          atomically $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                        atomically $ modifyTVar' (msgSent stats) (+ 1)
@@ -766,9 +698,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess
            expireMessages q = do
              msgExp <- asks $ messageExpiration . config
              old <- liftIO $ mapM expireBeforeEpoch msgExp
-              stats <- asks serverStats
-              deleted <- atomically $ sum <$> mapM (deleteExpiredMsgs q) old
-              atomically $ modifyTVar' (msgExpired stats) (+ deleted)
+              atomically $ mapM_ (deleteExpiredMsgs q) old

            trySendNotification :: Message -> TVar ChaChaDRG -> STM ()
            trySendNotification msg ntfNonceDrg =
@@ -785,7 +715,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess

            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> TVar ChaChaDRG -> STM (C.CbNonce, EncNMsgMeta)
            mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg = do
-              cbNonce <- C.randomCbNonce ntfNonceDrg
+              cbNonce <- C.pseudoRandomCbNonce ntfNonceDrg
              let msgMeta = NMsgMeta {msgId, msgTs}
                  encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
              pure . (cbNonce,) $ fromRight "" encNMsgMeta
@@ -810,7 +740,6 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess
                s -> s
              where
                subscriber = do
-                  labelMyThread $ B.unpack ("client $" <> encode sessionId) <> " subscriber/" <> T.unpack name
                  msg <- atomically $ peekMsg q
                  time "subscriber" . atomically $ do
                    let encMsg = encryptMsg qr msg
@@ -834,11 +763,11 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sess
            encrypt msgFlags body =
              let encBody = EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body
               in RcvMessage msgId' msgTs' msgFlags encBody
-            msgId' = messageId msg
-            msgTs' = messageTs msg
+            msgId' = msg.msgId
+            msgTs' = msg.msgTs

        setDelivered :: Sub -> Message -> STM Bool
-        setDelivered s msg = tryPutTMVar (delivered s) (messageId msg)
+        setDelivered s msg = tryPutTMVar (delivered s) msg.msgId

        getStoreMsgQueue :: T.Text -> RecipientId -> m MsgQueue
        getStoreMsgQueue name rId = time (name <> " getMsgQueue") $ do
@@ -885,7 +814,9 @@ timed name qId a = do
    sec = 1000_000000

 randomId :: (MonadUnliftIO m, MonadReader Env m) => Int -> m ByteString
-randomId n = atomically . C.randomBytes n =<< asks random
+randomId n = do
+  gVar <- asks idsDrg
+  atomically (C.pseudoRandomBytes n gVar)

 saveServerMessages :: (MonadUnliftIO m, MonadReader Env m) => Bool -> m ()
 saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessages
@@ -902,27 +833,24 @@ saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessag
          atomically (getMessages ms rId)
            >>= mapM_ (B.hPutStrLn h . strEncode . MLRv3 rId)

-restoreServerMessages :: forall m. (MonadUnliftIO m, MonadReader Env m) => m Int
-restoreServerMessages = asks (storeMsgsFile . config) >>= \case
-  Just f -> ifM (doesFileExist f) (restoreMessages f) (pure 0)
-  Nothing -> pure 0
+restoreServerMessages :: forall m. (MonadUnliftIO m, MonadReader Env m) => m ()
+restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
  where
-    restoreMessages f = do
+    restoreMessages f = whenM (doesFileExist f) $ do
      logInfo $ "restoring messages from file " <> T.pack f
      st <- asks queueStore
      ms <- asks msgStore
      quota <- asks $ msgQueueQuota . config
      old_ <- asks (messageExpiration . config) $>>= (liftIO . fmap Just . expireBeforeEpoch)
-      runExceptT (liftIO (B.readFile f) >>= foldM (\expired -> restoreMsg expired st ms quota old_) 0 . B.lines) >>= \case
+      runExceptT (liftIO (B.readFile f) >>= mapM_ (restoreMsg st ms quota old_) . B.lines) >>= \case
        Left e -> do
          logError . T.pack $ "error restoring messages: " <> e
          liftIO exitFailure
-        Right expired -> do
+        _ -> do
          renameFile f $ f <> ".bak"
          logInfo "messages restored"
-          pure expired
      where
-        restoreMsg !expired st ms quota old_ s = do
+        restoreMsg st ms quota old_ s = do
          r <- liftEither . first (msgErr "parsing") $ strDecode s
          case r of
            MLRv3 rId msg -> addToMsgQueue rId msg
@@ -932,15 +860,14 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= \case
              addToMsgQueue rId msg'
          where
            addToMsgQueue rId msg = do
-              (isExpired, logFull) <- atomically $ do
+              logFull <- atomically $ do
                q <- getMsgQueue ms rId quota
                case msg of
                  Message {msgTs}
-                    | maybe True (systemSeconds msgTs >=) old_ -> (False,) . isNothing <$> writeMsg q msg
-                    | otherwise -> pure (True, False)
-                  MessageQuota {} -> writeMsg q msg $> (False, False)
-              when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
-              pure $ if isExpired then expired + 1 else expired
+                    | maybe True (systemSeconds msgTs >=) old_ -> isNothing <$> writeMsg q msg
+                    | otherwise -> pure False
+                  MessageQuota {} -> writeMsg q msg $> False
+              when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode msg.msgId
            updateMsgV1toV3 QueueRec {rcvDhSecret} RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = do
              let nonce = C.cbNonce msgId
              msgBody <- liftEither . first (msgErr "v1 message decryption") $ C.maxLenBS =<< C.cbDecrypt rcvDhSecret nonce body
@@ -958,21 +885,19 @@ saveServerStats =
      B.writeFile f $ strEncode stats
      logInfo "server stats saved"

-restoreServerStats :: (MonadUnliftIO m, MonadReader Env m) => Int -> m ()
-restoreServerStats expiredWhileRestoring = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
+restoreServerStats :: (MonadUnliftIO m, MonadReader Env m) => m ()
+restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
  where
    restoreStats f = whenM (doesFileExist f) $ do
      logInfo $ "restoring server stats from file " <> T.pack f
      liftIO (strDecode <$> B.readFile f) >>= \case
-        Right d@ServerStatsData {_qCount = statsQCount} -> do
+        Right d -> do
          s <- asks serverStats
-          _qCount <- fmap M.size . readTVarIO . queues =<< asks queueStore
-          _msgCount <- foldM (\(!n) q -> (n +) <$> readTVarIO (size q)) 0 =<< readTVarIO =<< asks msgStore
-          atomically $ setServerStats s d {_qCount, _msgCount, _msgExpired = _msgExpired d + expiredWhileRestoring}
+          _qCount <- fmap (length . M.keys) . readTVarIO . queues =<< asks queueStore
+          _msgCount <- foldM (\n q -> (n +) <$> readTVarIO (size q)) 0 =<< readTVarIO =<< asks msgStore
+          atomically $ setServerStats s d {_qCount, _msgCount}
          renameFile f $ f <> ".bak"
          logInfo "server stats restored"
-          when (_qCount /= statsQCount) $ logWarn $ "Queue count differs: stats: " <> tshow statsQCount <> ", store: " <> tshow _qCount
-          logInfo $ "Restored " <> tshow _msgCount <> " messages in " <> tshow _qCount <> " queues"
        Left e -> do
          logInfo $ "error restoring server stats: " <> T.pack e
          liftIO exitFailure
@@ -4,7 +4,6 @@
 module Simplex.Messaging.Server.Control where

 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
 import Simplex.Messaging.Encoding.String

 data ControlProtocol
@@ -14,9 +13,6 @@ data ControlProtocol
  | CPStats
  | CPStatsRTS
  | CPThreads
-  | CPSockets
-  | CPSocketThreads
-  | CPDelete ByteString
  | CPSave
  | CPHelp
  | CPQuit
@@ -30,9 +26,6 @@ instance StrEncoding ControlProtocol where
    CPStats -> "stats"
    CPStatsRTS -> "stats-rts"
    CPThreads -> "threads"
-    CPSockets -> "sockets"
-    CPSocketThreads -> "socket-threads"
-    CPDelete bs -> "delete " <> strEncode bs
    CPSave -> "save"
    CPHelp -> "help"
    CPQuit -> "quit"
@@ -45,9 +38,6 @@ instance StrEncoding ControlProtocol where
      "stats" -> pure CPStats
      "stats-rts" -> pure CPStatsRTS
      "threads" -> pure CPThreads
-      "sockets" -> pure CPSockets
-      "socket-threads" -> pure CPSocketThreads
-      "delete" -> CPDelete <$> (A.space *> strP)
      "save" -> pure CPSave
      "help" -> pure CPHelp
      "quit" -> pure CPQuit
@@ -21,7 +21,6 @@ import qualified Network.TLS as T
 import Numeric.Natural
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Crypto (KeyHash (..))
-import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore.STM
@@ -32,7 +31,7 @@ import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport)
-import Simplex.Messaging.Transport.Server (SocketState, TransportServerConfig, loadFingerprint, loadTLSServerParams, newSocketState)
+import Simplex.Messaging.Transport.Server (TransportServerConfig, loadFingerprint, loadTLSServerParams)
 import Simplex.Messaging.Version
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
@@ -40,7 +39,6 @@ import UnliftIO.STM

 data ServerConfig = ServerConfig
  { transports :: [(ServiceName, ATransport)],
-    smpHandshakeTimeout :: Int,
    tbqSize :: Natural,
    -- serverTbqSize :: Natural,
    msgQueueQuota :: Int,
@@ -91,8 +89,8 @@ defaultMessageExpiration =
 defaultInactiveClientExpiration :: ExpirationConfig
 defaultInactiveClientExpiration =
  ExpirationConfig
-    { ttl = 43200, -- seconds, 12 hours
-      checkInterval = 3600 -- seconds, 1 hours
+    { ttl = 86400, -- seconds, 24 hours
+      checkInterval = 43200 -- seconds, 12 hours
    }

 data Env = Env
@@ -101,13 +99,10 @@ data Env = Env
    serverIdentity :: KeyHash,
    queueStore :: QueueStore,
    msgStore :: STMMsgStore,
-    random :: TVar ChaChaDRG,
+    idsDrg :: TVar ChaChaDRG,
    storeLog :: Maybe (StoreLog 'WriteMode),
    tlsServerParams :: T.ServerParams,
-    serverStats :: ServerStats,
-    sockets :: SocketState,
-    clientSeq :: TVar Int,
-    clients :: TMap Int Client
+    serverStats :: ServerStats
  }

 data Server = Server
@@ -119,17 +114,14 @@ data Server = Server
  }

 data Client = Client
-  { clientId :: Int,
-    subscriptions :: TMap RecipientId (TVar Sub),
+  { subscriptions :: TMap RecipientId (TVar Sub),
    ntfSubscriptions :: TMap NotifierId (),
    rcvQ :: TBQueue (NonEmpty (Maybe QueueRec, Transmission Cmd)),
    sndQ :: TBQueue (NonEmpty (Transmission BrokerMsg)),
    thVersion :: Version,
    sessionId :: ByteString,
    connected :: TVar Bool,
-    createdAt :: SystemTime,
-    rcvActiveAt :: TVar SystemTime,
-    sndActiveAt :: TVar SystemTime
+    activeAt :: TVar SystemTime
  }

 data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId) | ProhibitSub
@@ -148,17 +140,15 @@ newServer = do
  savingLock <- createLock
  return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, savingLock}

-newClient :: TVar Int -> Natural -> Version -> ByteString -> SystemTime -> STM Client
-newClient nextClientId qSize thVersion sessionId createdAt = do
-  clientId <- stateTVar nextClientId $ \next -> (next, next + 1)
+newClient :: Natural -> Version -> ByteString -> SystemTime -> STM Client
+newClient qSize thVersion sessionId ts = do
  subscriptions <- TM.empty
  ntfSubscriptions <- TM.empty
  rcvQ <- newTBQueue qSize
  sndQ <- newTBQueue qSize
  connected <- newTVar True
-  rcvActiveAt <- newTVar createdAt
-  sndActiveAt <- newTVar createdAt
-  return Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, thVersion, sessionId, connected, createdAt, rcvActiveAt, sndActiveAt}
+  activeAt <- newTVar ts
+  return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, thVersion, sessionId, connected, activeAt}

 newSubscription :: SubscriptionThread -> STM Sub
 newSubscription subThread = do
@@ -170,16 +160,13 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
  server <- atomically newServer
  queueStore <- atomically newQueueStore
  msgStore <- atomically newMsgStore
-  random <- liftIO C.newRandom
+  idsDrg <- drgNew >>= newTVarIO
  storeLog <- restoreQueues queueStore `mapM` storeLogFile
  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
  let serverIdentity = KeyHash fp
  serverStats <- atomically . newServerStats =<< liftIO getCurrentTime
-  sockets <- atomically newSocketState
-  clientSeq <- newTVarIO 0
-  clients <- atomically TM.empty
-  return Env {config, server, serverIdentity, queueStore, msgStore, random, storeLog, tlsServerParams, serverStats, sockets, clientSeq, clients}
+  return Env {config, server, serverIdentity, queueStore, msgStore, idsDrg, storeLog, tlsServerParams, serverStats}
  where
    restoreQueues :: QueueStore -> FilePath -> m (StoreLog 'WriteMode)
    restoreQueues QueueStore {queues, senders, notifiers} f = do
@@ -8,8 +8,8 @@

 module Simplex.Messaging.Server.Main where

-import Control.Concurrent.STM
 import Control.Monad (void)
+import Crypto.Random (getRandomBytes)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
@@ -95,7 +95,7 @@ smpServerCLI cfgPath logPath =
          where
            createServerPassword = \case
              ServerPassword s -> pure s
-              SPRandom -> BasicAuth . strEncode <$> (atomically . C.randomBytes 32 =<< C.newRandom)
+              SPRandom -> BasicAuth . strEncode <$> (getRandomBytes 32 :: IO B.ByteString)
            iniFileContent host basicAuth =
              "[STORE_LOG]\n\
              \# The server uses STM memory for persistence,\n\
@@ -165,7 +165,6 @@ smpServerCLI cfgPath logPath =
        serverConfig =
          ServerConfig
            { transports = iniTransports ini,
-              smpHandshakeTimeout = 120000000,
              tbqSize = 64,
              -- serverTbqSize = 1024,
              msgQueueQuota = 128,
@@ -12,7 +12,6 @@ module Simplex.Messaging.Server.MsgStore.STM
    newMsgStore,
    getMsgQueue,
    delMsgQueue,
-    delMsgQueueSize,
    flushMsgQueue,
    snapshotMsgQueue,
    writeMsg,
@@ -25,6 +24,7 @@ module Simplex.Messaging.Server.MsgStore.STM
 where

 import Control.Concurrent.STM.TQueue (flushTQueue)
+import Control.Monad (when)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -60,9 +60,6 @@ getMsgQueue st rId quota = maybe newQ pure =<< TM.lookup rId st
 delMsgQueue :: STMMsgStore -> RecipientId -> STM ()
 delMsgQueue st rId = TM.delete rId st

-delMsgQueueSize :: STMMsgStore -> RecipientId -> STM Int
-delMsgQueueSize st rId = TM.lookupDelete rId st >>= maybe (pure 0) (\MsgQueue {size} -> readTVar size)
-
 flushMsgQueue :: STMMsgStore -> RecipientId -> STM [Message]
 flushMsgQueue st rId = TM.lookupDelete rId st >>= maybe (pure []) (flushTQueue . msgQueue)

@@ -115,15 +112,15 @@ tryDelPeekMsg mq msgId' =
      | otherwise -> pure (Nothing, msg_)
    _ -> pure (Nothing, Nothing)

-deleteExpiredMsgs :: MsgQueue -> Int64 -> STM Int
-deleteExpiredMsgs mq old = loop 0
+deleteExpiredMsgs :: MsgQueue -> Int64 -> STM ()
+deleteExpiredMsgs mq old = loop
  where
-    loop dc =
-      tryPeekMsg mq >>= \case
-        Just Message {msgTs}
-          | systemSeconds msgTs < old ->
-              tryDeleteMsg mq >> loop (dc + 1)
-        _ -> pure dc
+    loop = tryPeekMsg mq >>= mapM_ delOldMsg
+    delOldMsg = \case
+      Message {msgTs} ->
+        when (systemSeconds msgTs < old) $
+          tryDeleteMsg mq >> loop
+      _ -> pure ()

 tryDeleteMsg :: MsgQueue -> STM ()
 tryDeleteMsg MsgQueue {msgQueue = q, size} =
@@ -11,7 +11,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.Set (Set)
 import qualified Data.Set as S
-import Data.Time.Calendar.Month (pattern MonthDay)
+import Data.Time.Calendar.Month.Compat (pattern MonthDay)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
 import Simplex.Messaging.Encoding.String
@@ -25,7 +25,6 @@ data ServerStats = ServerStats
    qDeleted :: TVar Int,
    msgSent :: TVar Int,
    msgRecv :: TVar Int,
-    msgExpired :: TVar Int,
    activeQueues :: PeriodStats RecipientId,
    msgSentNtf :: TVar Int,
    msgRecvNtf :: TVar Int,
@@ -41,7 +40,6 @@ data ServerStatsData = ServerStatsData
    _qDeleted :: Int,
    _msgSent :: Int,
    _msgRecv :: Int,
-    _msgExpired :: Int,
    _activeQueues :: PeriodStatsData RecipientId,
    _msgSentNtf :: Int,
    _msgRecvNtf :: Int,
@@ -59,14 +57,13 @@ newServerStats ts = do
  qDeleted <- newTVar 0
  msgSent <- newTVar 0
  msgRecv <- newTVar 0
-  msgExpired <- newTVar 0
  activeQueues <- newPeriodStats
  msgSentNtf <- newTVar 0
  msgRecvNtf <- newTVar 0
  activeQueuesNtf <- newPeriodStats
  qCount <- newTVar 0
  msgCount <- newTVar 0
-  pure ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount}
+  pure ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount}

 getServerStatsData :: ServerStats -> STM ServerStatsData
 getServerStatsData s = do
@@ -76,14 +73,13 @@ getServerStatsData s = do
  _qDeleted <- readTVar $ qDeleted s
  _msgSent <- readTVar $ msgSent s
  _msgRecv <- readTVar $ msgRecv s
-  _msgExpired <- readTVar $ msgExpired s
  _activeQueues <- getPeriodStatsData $ activeQueues s
  _msgSentNtf <- readTVar $ msgSentNtf s
  _msgRecvNtf <- readTVar $ msgRecvNtf s
  _activeQueuesNtf <- getPeriodStatsData $ activeQueuesNtf s
  _qCount <- readTVar $ qCount s
  _msgCount <- readTVar $ msgCount s
-  pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _msgExpired, _activeQueues, _msgSentNtf, _msgRecvNtf, _activeQueuesNtf, _qCount, _msgCount}
+  pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _activeQueues, _msgSentNtf, _msgRecvNtf, _activeQueuesNtf, _qCount, _msgCount}

 setServerStats :: ServerStats -> ServerStatsData -> STM ()
 setServerStats s d = do
@@ -93,7 +89,6 @@ setServerStats s d = do
  writeTVar (qDeleted s) $! _qDeleted d
  writeTVar (msgSent s) $! _msgSent d
  writeTVar (msgRecv s) $! _msgRecv d
-  writeTVar (msgExpired s) $! _msgExpired d
  setPeriodStats (activeQueues s) (_activeQueues d)
  writeTVar (msgSentNtf s) $! _msgSentNtf d
  writeTVar (msgRecvNtf s) $! _msgRecvNtf d
@@ -102,16 +97,14 @@ setServerStats s d = do
  writeTVar (msgCount s) $! _msgCount d

 instance StrEncoding ServerStatsData where
-  strEncode ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _msgExpired, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf, _qCount, _msgCount} =
+  strEncode ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf} =
    B.unlines
      [ "fromTime=" <> strEncode _fromTime,
        "qCreated=" <> strEncode _qCreated,
        "qSecured=" <> strEncode _qSecured,
        "qDeleted=" <> strEncode _qDeleted,
-        "qCount=" <> strEncode _qCount,
        "msgSent=" <> strEncode _msgSent,
        "msgRecv=" <> strEncode _msgRecv,
-        "msgExpired=" <> strEncode _msgExpired,
        "msgSentNtf=" <> strEncode _msgSentNtf,
        "msgRecvNtf=" <> strEncode _msgRecvNtf,
        "activeQueues:",
@@ -124,10 +117,8 @@ instance StrEncoding ServerStatsData where
    _qCreated <- "qCreated=" *> strP <* A.endOfLine
    _qSecured <- "qSecured=" *> strP <* A.endOfLine
    _qDeleted <- "qDeleted=" *> strP <* A.endOfLine
-    _qCount <- "qCount=" *> strP <* A.endOfLine <|> pure 0
    _msgSent <- "msgSent=" *> strP <* A.endOfLine
    _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
-    _msgExpired <- "msgExpired=" *> strP <* A.endOfLine <|> pure 0
    _msgSentNtf <- "msgSentNtf=" *> strP <* A.endOfLine <|> pure 0
    _msgRecvNtf <- "msgRecvNtf=" *> strP <* A.endOfLine <|> pure 0
    _activeQueues <-
@@ -142,7 +133,7 @@ instance StrEncoding ServerStatsData where
      optional ("activeQueuesNtf:" <* A.endOfLine) >>= \case
        Just _ -> strP <* optional A.endOfLine
        _ -> pure newPeriodStatsData
-    pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _msgExpired, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf, _qCount, _msgCount = 0}
+    pure ServerStatsData {_fromTime, _qCreated, _qSecured, _qDeleted, _msgSent, _msgRecv, _msgSentNtf, _msgRecvNtf, _activeQueues, _activeQueuesNtf, _qCount = 0, _msgCount = 0}

 data PeriodStats a = PeriodStats
  { day :: TVar (Set a),
@@ -114,7 +114,7 @@ closeStoreLog = \case

 writeStoreLogRecord :: StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
 writeStoreLogRecord (WriteStoreLog _ h) r = do
-  B.hPut h $ strEncode r `B.snoc` '\n' -- hPutStrLn makes write non-atomic for length > 1024
+  B.hPutStrLn h $ strEncode r
  hFlush h

 logCreateQueue :: StoreLog 'WriteMode -> QueueRec -> IO ()
@@ -69,7 +69,7 @@ import Data.Bifunctor (first)
 import Data.Bitraversable (bimapM)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
+import qualified Data.ByteString.Lazy as BL
 import Data.Default (def)
 import Data.Functor (($>))
 import Data.Version (showVersion)
@@ -78,7 +78,6 @@ import Network.Socket
 import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
 import qualified Paths_simplexmq as SMQ
-import Simplex.Messaging.Builder (Builder, byteString, toLazyByteString)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Parsers (dropPrefix, parse, parseRead1, sumTypeJSON)
@@ -135,9 +134,6 @@ class Transport c where
  -- | Write bytes to connection
  cPut :: c -> ByteString -> IO ()

-  -- | Write bytes to connection
-  cPut' :: c -> LB.ByteString -> IO ()
-
  -- | Receive ByteString from connection, allowing LF or CRLF termination.
  getLn :: c -> IO ByteString

@@ -221,11 +217,8 @@ instance Transport TLS where
    getBuffered tlsBuffer n t_ (T.recvData tlsContext)

  cPut :: TLS -> ByteString -> IO ()
-  cPut cxt = cPut' cxt . LB.fromStrict
-
-  cPut' :: TLS -> LB.ByteString -> IO ()
-  cPut' TLS {tlsContext, tlsTransportConfig = TransportConfig {transportTimeout = t_}} s =
-    withTimedErr t_ $ T.sendData tlsContext s
+  cPut TLS {tlsContext, tlsTransportConfig = TransportConfig {transportTimeout = t_}} s =
+    withTimedErr t_ . T.sendData tlsContext $ BL.fromStrict s

  getLn :: TLS -> IO ByteString
  getLn TLS {tlsContext, tlsBuffer} = do
@@ -316,10 +309,10 @@ serializeTransportError = \case
  TEHandshake e -> "HANDSHAKE " <> bshow e

 -- | Pad and send block to SMP transport.
-tPutBlock :: Transport c => THandle c -> Builder -> IO (Either TransportError ())
+tPutBlock :: Transport c => THandle c -> ByteString -> IO (Either TransportError ())
 tPutBlock THandle {connection = c, blockSize} block =
-  bimapM (const $ pure TELargeMsg) (cPut' c . toLazyByteString) $
-    C.pad' block blockSize
+  bimapM (const $ pure TELargeMsg) (cPut c) $
+    C.pad block blockSize

 -- | Receive block from SMP transport.
 tGetBlock :: Transport c => THandle c -> IO (Either TransportError ByteString)
@@ -363,7 +356,7 @@ smpThHandle :: forall c. THandle c -> Version -> THandle c
 smpThHandle th v = (th :: THandle c) {thVersion = v, batch = v >= 4}

 sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()
-sendHandshake th = ExceptT . tPutBlock th . byteString . smpEncode
+sendHandshake th = ExceptT . tPutBlock th . smpEncode

 getHandshake :: (Transport c, Encoding smp) => THandle c -> ExceptT TransportError IO smp
 getHandshake th = ExceptT $ (parse smpP (TEHandshake PARSE) =<<) <$> tGetBlock th
@@ -6,7 +6,6 @@ module Simplex.Messaging.Transport.Buffer where

 import Control.Concurrent.STM
 import qualified Control.Exception as E
-import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import GHC.IO.Exception (IOErrorType (..), IOException (..), ioException)
@@ -29,14 +28,6 @@ withBufferLock TBuffer {getLock} =
    (atomically $ takeTMVar getLock)
    (atomically $ putTMVar getLock ())

-- | Attempt to read some bytes, appending it to the existing buffer
-peekBuffered :: TBuffer -> Int -> IO ByteString -> IO (ByteString, Maybe ByteString)
-peekBuffered tb@TBuffer {buffer} t getChunk = withBufferLock tb $ do
-  old <- readTVarIO buffer
-  next_ <- timeout t getChunk
-  forM_ next_ $ \next -> atomically $ writeTVar buffer $! old <> next
-  pure (old, next_)
-
 getBuffered :: TBuffer -> Int -> Maybe Int -> IO ByteString -> IO ByteString
 getBuffered tb@TBuffer {buffer} n t_ getChunk = withBufferLock tb $ do
  b <- readChunks True =<< readTVarIO buffer
@@ -110,13 +110,12 @@ instance IsString (NonEmpty TransportHost) where fromString = parseString strDec
 data TransportClientConfig = TransportClientConfig
  { socksProxy :: Maybe SocksProxy,
    tcpKeepAlive :: Maybe KeepAliveOpts,
-    logTLSErrors :: Bool,
-    clientCredentials :: Maybe (X.CertificateChain, T.PrivKey)
+    logTLSErrors :: Bool
  }
  deriving (Eq, Show)

 defaultTransportClientConfig :: TransportClientConfig
-defaultTransportClientConfig = TransportClientConfig Nothing (Just defaultKeepAliveOpts) True Nothing
+defaultTransportClientConfig = TransportClientConfig Nothing (Just defaultKeepAliveOpts) True

 clientTransportConfig :: TransportClientConfig -> TransportConfig
 clientTransportConfig TransportClientConfig {logTLSErrors} =
@@ -127,9 +126,9 @@ runTransportClient :: (Transport c, MonadUnliftIO m) => TransportClientConfig ->
 runTransportClient = runTLSTransportClient supportedParameters Nothing

 runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
-runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials} proxyUsername host port keyHash client = do
+runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive} proxyUsername host port keyHash client = do
  let hostName = B.unpack $ strEncode host
-      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials
+      clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash
      connectTCP = case socksProxy of
        Just proxy -> connectSocksClient proxy proxyUsername $ hostAddr host
        _ -> connectTCPClient hostName
@@ -206,19 +205,14 @@ instance ToJSON SocksProxy where
 instance FromJSON SocksProxy where
  parseJSON = strParseJSON "SocksProxy"

-mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> T.ClientParams
-mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ =
+mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams
+mkTLSClientParams supported caStore_ host port keyHash_ = do
+  let p = B.pack port
  (T.defaultParamsClient host p)
-    { T.clientShared = def {T.sharedCAStore = fromMaybe (T.sharedCAStore def) caStore_},
-      T.clientHooks =
-        def
-          { T.onServerCertificate = maybe def (\cafp _ _ _ -> validateCertificateChain cafp host p) cafp_,
-            T.onCertificateRequest = maybe def (const . pure . Just) clientCreds_
-          },
+    { T.clientShared = maybe def (\caStore -> def {T.sharedCAStore = caStore}) caStore_,
+      T.clientHooks = maybe def (\keyHash -> def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p}) keyHash_,
      T.clientSupported = supported
    }
-  where
-    p = B.pack port

 validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
 validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
@@ -9,13 +9,11 @@ module Simplex.Messaging.Transport.Credentials
  )
 where

-import Control.Concurrent.STM
-import Crypto.Random (ChaChaDRG)
 import Data.ASN1.Types (getObjectID)
 import Data.ASN1.Types.String (ASN1StringEncoding (UTF8))
 import Data.Hourglass (Hours (..), timeAdd)
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
+import qualified Data.List.NonEmpty as NE
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.X509 as X509
@@ -36,9 +34,9 @@ tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credentials)
 tlsCredentials credentials = (C.KeyHash rootFP, TLS.Credentials [(X509.CertificateChain certs, privateToTls $ snd leafKey)])
  where
    Fingerprint rootFP = getFingerprint root X509.HashSHA256
-    leafKey = fst $ L.head credentials
-    root = snd $ L.last credentials
-    certs = map snd $ L.toList credentials
+    leafKey = fst $ NE.head credentials
+    root = snd $ NE.last credentials
+    certs = map snd $ NE.toList credentials

 privateToTls :: C.APrivateSignKey -> TLS.PrivKey
 privateToTls (C.APrivateSignKey _ k) = case k of
@@ -47,9 +45,9 @@ privateToTls (C.APrivateSignKey _ k) = case k of

 type Credentials = (C.ASignatureKeyPair, X509.SignedCertificate)

-genCredentials :: TVar ChaChaDRG -> Maybe Credentials -> (Hours, Hours) -> Text -> IO Credentials
-genCredentials g parent (before, after) subjectName = do
-  subjectKeys <- atomically $ C.generateSignatureKeyPair C.SEd25519 g
+genCredentials :: Maybe Credentials -> (Hours, Hours) -> Text -> IO Credentials
+genCredentials parent (before, after) subjectName = do
+  subjectKeys <- C.generateSignatureKeyPair C.SEd25519
  let (issuerKeys, issuer) = case parent of
        Nothing -> (subjectKeys, subject) -- self-signed
        Just (keys, cert) -> (keys, X509.certSubjectDN . X509.signedObject $ X509.getSigned cert)
@@ -13,7 +13,6 @@ import Network.HPACK (BufferSize)
 import Network.HTTP2.Client (Config (..), defaultPositionReadMaker, freeSimpleConfig)
 import qualified Network.HTTP2.Client as HC
 import qualified Network.HTTP2.Server as HS
-import Network.Socket (SockAddr (..))
 import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
 import Simplex.Messaging.Transport (SessionId, TLS (tlsUniq), Transport (cGet, cPut))
@@ -37,9 +36,7 @@ allocHTTP2Config c sz = do
        confSendAll = cPut c,
        confReadN = cGet c,
        confPositionReadMaker = defaultPositionReadMaker,
-        confTimeoutManager = tm,
-        confMySockAddr = SockAddrInet 0 0,
-        confPeerSockAddr = SockAddrInet 0 0
+        confTimeoutManager = tm
      }

 http2TLSParams :: T.Supported
@@ -2,7 +2,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}

 module Simplex.Messaging.Transport.HTTP2.Client where
@@ -66,7 +65,7 @@ defaultHTTP2ClientConfig =
  HTTP2ClientConfig
    { qSize = 64,
      connTimeout = 10000000,
-      transportConfig = TransportClientConfig Nothing Nothing True Nothing,
+      transportConfig = TransportClientConfig Nothing Nothing True,
      bufferSize = defaultHTTP2BufferSize,
      bodyHeadSize = 16384,
      suportedTLSParams = http2TLSParams
@@ -163,4 +162,4 @@ runHTTP2ClientWith :: forall a. BufferSize -> TransportHost -> ((TLS -> IO a) ->
 runHTTP2ClientWith bufferSize host setup client = setup $ withHTTP2 bufferSize run
  where
    run :: H.Config -> SessionId -> IO a
-    run cfg sessId = H.run (ClientConfig "https" (strEncode host) 20) cfg $ client sessId
+    run cfg = H.run (ClientConfig "https" (strEncode host) 20) cfg . client
@@ -5,20 +5,15 @@ module Simplex.Messaging.Transport.HTTP2.Server where
 import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
 import Control.Concurrent.STM
 import Control.Monad
-import Data.Time.Clock.System (getSystemTime, systemSeconds)
 import Network.HPACK (BufferSize)
 import Network.HTTP2.Server (Request, Response)
 import qualified Network.HTTP2.Server as H
 import Network.Socket
 import qualified Network.TLS as T
 import Numeric.Natural (Natural)
-import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Transport (SessionId, TLS, closeConnection)
+import Simplex.Messaging.Transport (SessionId, TLS)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), loadSupportedTLSServerParams, runTransportServer)
-import Simplex.Messaging.Util (threadDelay')
-import UnliftIO (finally)
-import UnliftIO.Concurrent (forkIO, killThread)

 type HTTP2ServerFunc = SessionId -> Request -> (Response -> IO ()) -> IO ()

@@ -54,7 +49,7 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
  started <- newEmptyTMVarIO
  reqQ <- newTBQueueIO qSize
  action <- async $
-    runHTTP2Server started http2Port bufferSize tlsServerParams transportConfig Nothing $ \sessionId r sendResponse -> do
+    runHTTP2Server started http2Port bufferSize tlsServerParams transportConfig $ \sessionId r sendResponse -> do
      reqBody <- getHTTP2Body r bodyHeadSize
      atomically $ writeTBQueue reqQ HTTP2Request {sessionId, request = r, reqBody, sendResponse}
  void . atomically $ takeTMVar started
@@ -63,29 +58,12 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
 closeHTTP2Server :: HTTP2Server -> IO ()
 closeHTTP2Server = uninterruptibleCancel . action

-runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.ServerParams -> TransportServerConfig -> Maybe ExpirationConfig -> HTTP2ServerFunc -> IO ()
-runHTTP2Server started port bufferSize serverParams transportConfig expCfg_ = runHTTP2ServerWith_ expCfg_ bufferSize setup
+runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.ServerParams -> TransportServerConfig -> HTTP2ServerFunc -> IO ()
+runHTTP2Server started port bufferSize serverParams transportConfig = runHTTP2ServerWith bufferSize setup
  where
    setup = runTransportServer started port serverParams transportConfig

-runHTTP2ServerWith :: BufferSize -> ((TLS -> IO ()) -> a) -> HTTP2ServerFunc -> a
-runHTTP2ServerWith = runHTTP2ServerWith_ Nothing
-
-runHTTP2ServerWith_ :: Maybe ExpirationConfig -> BufferSize -> ((TLS -> IO ()) -> a) -> HTTP2ServerFunc -> a
-runHTTP2ServerWith_ expCfg_ bufferSize setup http2Server = setup $ \tls -> do
-  activeAt <- newTVarIO =<< getSystemTime
-  tid_ <- mapM (forkIO . expireInactiveClient tls activeAt) expCfg_
-  withHTTP2 bufferSize (run activeAt) tls `finally` mapM_ killThread tid_
+runHTTP2ServerWith :: BufferSize -> ((TLS -> IO ()) -> a) -> (SessionId -> Request -> (Response -> IO ()) -> IO ()) -> a
+runHTTP2ServerWith bufferSize setup http2Server = setup $ withHTTP2 bufferSize run
  where
-    run activeAt cfg sessId = H.run cfg $ \req _aux sendResp -> do
-      getSystemTime >>= atomically . writeTVar activeAt
-      http2Server sessId req (`sendResp` [])
-    expireInactiveClient tls activeAt expCfg = loop
-      where
-        loop = do
-          threadDelay' $ checkInterval expCfg * 1000000
-          old <- expireBeforeEpoch expCfg
-          ts <- readTVarIO activeAt
-          if systemSeconds ts < old
-            then closeConnection tls
-            else loop
+    run cfg sessId = H.run cfg $ \req _aux sendResp -> http2Server sessId req (`sendResp` [])
@@ -7,9 +7,6 @@
 module Simplex.Messaging.Transport.Server
  ( TransportServerConfig (..),
    defaultTransportServerConfig,
-    runTransportServerState,
-    SocketState,
-    newSocketState,
    runTransportServer,
    runTransportServerSocket,
    runTCPServer,
@@ -41,14 +38,12 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (catchAll_, labelMyThread, tshow)
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak, deRefWeak)
-import UnliftIO (timeout)
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM

 data TransportServerConfig = TransportServerConfig
  { logTLSErrors :: Bool,
-    tlsSetupTimeout :: Int,
    transportTimeout :: Int
  }
  deriving (Eq, Show)
@@ -57,7 +52,6 @@ defaultTransportServerConfig :: TransportServerConfig
 defaultTransportServerConfig =
  TransportServerConfig
    { logTLSErrors = True,
-      tlsSetupTimeout = 60000000,
      transportTimeout = 40000000
    }

@@ -70,57 +64,39 @@ serverTransportConfig TransportServerConfig {logTLSErrors} =
 --
 -- All accepted connections are passed to the passed function.
 runTransportServer :: forall c m. (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> m ()) -> m ()
-runTransportServer started port params cfg server = do
-  ss <- atomically newSocketState
-  runTransportServerState ss started port params cfg server
-
-runTransportServerState :: forall c m. (Transport c, MonadUnliftIO m) => SocketState -> TMVar Bool -> ServiceName -> T.ServerParams -> TransportServerConfig -> (c -> m ()) -> m ()
-runTransportServerState ss started port = runTransportServerSocketState ss started (startTCPServer started port) (transportName (TProxy :: TProxy c))
+runTransportServer started port = runTransportServerSocket started (startTCPServer started port) (transportName (TProxy :: TProxy c))

 -- | Run a transport server with provided connection setup and handler.
 runTransportServerSocket :: (MonadUnliftIO m, T.TLSParams p, Transport a) => TMVar Bool -> IO Socket -> String -> p -> TransportServerConfig -> (a -> m ()) -> m ()
 runTransportServerSocket started getSocket threadLabel serverParams cfg server = do
-  ss <- atomically newSocketState
-  runTransportServerSocketState ss started getSocket threadLabel serverParams cfg server
-
-- | Run a transport server with provided connection setup and handler.
-runTransportServerSocketState :: (MonadUnliftIO m, T.TLSParams p, Transport a) => SocketState -> TMVar Bool -> IO Socket -> String -> p -> TransportServerConfig -> (a -> m ()) -> m ()
-runTransportServerSocketState ss started getSocket threadLabel serverParams cfg server = do
  u <- askUnliftIO
+  let tCfg = serverTransportConfig cfg
  labelMyThread $ "transport server for " <> threadLabel
-  liftIO . runTCPServerSocket ss started getSocket $ \conn ->
-    E.bracket (setup conn >>= maybe (fail "tls setup timeout") pure) closeConnection (unliftIO u . server)
-  where
-    tCfg = serverTransportConfig cfg
-    setup conn = timeout (tlsSetupTimeout cfg) $ do
-      labelMyThread $ threadLabel <> "/setup"
-      tls <- connectTLS Nothing tCfg serverParams conn
-      getServerConnection tCfg tls
+  liftIO . runTCPServerSocket started getSocket $ \conn ->
+    E.bracket
+      (connectTLS Nothing tCfg serverParams conn >>= getServerConnection tCfg)
+      closeConnection
+      (unliftIO u . server)

 -- | Run TCP server without TLS
 runTCPServer :: TMVar Bool -> ServiceName -> (Socket -> IO ()) -> IO ()
-runTCPServer started port server = do
-  ss <- atomically newSocketState
-  runTCPServerSocket ss started (startTCPServer started port) server
+runTCPServer started port = runTCPServerSocket started $ startTCPServer started port

 -- | Wrap socket provider in a TCP server bracket.
-runTCPServerSocket :: SocketState -> TMVar Bool -> IO Socket -> (Socket -> IO ()) -> IO ()
-runTCPServerSocket (accepted, gracefullyClosed, clients) started getSocket server =
-  E.bracket getSocket (closeServer started clients) $ \sock ->
-    forever . E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> do
-      cId <- atomically $ stateTVar accepted $ \cId -> let cId' = cId + 1 in cId `seq` (cId', cId')
-      let closeConn _ = do
-            atomically $ TM.delete cId clients
-            gracefulClose conn 5000 `catchAll_` pure () -- catchAll_ is needed here in case the connection was closed earlier
-            atomically $ modifyTVar' gracefullyClosed (+1)
+runTCPServerSocket :: TMVar Bool -> IO Socket -> (Socket -> IO ()) -> IO ()
+runTCPServerSocket started getSocket server = do
+  clients <- atomically TM.empty
+  clientId <- newTVarIO 0
+  E.bracket
+    getSocket
+    (closeServer started clients)
+    $ \sock -> forever . E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> do
+      -- catchAll_ is needed here in case the connection was closed earlier
+      cId <- atomically $ stateTVar clientId $ \cId -> let cId' = cId + 1 in (cId', cId')
+      let closeConn _ = atomically (TM.delete cId clients) >> gracefulClose conn 5000 `catchAll_` pure ()
      tId <- mkWeakThreadId =<< server conn `forkFinally` closeConn
      atomically $ TM.insert cId tId clients

-type SocketState = (TVar Int, TVar Int, TMap Int (Weak ThreadId))
-
-newSocketState :: STM SocketState
-newSocketState = (,,) <$> newTVar 0 <*> newTVar 0 <*> newTVar mempty
-
 closeServer :: TMVar Bool -> TMap Int (Weak ThreadId) -> Socket -> IO ()
 closeServer started clients sock = do
  readTVarIO clients >>= mapM_ (deRefWeak >=> mapM_ killThread)
@@ -7,7 +7,7 @@ module Simplex.Messaging.Transport.WebSockets (WS (..)) where
 import qualified Control.Exception as E
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy as BL
 import qualified Network.TLS as T
 import Network.WebSockets
 import Network.WebSockets.Stream (Stream)
@@ -72,9 +72,6 @@ instance Transport WS where
  cPut :: WS -> ByteString -> IO ()
  cPut = sendBinaryData . wsConnection

-  cPut' :: WS -> LB.ByteString -> IO ()
-  cPut' = sendBinaryData . wsConnection
-
  getLn :: WS -> IO ByteString
  getLn c = do
    s <- trimCR <$> receiveData (wsConnection c)
@@ -104,5 +101,5 @@ makeTLSContextStream cxt =
      (Just <$> T.recvData cxt) `E.catch` \case
        T.Error_EOF -> pure Nothing
        e -> E.throwIO e
-    writeStream :: Maybe LB.ByteString -> IO ()
+    writeStream :: Maybe BL.ByteString -> IO ()
    writeStream = maybe (closeTLS cxt) (T.sendData cxt)
@@ -18,8 +18,8 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Time (NominalDiffTime)
-import GHC.Conc (labelThread, myThreadId, threadDelay)
-import UnliftIO
+import GHC.Conc
+import UnliftIO.Async
 import qualified UnliftIO.Exception as UE

 raceAny_ :: MonadUnliftIO m => [m a] -> m ()
@@ -85,18 +85,6 @@ unlessM b = ifM b $ pure ()
 ($>>=) :: (Monad m, Monad f, Traversable f) => m (f a) -> (a -> m (f b)) -> m (f b)
 f $>>= g = f >>= fmap join . mapM g

-mapME :: (Monad m, Traversable t) => (a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b))
-mapME f = mapM (bindRight f)
-{-# INLINE mapME #-}
-
-bindRight :: Monad m => (a -> m (Either e b)) -> Either e a -> m (Either e b)
-bindRight = either (pure . Left)
-{-# INLINE bindRight #-}
-
-forME :: (Monad m, Traversable t) => t (Either e a) -> (a -> m (Either e b)) -> m (t (Either e b))
-forME = flip mapME
-{-# INLINE forME #-}
-
 catchAll :: IO a -> (E.SomeException -> IO a) -> IO a
 catchAll = E.catch
 {-# INLINE catchAll #-}
@@ -110,7 +98,7 @@ tryAllErrors err action = tryError action `UE.catch` (pure . Left . err)
 {-# INLINE tryAllErrors #-}

 catchAllErrors :: (MonadUnliftIO m, MonadError e m) => (E.SomeException -> e) -> m a -> (e -> m a) -> m a
-catchAllErrors err action handler = tryAllErrors err action >>= either handler pure
+catchAllErrors err action handle = tryAllErrors err action >>= either handle pure
 {-# INLINE catchAllErrors #-}

 catchThrow :: (MonadUnliftIO m, MonadError e m) => m a -> (E.SomeException -> e) -> m a
@@ -148,9 +136,6 @@ safeDecodeUtf8 = decodeUtf8With onError
  where
    onError _ _ = Just '?'

-timeoutThrow :: (MonadUnliftIO m, MonadError e m) => e -> Int -> m a -> m a
-timeoutThrow e ms action = timeout ms action >>= maybe (throwError e) pure
-
 threadDelay' :: Int64 -> IO ()
 threadDelay' time
  | time <= 0 = pure ()
@@ -1,448 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
-
-module Simplex.RemoteControl.Client
-  ( RCHostClient (action),
-    RCHostConnection,
-    newRCHostPairing,
-    connectRCHost,
-    cancelHostClient,
-    RCCtrlClient (action),
-    RCCtrlConnection,
-    connectRCCtrl,
-    discoverRCCtrl,
-    confirmCtrlSession,
-    cancelCtrlClient,
-    RCStepTMVar,
-    rcEncryptBody,
-    rcDecryptBody,
-    xrcpBlockSize,
-  ) where
-
-import Control.Applicative ((<|>))
-import Control.Logger.Simple
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.IO.Class
-import Crypto.Random (ChaChaDRG)
-import qualified Data.Aeson as J
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as LB
-import Data.Default (def)
-import Data.Functor (($>))
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
-import Data.Maybe (isNothing)
-import qualified Data.Text as T
-import Data.Time.Clock.System (getSystemTime)
-import Data.Word (Word16)
-import qualified Data.X509 as X509
-import Data.X509.Validation (Fingerprint (..), getFingerprint)
-import Network.Socket (PortNumber, SockAddr (..), hostAddressToTuple)
-import qualified Network.TLS as TLS
-import qualified Network.UDP as UDP
-import Simplex.Messaging.Agent.Client ()
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.Lazy (LazyByteString)
-import qualified Simplex.Messaging.Crypto.Lazy as LC
-import Simplex.Messaging.Crypto.SNTRUP761
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings
-import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Transport (TLS (..), cGet, cPut)
-import Simplex.Messaging.Transport.Buffer (peekBuffered)
-import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTransportClient)
-import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
-import Simplex.Messaging.Util
-import Simplex.Messaging.Version
-import Simplex.RemoteControl.Discovery (getLocalAddress, recvAnnounce, startTLSServer, withListener, withSender)
-import Simplex.RemoteControl.Invitation
-import Simplex.RemoteControl.Types
-import UnliftIO
-import UnliftIO.Concurrent
-
-currentRCVersion :: Version
-currentRCVersion = 1
-
-supportedRCVRange :: VersionRange
-supportedRCVRange = mkVersionRange 1 currentRCVersion
-
-xrcpBlockSize :: Int
-xrcpBlockSize = 16384
-
-helloBlockSize :: Int
-helloBlockSize = 12288
-
-encInvitationSize :: Int
-encInvitationSize = 900
-
-newRCHostPairing :: TVar ChaChaDRG -> IO RCHostPairing
-newRCHostPairing drg = do
-  ((_, caKey), caCert) <- genCredentials drg Nothing (-25, 24 * 999999) "ca"
-  (_, idPrivKey) <- atomically $ C.generateKeyPair drg
-  pure RCHostPairing {caKey, caCert, idPrivKey, knownHost = Nothing}
-
-data RCHostClient = RCHostClient
-  { action :: Async (),
-    client_ :: RCHClient_
-  }
-
-data RCHClient_ = RCHClient_
-  { startedPort :: TMVar (Maybe PortNumber),
-    announcer :: TMVar (Async (Either RCErrorType ())),
-    hostCAHash :: TMVar C.KeyHash,
-    endSession :: TMVar ()
-  }
-
-type RCHostConnection = (NonEmpty RCCtrlAddress, RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
-
-connectRCHost :: TVar ChaChaDRG -> RCHostPairing -> J.Value -> Bool -> Maybe RCCtrlAddress -> Maybe Word16 -> ExceptT RCErrorType IO RCHostConnection
-connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ctrlAppInfo multicast rcAddrPrefs_ port_ = do
-  r <- newEmptyTMVarIO
-  found@(RCCtrlAddress {address} :| _) <- findCtrlAddress
-  c@RCHClient_ {startedPort, announcer} <- liftIO mkClient
-  hostKeys <- atomically genHostKeys
-  action <- runClient c r hostKeys `putRCError` r
-  -- wait for the port to make invitation
-  portNum <- atomically $ readTMVar startedPort
-  signedInv@RCSignedInvitation {invitation} <- maybe (throwError RCETLSStartFailed) (liftIO . mkInvitation hostKeys address) portNum
-  when multicast $ case knownHost of
-    Nothing -> throwError RCENewController
-    Just KnownHostPairing {hostDhPubKey} -> do
-      ann <- async . liftIO . runExceptT $ announceRC drg 60 idPrivKey hostDhPubKey hostKeys invitation
-      atomically $ putTMVar announcer ann
-  pure (found, signedInv, RCHostClient {action, client_ = c}, r)
-  where
-    findCtrlAddress :: ExceptT RCErrorType IO (NonEmpty RCCtrlAddress)
-    findCtrlAddress = do
-      found' <- liftIO $ getLocalAddress rcAddrPrefs_
-      maybe (throwError RCENoLocalAddress) pure $ L.nonEmpty found'
-    mkClient :: IO RCHClient_
-    mkClient = do
-      startedPort <- newEmptyTMVarIO
-      announcer <- newEmptyTMVarIO
-      endSession <- newEmptyTMVarIO
-      hostCAHash <- newEmptyTMVarIO
-      pure RCHClient_ {startedPort, announcer, hostCAHash, endSession}
-    runClient :: RCHClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> RCHostKeys -> ExceptT RCErrorType IO (Async ())
-    runClient RCHClient_ {startedPort, announcer, hostCAHash, endSession} r hostKeys = do
-      tlsCreds <- liftIO $ genTLSCredentials drg caKey caCert
-      startTLSServer port_ startedPort tlsCreds (tlsHooks r knownHost hostCAHash) $ \tls ->
-        void . runExceptT $ do
-          r' <- newEmptyTMVarIO
-          whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $
-            runSession tls r' `putRCError` r'
-      where
-        runSession tls r' = do
-          logDebug "Incoming TLS connection"
-          hostEncHello <- receiveRCPacket tls
-          logDebug "Received host HELLO"
-          hostCA <- atomically $ takeTMVar hostCAHash
-          (ctrlEncHello, sessionKeys, helloBody, pairing') <- prepareHostSession drg hostCA pairing hostKeys hostEncHello
-          sendRCPacket tls ctrlEncHello
-          logDebug "Sent ctrl HELLO"
-          whenM (atomically $ tryPutTMVar r' $ Right (RCHostSession {tls, sessionKeys}, helloBody, pairing')) $ do
-            atomically (tryReadTMVar announcer) >>= mapM_ uninterruptibleCancel
-            -- can use `RCHostSession` until `endSession` is signalled
-            logDebug "Holding session"
-            atomically $ takeTMVar endSession
-    tlsHooks :: TMVar a -> Maybe KnownHostPairing -> TMVar C.KeyHash -> TLS.ServerHooks
-    tlsHooks r knownHost_ hostCAHash =
-      def
-        { TLS.onNewHandshake = \_ -> atomically $ isNothing <$> tryReadTMVar r,
-          TLS.onClientCertificate = \(X509.CertificateChain chain) ->
-            case chain of
-              [_leaf, ca] -> do
-                let kh = certFingerprint ca
-                    accept = maybe True (\h -> hostFingerprint h == kh) knownHost_
-                if accept
-                  then atomically (putTMVar hostCAHash kh) $> TLS.CertificateUsageAccept
-                  else pure $ TLS.CertificateUsageReject TLS.CertificateRejectUnknownCA
-              _ ->
-                pure $ TLS.CertificateUsageReject TLS.CertificateRejectUnknownCA
-        }
-    genHostKeys :: STM RCHostKeys
-    genHostKeys = do
-      sessKeys <- C.generateKeyPair drg
-      dhKeys <- C.generateKeyPair drg
-      pure RCHostKeys {sessKeys, dhKeys}
-    mkInvitation :: RCHostKeys -> TransportHost -> PortNumber -> IO RCSignedInvitation
-    mkInvitation RCHostKeys {sessKeys, dhKeys} host portNum = do
-      ts <- getSystemTime
-      let inv =
-            RCInvitation
-              { ca = certFingerprint caCert,
-                host,
-                port = fromIntegral portNum,
-                v = supportedRCVRange,
-                app = ctrlAppInfo,
-                ts,
-                skey = fst sessKeys,
-                idkey = C.publicKey idPrivKey,
-                dh = fst dhKeys
-              }
-      pure $ signInvitation (snd sessKeys) idPrivKey inv
-
-genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credentials
-genTLSCredentials drg caKey caCert = do
-  let caCreds = (C.signatureKeyPair caKey, caCert)
-  leaf <- genCredentials drg (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert
-  pure . snd $ tlsCredentials (leaf :| [caCreds])
-
-certFingerprint :: X509.SignedCertificate -> C.KeyHash
-certFingerprint caCert = C.KeyHash fp
-  where
-    Fingerprint fp = getFingerprint caCert X509.HashSHA256
-
-cancelHostClient :: RCHostClient -> IO ()
-cancelHostClient RCHostClient {action, client_ = RCHClient_ {announcer, endSession}} = do
-  atomically $ putTMVar endSession ()
-  atomically (tryTakeTMVar announcer) >>= mapM_ uninterruptibleCancel
-  uninterruptibleCancel action
-
-prepareHostSession :: TVar ChaChaDRG -> C.KeyHash -> RCHostPairing -> RCHostKeys -> RCHostEncHello -> ExceptT RCErrorType IO (RCCtrlEncHello, HostSessKeys, RCHostHello, RCHostPairing)
-prepareHostSession
-  drg
-  tlsHostFingerprint
-  pairing@RCHostPairing {idPrivKey, knownHost = knownHost_}
-  RCHostKeys {sessKeys = (_, sessPrivKey), dhKeys = (_, dhPrivKey)}
-  RCHostEncHello {dhPubKey, nonce, encBody} = do
-    let sharedKey = C.dh' dhPubKey dhPrivKey
-    helloBody <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encBody
-    hostHello@RCHostHello {v, ca, kem = kemPubKey} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
-    unless (ca == tlsHostFingerprint) $ throwError RCEIdentity
-    (kemCiphertext, kemSharedKey) <- liftIO $ sntrup761Enc drg kemPubKey
-    let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
-    unless (isCompatible v supportedRCVRange) $ throwError RCEVersion
-    let keys = HostSessKeys {hybridKey, idPrivKey, sessPrivKey}
-    knownHost' <- updateKnownHost ca dhPubKey
-    let ctrlHello = RCCtrlHello {}
-    -- TODO send error response if something fails
-    nonce' <- liftIO . atomically $ C.randomCbNonce drg
-    encBody' <- liftEitherWith (const RCEBlockSize) $ kcbEncrypt hybridKey nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize
-    let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, nonce = nonce', encBody = encBody'}
-    pure (ctrlEncHello, keys, hostHello, pairing {knownHost = Just knownHost'})
-    where
-      updateKnownHost :: C.KeyHash -> C.PublicKeyX25519 -> ExceptT RCErrorType IO KnownHostPairing
-      updateKnownHost ca hostDhPubKey = case knownHost_ of
-        Just h -> do
-          unless (hostFingerprint h == tlsHostFingerprint) . throwError $
-            RCEInternal "TLS host CA is different from host pairing, should be caught in TLS handshake"
-          pure (h :: KnownHostPairing) {hostDhPubKey}
-        Nothing -> pure KnownHostPairing {hostFingerprint = ca, hostDhPubKey}
-
-data RCCtrlClient = RCCtrlClient
-  { action :: Async (),
-    client_ :: RCCClient_
-  }
-
-data RCCClient_ = RCCClient_
-  { confirmSession :: TMVar Bool,
-    endSession :: TMVar ()
-  }
-
-type RCCtrlConnection = (RCCtrlClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)))
-
-- app should determine whether it is a new or known pairing based on CA fingerprint in the invitation
-connectRCCtrl :: TVar ChaChaDRG -> RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
-connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ hostAppInfo = do
-  pairing' <- maybe (liftIO newCtrlPairing) updateCtrlPairing pairing_
-  connectRCCtrl_ drg pairing' inv hostAppInfo
-  where
-    newCtrlPairing :: IO RCCtrlPairing
-    newCtrlPairing = do
-      ((_, caKey), caCert) <- genCredentials drg Nothing (0, 24 * 999999) "ca"
-      (_, dhPrivKey) <- atomically $ C.generateKeyPair drg
-      pure RCCtrlPairing {caKey, caCert, ctrlFingerprint = ca, idPubKey = idkey, dhPrivKey, prevDhPrivKey = Nothing}
-    updateCtrlPairing :: RCCtrlPairing -> ExceptT RCErrorType IO RCCtrlPairing
-    updateCtrlPairing pairing@RCCtrlPairing {ctrlFingerprint, idPubKey, dhPrivKey = currDhPrivKey} = do
-      unless (ca == ctrlFingerprint && idPubKey == idkey) $ throwError RCEIdentity
-      (_, dhPrivKey) <- atomically $ C.generateKeyPair drg
-      pure pairing {dhPrivKey, prevDhPrivKey = Just currDhPrivKey}
-
-connectRCCtrl_ :: TVar ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
-connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca, host, port} hostAppInfo = do
-  r <- newEmptyTMVarIO
-  c <- liftIO mkClient
-  action <- async $ runClient c r `putRCError` r
-  pure (RCCtrlClient {action, client_ = c}, r)
-  where
-    mkClient :: IO RCCClient_
-    mkClient = do
-      confirmSession <- newEmptyTMVarIO
-      endSession <- newEmptyTMVarIO
-      pure RCCClient_ {confirmSession, endSession}
-    runClient :: RCCClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> ExceptT RCErrorType IO ()
-    runClient RCCClient_ {confirmSession, endSession} r = do
-      clientCredentials <-
-        liftIO (genTLSCredentials drg caKey caCert) >>= \case
-          TLS.Credentials (creds : _) -> pure $ Just creds
-          _ -> throwError $ RCEInternal "genTLSCredentials must generate credentials"
-      let clientConfig = defaultTransportClientConfig {clientCredentials}
-      runTransportClient clientConfig Nothing host (show port) (Just ca) $ \tls@TLS {tlsBuffer, tlsContext} -> do
-        -- pump socket to detect connection problems
-        liftIO $ peekBuffered tlsBuffer 100000 (TLS.recvData tlsContext) >>= logDebug . tshow -- should normally be ("", Nothing) here
-        logDebug "Got TLS connection"
-        r' <- newEmptyTMVarIO
-        whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $ do
-          logDebug "Waiting for session confirmation"
-          whenM (atomically $ readTMVar confirmSession) $ runSession tls r' `putRCError` r'
-      where
-        runSession tls r' = do
-          (sharedKey, kemPrivKey, hostEncHello) <- prepareHostHello drg pairing' inv hostAppInfo
-          sendRCPacket tls hostEncHello
-          ctrlEncHello <- receiveRCPacket tls
-          logDebug "Received ctrl HELLO"
-          ctrlSessKeys <- prepareCtrlSession pairing' inv sharedKey kemPrivKey ctrlEncHello
-          whenM (atomically $ tryPutTMVar r' $ Right (RCCtrlSession {tls, sessionKeys = ctrlSessKeys}, pairing')) $ do
-            logDebug "Session started"
-            -- release second putTMVar in confirmCtrlSession
-            void . atomically $ takeTMVar confirmSession
-            atomically $ takeTMVar endSession
-            logDebug "Session ended"
-
-catchRCError :: ExceptT RCErrorType IO a -> (RCErrorType -> ExceptT RCErrorType IO a) -> ExceptT RCErrorType IO a
-catchRCError = catchAllErrors (RCEException . show)
-{-# INLINE catchRCError #-}
-
-putRCError :: ExceptT RCErrorType IO a -> TMVar (Either RCErrorType b) -> ExceptT RCErrorType IO a
-a `putRCError` r = a `catchRCError` \e -> atomically (tryPutTMVar r $ Left e) >> throwError e
-
-sendRCPacket :: Encoding a => TLS -> a -> ExceptT RCErrorType IO ()
-sendRCPacket tls pkt = do
-  b <- liftEitherWith (const RCEBlockSize) $ C.pad (smpEncode pkt) xrcpBlockSize
-  liftIO $ cPut tls b
-
-receiveRCPacket :: Encoding a => TLS -> ExceptT RCErrorType IO a
-receiveRCPacket tls = do
-  b <- liftIO $ cGet tls xrcpBlockSize
-  when (B.length b /= xrcpBlockSize) $ throwError RCEBlockSize
-  b' <- liftEitherWith (const RCEBlockSize) $ C.unPad b
-  liftEitherWith RCESyntax $ smpDecode b'
-
-prepareHostHello :: TVar ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO (C.DhSecretX25519, KEMSecretKey, RCHostEncHello)
-prepareHostHello
-  drg
-  RCCtrlPairing {caCert, dhPrivKey}
-  RCInvitation {v, dh = dhPubKey}
-  hostAppInfo = do
-    logDebug "Preparing session"
-    case compatibleVersion v supportedRCVRange of
-      Nothing -> throwError RCEVersion
-      Just (Compatible v') -> do
-        nonce <- liftIO . atomically $ C.randomCbNonce drg
-        (kemPubKey, kemPrivKey) <- liftIO $ sntrup761Keypair drg
-        let helloBody = RCHostHello {v = v', ca = certFingerprint caCert, app = hostAppInfo, kem = kemPubKey}
-            sharedKey = C.dh' dhPubKey dhPrivKey
-        encBody <- liftEitherWith (const RCEBlockSize) $ C.cbEncrypt sharedKey nonce (LB.toStrict $ J.encode helloBody) helloBlockSize
-        -- let sessKeys = CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey}
-        let hostEncHello = RCHostEncHello {dhPubKey = C.publicKey dhPrivKey, nonce, encBody}
-        pure (sharedKey, kemPrivKey, hostEncHello)
-
-prepareCtrlSession :: RCCtrlPairing -> RCInvitation -> C.DhSecretX25519 -> KEMSecretKey -> RCCtrlEncHello -> ExceptT RCErrorType IO CtrlSessKeys
-prepareCtrlSession
-  RCCtrlPairing {idPubKey, dhPrivKey}
-  RCInvitation {skey, dh = dhPubKey}
-  sharedKey
-  kemPrivKey = \case
-    RCCtrlEncHello {kem = kemCiphertext, nonce, encBody} -> do
-      kemSharedKey <- liftIO $ sntrup761Dec kemCiphertext kemPrivKey
-      let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
-      helloBody <- liftEitherWith (const RCEDecrypt) $ kcbDecrypt hybridKey nonce encBody
-      logDebug "Decrypted ctrl HELLO"
-      RCCtrlHello {} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody
-      pure CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey}
-    RCCtrlEncError {nonce, encMessage} -> do
-      message <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encMessage
-      throwError $ RCECtrlError $ T.unpack $ safeDecodeUtf8 message
-
-- * Multicast discovery
-
-announceRC :: TVar ChaChaDRG -> Int -> C.PrivateKeyEd25519 -> C.PublicKeyX25519 -> RCHostKeys -> RCInvitation -> ExceptT RCErrorType IO ()
-announceRC drg maxCount idPrivKey knownDhPub RCHostKeys {sessKeys, dhKeys} inv = withSender $ \sender -> do
-  replicateM_ maxCount $ do
-    logDebug "Announcing..."
-    nonce <- atomically $ C.randomCbNonce drg
-    encInvitation <- liftEitherWith undefined $ C.cbEncrypt sharedKey nonce sigInvitation encInvitationSize
-    liftIO . UDP.send sender $ smpEncode RCEncInvitation {dhPubKey, nonce, encInvitation}
-    threadDelay 1000000
-  where
-    sigInvitation = strEncode $ signInvitation sPrivKey idPrivKey inv
-    (_sPub, sPrivKey) = sessKeys
-    sharedKey = C.dh' knownDhPub dhPrivKey
-    (dhPubKey, dhPrivKey) = dhKeys
-
-discoverRCCtrl :: TMVar Int -> NonEmpty RCCtrlPairing -> ExceptT RCErrorType IO (RCCtrlPairing, RCVerifiedInvitation)
-discoverRCCtrl subscribers pairings =
-  timeoutThrow RCENotDiscovered 30000000 $ withListener subscribers $ \listener ->
-    loop $ do
-      (source, bytes) <- recvAnnounce listener
-      encInvitation <- liftEitherWith (const RCEInvitation) $ smpDecode bytes
-      r@(_, RCVerifiedInvitation RCInvitation {host}) <- findRCCtrlPairing pairings encInvitation
-      case source of
-        SockAddrInet _ ha | THIPv4 (hostAddressToTuple ha) == host -> pure ()
-        _ -> throwError RCEInvitation
-      pure r
-  where
-    loop :: ExceptT RCErrorType IO a -> ExceptT RCErrorType IO a
-    loop action =
-      liftIO (runExceptT action) >>= \case
-        Left err -> logError (tshow err) >> loop action
-        Right res -> pure res
-
-findRCCtrlPairing :: NonEmpty RCCtrlPairing -> RCEncInvitation -> ExceptT RCErrorType IO (RCCtrlPairing, RCVerifiedInvitation)
-findRCCtrlPairing pairings RCEncInvitation {dhPubKey, nonce, encInvitation} = do
-  (pairing, signedInvStr) <- liftEither $ decrypt (L.toList pairings)
-  signedInv <- liftEitherWith RCESyntax $ strDecode signedInvStr
-  inv@(RCVerifiedInvitation RCInvitation {dh = invDh}) <- maybe (throwError RCEInvitation) pure $ verifySignedInvitation signedInv
-  unless (invDh == dhPubKey) $ throwError RCEInvitation
-  pure (pairing, inv)
-  where
-    decrypt :: [RCCtrlPairing] -> Either RCErrorType (RCCtrlPairing, ByteString)
-    decrypt [] = Left RCECtrlNotFound
-    decrypt (pairing@RCCtrlPairing {dhPrivKey, prevDhPrivKey} : rest) =
-      let r = decrypt_ dhPrivKey <|> (decrypt_ =<< prevDhPrivKey)
-       in maybe (decrypt rest) (Right . (pairing,)) r
-    decrypt_ :: C.PrivateKeyX25519 -> Maybe ByteString
-    decrypt_ dhPrivKey =
-      let key = C.dh' dhPubKey dhPrivKey
-       in eitherToMaybe $ C.cbDecrypt key nonce encInvitation
-
-- * Controller handle operations
-
-- application should call this function when TMVar resolves
-confirmCtrlSession :: RCCtrlClient -> Bool -> IO ()
-confirmCtrlSession RCCtrlClient {client_ = RCCClient_ {confirmSession}} res = do
-  atomically $ putTMVar confirmSession res
-  -- controler does takeTMVar, freeing the slot
-  -- TODO add timeout
-  atomically $ putTMVar confirmSession res -- wait for Ctrl to take the var
-
-cancelCtrlClient :: RCCtrlClient -> IO ()
-cancelCtrlClient RCCtrlClient {action, client_ = RCCClient_ {endSession}} = do
-  atomically $ putTMVar endSession ()
-  uninterruptibleCancel action
-
-- * Session encryption
-
-rcEncryptBody :: TVar ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString)
-rcEncryptBody drg hybridKey s = do
-  nonce <- atomically $ C.randomCbNonce drg
-  let len = LB.length s
-  ct <- liftEitherWith (const RCEEncrypt) $ LC.kcbEncryptTailTag hybridKey nonce s len (len + 8)
-  pure (nonce, ct)
-
-rcDecryptBody :: KEMHybridSecret -> C.CbNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
-rcDecryptBody hybridKey nonce ct = do
-  let len = LB.length ct - 16
-  when (len < 0) $ throwError RCEDecrypt
-  (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.kcbDecryptTailTag hybridKey nonce len ct
-  unless ok $ throwError RCEDecrypt
-  pure s
@@ -1,138 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-
-module Simplex.RemoteControl.Discovery where
-
-import Control.Applicative ((<|>))
-import Control.Logger.Simple
-import Control.Monad
-import Data.ByteString (ByteString)
-import Data.Default (def)
-import Data.List (delete, find)
-import Data.Maybe (mapMaybe)
-import Data.String (IsString)
-import qualified Data.Text as T
-import Data.Word (Word16)
-import Network.Info (IPv4 (..), NetworkInterface (..), getNetworkInterfaces)
-import qualified Network.Socket as N
-import qualified Network.TLS as TLS
-import qualified Network.UDP as UDP
-import Simplex.Messaging.Transport (supportedParameters)
-import qualified Simplex.Messaging.Transport as Transport
-import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, runTransportServerSocket, startTCPServer)
-import Simplex.Messaging.Util (ifM, tshow)
-import Simplex.RemoteControl.Discovery.Multicast (setMembership)
-import Simplex.RemoteControl.Types
-import UnliftIO
-
-- | mDNS multicast group
-pattern MULTICAST_ADDR_V4 :: (IsString a, Eq a) => a
-pattern MULTICAST_ADDR_V4 = "224.0.0.251"
-
-pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
-pattern ANY_ADDR_V4 = "0.0.0.0"
-
-pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
-pattern DISCOVERY_PORT = "5227"
-
-getLocalAddress :: Maybe RCCtrlAddress -> IO [RCCtrlAddress]
-getLocalAddress preferred_ =
-  maybe id preferAddress preferred_ . mkLastLocalHost . mapMaybe toCtrlAddr <$> getNetworkInterfaces
-  where
-    toCtrlAddr NetworkInterface {name, ipv4 = IPv4 ha} = case N.hostAddressToTuple ha of
-      (0, 0, 0, 0) -> Nothing -- "no" address
-      (255, 255, 255, 255) -> Nothing -- broadcast
-      (169, 254, _, _) -> Nothing -- link-local
-      ok -> Just RCCtrlAddress {address = THIPv4 ok, interface = T.pack name}
-
-mkLastLocalHost :: [RCCtrlAddress] -> [RCCtrlAddress]
-mkLastLocalHost addrs = case find localHost addrs of
-  Nothing -> addrs
-  Just lh -> delete lh addrs <> [lh]
-  where
-    localHost RCCtrlAddress {address = a} = a == THIPv4 (127, 0, 0, 1)
-
-preferAddress :: RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
-preferAddress RCCtrlAddress {address, interface} addrs =
-  case find matchAddr addrs <|> find matchIface addrs of
-    Nothing -> addrs
-    Just p -> p : delete p addrs
-  where
-    matchAddr RCCtrlAddress {address = a} = a == address
-    matchIface RCCtrlAddress {interface = i} = i == interface
-
-startTLSServer :: MonadUnliftIO m => Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> m (Async ())
-startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ do
-  started <- newEmptyTMVarIO
-  bracketOnError (startTCPServer started $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
-    ifM
-      (atomically $ readTMVar started)
-      (runServer started socket)
-      (setPort Nothing)
-  where
-    runServer started socket = do
-      port <- N.socketPort socket
-      logInfo $ "System-assigned port: " <> tshow port
-      setPort $ Just port
-      runTransportServerSocket started (pure socket) "RCP TLS" serverParams defaultTransportServerConfig server
-    setPort = void . atomically . tryPutTMVar startedOnPort
-    serverParams =
-      def
-        { TLS.serverWantClientCert = True,
-          TLS.serverShared = def {TLS.sharedCredentials = credentials},
-          TLS.serverHooks = hooks,
-          TLS.serverSupported = supportedParameters
-        }
-
-withSender :: MonadUnliftIO m => (UDP.UDPSocket -> m a) -> m a
-withSender = bracket (liftIO $ UDP.clientSocket MULTICAST_ADDR_V4 DISCOVERY_PORT False) (liftIO . UDP.close)
-
-withListener :: MonadUnliftIO m => TMVar Int -> (UDP.ListenSocket -> m a) -> m a
-withListener subscribers = bracket (openListener subscribers) (closeListener subscribers)
-
-openListener :: MonadIO m => TMVar Int -> m UDP.ListenSocket
-openListener subscribers = liftIO $ do
-  sock <- UDP.serverSocket (MULTICAST_ADDR_V4, read DISCOVERY_PORT)
-  logDebug $ "Discovery listener socket: " <> tshow sock
-  let raw = UDP.listenSocket sock
-  -- N.setSocketOption raw N.Broadcast 1
-  joinMulticast subscribers raw (listenerHostAddr4 sock)
-  pure sock
-
-closeListener :: MonadIO m => TMVar Int -> UDP.ListenSocket -> m ()
-closeListener subscribers sock =
-  liftIO $
-    partMulticast subscribers (UDP.listenSocket sock) (listenerHostAddr4 sock) `finally` UDP.stop sock
-
-joinMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
-joinMulticast subscribers sock group = do
-  now <- atomically $ takeTMVar subscribers
-  when (now == 0) $ do
-    setMembership sock group True >>= \case
-      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
-      Right () -> atomically $ putTMVar subscribers (now + 1)
-
-partMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
-partMulticast subscribers sock group = do
-  now <- atomically $ takeTMVar subscribers
-  when (now == 1) $
-    setMembership sock group False >>= \case
-      Left e -> atomically (putTMVar subscribers now) >> logError ("setMembership failed " <> tshow e)
-      Right () -> atomically $ putTMVar subscribers (now - 1)
-
-listenerHostAddr4 :: UDP.ListenSocket -> N.HostAddress
-listenerHostAddr4 sock = case UDP.mySockAddr sock of
-  N.SockAddrInet _port host -> host
-  _ -> error "MULTICAST_ADDR_V4 is V4"
-
-recvAnnounce :: MonadIO m => UDP.ListenSocket -> m (N.SockAddr, ByteString)
-recvAnnounce sock = liftIO $ do
-  (invite, UDP.ClientSockAddr source _cmsg) <- UDP.recvFrom sock
-  pure (source, invite)
@@ -1,48 +0,0 @@
-module Simplex.RemoteControl.Discovery.Multicast
-  ( setMembership
-  ) where
-
-import Foreign (Ptr, allocaBytes, castPtr, pokeByteOff)
-import Foreign.C.Types (CInt (..))
-import Network.Socket
-
-#include <HsNet.h>
-
-{- | Toggle multicast group membership.
-
-NB: Group membership is per-host, not per-process. A socket is only used to access system interface for groups.
-}
-setMembership :: Socket -> HostAddress -> Bool -> IO (Either CInt ())
-setMembership sock group membership = allocaBytes #{size struct ip_mreq} $ \mReqPtr -> do
-  #{poke struct ip_mreq, imr_multiaddr} mReqPtr group
-  #{poke struct ip_mreq, imr_interface} mReqPtr (0 :: HostAddress) -- attempt to contact the group on ANY interface
-  withFdSocket sock $ \fd -> do
-    rc <- c_setsockopt fd c_IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})
-    if rc == 0
-      then pure $ Right ()
-      else pure $ Left rc
-  where
-    flag = if membership then c_IP_ADD_MEMBERSHIP else c_IP_DROP_MEMBERSHIP
-
-#ifdef mingw32_HOST_OS
-
-foreign import stdcall unsafe "setsockopt"
-    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
-
-c_IP_ADD_MEMBERSHIP, c_IP_DROP_MEMBERSHIP :: CInt
-c_IP_ADD_MEMBERSHIP  = 12
-c_IP_DROP_MEMBERSHIP = 13
-
-#else
-
-foreign import ccall unsafe "setsockopt"
-    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
-
-c_IP_ADD_MEMBERSHIP, c_IP_DROP_MEMBERSHIP :: CInt
-c_IP_ADD_MEMBERSHIP  = #const IP_ADD_MEMBERSHIP
-c_IP_DROP_MEMBERSHIP = #const IP_DROP_MEMBERSHIP
-
-#endif
-
-c_IPPROTO_IP :: CInt
-c_IPPROTO_IP = #const IPPROTO_IP
@@ -1,169 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Simplex.RemoteControl.Invitation
-  ( RCInvitation (..)
-  , signInvitation
-  , RCSignedInvitation (..)
-  , verifySignedInvitation
-  , RCVerifiedInvitation (..)
-  , RCEncInvitation (..)
-  ) where
-
-import qualified Data.Aeson as J
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as LB
-import Data.Time.Clock.System (SystemTime)
-import Data.Word (Word16)
-import Network.HTTP.Types (parseSimpleQuery)
-import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery, urlDecode)
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Version (VersionRange)
-
-data RCInvitation = RCInvitation
-  { -- | 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.
-    ca :: C.KeyHash,
-    host :: TransportHost,
-    port :: Word16,
-    -- | Supported version range for remote control protocol
-    v :: VersionRange,
-    -- | Application information
-    app :: J.Value,
-    -- | Session start time in seconds since epoch
-    ts :: SystemTime,
-    -- | 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.
-    skey :: C.PublicKeyEd25519,
-    -- | Long-term Ed25519 public key used to verify the announcement and commands.
-    --
-    -- Is apart of the long term controller identity.
-    idkey :: C.PublicKeyEd25519,
-    -- | Session X25519 DH key
-    dh :: C.PublicKeyX25519
-  }
-  deriving (Show)
-
-instance StrEncoding RCInvitation where
-  strEncode RCInvitation {ca, host, port, v, app, ts, skey, idkey, dh} =
-    mconcat
-      [ "xrcp:/",
-        strEncode ca,
-        "@",
-        strEncode host,
-        ":",
-        strEncode port,
-        "#/?",
-        renderSimpleQuery False query
-      ]
-    where
-      query =
-        [ ("v", strEncode v),
-          ("app", LB.toStrict $ J.encode app),
-          ("ts", strEncode ts),
-          ("skey", strEncode skey),
-          ("idkey", strEncode idkey),
-          ("dh", strEncode dh)
-        ]
-
-  strP = do
-    _ <- A.string "xrcp:/"
-    ca <- strP
-    _ <- A.char '@'
-    host <- A.takeWhile (/= ':') >>= either fail pure . strDecode . urlDecode True
-    _ <- A.char ':'
-    port <- strP
-    _ <- A.string "#/?"
-
-    q <- parseSimpleQuery <$> A.takeWhile (/= ' ')
-    v <- requiredP q "v" strDecode
-    app <- requiredP q "app" $ J.eitherDecodeStrict . urlDecode True
-    ts <- requiredP q "ts" $ strDecode . urlDecode True
-    skey <- requiredP q "skey" $ parseAll strP
-    idkey <- requiredP q "idkey" $ parseAll strP
-    dh <- requiredP q "dh" $ parseAll strP
-    pure RCInvitation {ca, host, port, v, app, ts, skey, idkey, dh}
-
-data RCSignedInvitation = RCSignedInvitation
-  { invitation :: RCInvitation,
-    ssig :: C.Signature 'C.Ed25519,
-    idsig :: C.Signature 'C.Ed25519
-  }
-  deriving (Show)
-
-- | URL-encoded and signed for showing in QR code
-instance StrEncoding RCSignedInvitation where
-  strEncode RCSignedInvitation {invitation, ssig, idsig} =
-    mconcat
-      [ strEncode invitation,
-        "&ssig=",
-        strEncode $ C.signatureBytes ssig,
-        "&idsig=",
-        strEncode $ C.signatureBytes idsig
-      ]
-
-  strP = do
-    -- TODO this assumes some order or parameters, can be made independent
-    (url, invitation) <- A.match strP
-    sigs <- case B.breakSubstring "&ssig=" url of
-      (_, sigs) | B.null sigs -> fail "missing signatures"
-      (_, sigs) -> pure $ parseSimpleQuery $ B.drop 1 sigs
-    ssig <- requiredP sigs "ssig" $ parseAll strP
-    idsig <- requiredP sigs "idsig" $ parseAll strP
-    pure RCSignedInvitation {invitation, ssig, idsig}
-
-signInvitation :: C.PrivateKey C.Ed25519 -> C.PrivateKey C.Ed25519 -> RCInvitation -> RCSignedInvitation
-signInvitation sKey idKey invitation = RCSignedInvitation {invitation, ssig, idsig}
-  where
-    uri = strEncode invitation
-    ssig =
-      case C.sign (C.APrivateSignKey C.SEd25519 sKey) uri of
-        C.ASignature C.SEd25519 s -> s
-        _ -> error "signing with ed25519"
-    inviteUrlSigned = mconcat [uri, "&ssig=", strEncode ssig]
-    idsig =
-      case C.sign (C.APrivateSignKey C.SEd25519 idKey) inviteUrlSigned of
-        C.ASignature C.SEd25519 s -> s
-        _ -> error "signing with ed25519"
-
-newtype RCVerifiedInvitation = RCVerifiedInvitation RCInvitation
-  deriving (Show)
-
-verifySignedInvitation :: RCSignedInvitation -> Maybe RCVerifiedInvitation
-verifySignedInvitation RCSignedInvitation {invitation, ssig, idsig} =
-  if C.verify' skey ssig inviteURL && C.verify' idkey idsig inviteURLS
-    then Just $ RCVerifiedInvitation invitation
-    else Nothing
-  where
-    RCInvitation {skey, idkey} = invitation
-    inviteURL = strEncode invitation
-    inviteURLS = mconcat [inviteURL, "&ssig=", strEncode ssig]
-
-data RCEncInvitation = RCEncInvitation
-  { dhPubKey :: C.PublicKeyX25519,
-    nonce :: C.CbNonce,
-    encInvitation :: ByteString
-  }
-
-instance Encoding RCEncInvitation where
-  smpEncode RCEncInvitation {dhPubKey, nonce, encInvitation} =
-    smpEncode (dhPubKey, nonce, Tail encInvitation)
-  smpP = do
-    (dhPubKey, nonce, Tail encInvitation) <- smpP
-    pure RCEncInvitation {dhPubKey, nonce, encInvitation}
-
-- * Utils
-
-requiredP :: MonadFail m => SimpleQuery -> ByteString -> (ByteString -> Either String a) -> m a
-requiredP q k f = maybe (fail $ "missing " <> show k) (either fail pure . f) $ lookup k q
@@ -1,238 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Simplex.RemoteControl.Types where
-
-import qualified Data.Aeson as J
-import qualified Data.Aeson.TH as JQ
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.SNTRUP761
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings
-import Simplex.Messaging.Encoding
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
-import Simplex.Messaging.Transport (TLS)
-import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (safeDecodeUtf8)
-import Simplex.Messaging.Version (Version, VersionRange, mkVersionRange)
-import UnliftIO
-
-data RCErrorType
-  = RCEInternal {internalErr :: String}
-  | RCEIdentity
-  | RCENoLocalAddress
-  | RCENewController
-  | RCENotDiscovered
-  | RCETLSStartFailed
-  | RCEException {exception :: String}
-  | RCECtrlAuth
-  | RCECtrlNotFound
-  | RCECtrlError {ctrlErr :: String}
-  | RCEInvitation
-  | RCEVersion
-  | RCEEncrypt
-  | RCEDecrypt
-  | RCEBlockSize
-  | RCESyntax {syntaxErr :: String}
-  deriving (Eq, Show, Exception)
-
-instance StrEncoding RCErrorType where
-  strEncode = \case
-    RCEInternal err -> "INTERNAL" <> text err
-    RCEIdentity -> "IDENTITY"
-    RCENoLocalAddress -> "NO_LOCAL_ADDR"
-    RCENewController -> "NEW_CONTROLLER"
-    RCENotDiscovered -> "NOT_DISCOVERED"
-    RCETLSStartFailed -> "CTRL_TLS_START"
-    RCEException err -> "EXCEPTION" <> text err
-    RCECtrlAuth -> "CTRL_AUTH"
-    RCECtrlNotFound -> "CTRL_NOT_FOUND"
-    RCECtrlError err -> "CTRL_ERROR" <> text err
-    RCEInvitation -> "INVITATION"
-    RCEVersion -> "VERSION"
-    RCEEncrypt -> "ENCRYPT"
-    RCEDecrypt -> "DECRYPT"
-    RCEBlockSize -> "BLOCK_SIZE"
-    RCESyntax err -> "SYNTAX" <> text err
-    where
-      text = (" " <>) . encodeUtf8 . T.pack
-  strP =
-    A.takeTill (== ' ') >>= \case
-      "INTERNAL" -> RCEInternal <$> textP
-      "IDENTITY" -> pure RCEIdentity
-      "NO_LOCAL_ADDR" -> pure RCENoLocalAddress
-      "NEW_CONTROLLER" -> pure RCENewController
-      "NOT_DISCOVERED" -> pure RCENotDiscovered
-      "CTRL_TLS_START" -> pure RCETLSStartFailed
-      "EXCEPTION" -> RCEException <$> textP
-      "CTRL_AUTH" -> pure RCECtrlAuth
-      "CTRL_NOT_FOUND" -> pure RCECtrlNotFound
-      "CTRL_ERROR" -> RCECtrlError <$> textP
-      "INVITATION" -> pure RCEInvitation
-      "VERSION" -> pure RCEVersion
-      "ENCRYPT" -> pure RCEEncrypt
-      "DECRYPT" -> pure RCEDecrypt
-      "BLOCK_SIZE" -> pure RCEBlockSize
-      "SYNTAX" -> RCESyntax <$> textP
-      _ -> fail "bad RCErrorType"
-    where
-      textP = T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
-
-- * Discovery
-
-ipProbeVersionRange :: VersionRange
-ipProbeVersionRange = mkVersionRange 1 1
-
-data IpProbe = IpProbe
-  { versionRange :: VersionRange,
-    randomNonce :: ByteString
-  }
-  deriving (Show)
-
-instance Encoding IpProbe where
-  smpEncode IpProbe {versionRange, randomNonce} = smpEncode (versionRange, 'I', randomNonce)
-
-  smpP = IpProbe <$> (smpP <* "I") *> smpP
-
-- * Session
-
-data RCHostHello = RCHostHello
-  { v :: Version,
-    ca :: C.KeyHash,
-    app :: J.Value,
-    kem :: KEMPublicKey
-  }
-  deriving (Show)
-
-$(JQ.deriveJSON defaultJSON ''RCHostHello)
-
-data RCCtrlHello = RCCtrlHello {}
-  deriving (Show)
-
-$(JQ.deriveJSON defaultJSON {J.nullaryToObject = True} ''RCCtrlHello)
-
-- | Long-term part of controller (desktop) connection to host (mobile)
-data RCHostPairing = RCHostPairing
-  { caKey :: C.APrivateSignKey,
-    caCert :: C.SignedCertificate,
-    idPrivKey :: C.PrivateKeyEd25519,
-    knownHost :: Maybe KnownHostPairing
-  }
-
-data KnownHostPairing = KnownHostPairing
-  { hostFingerprint :: C.KeyHash, -- this is only changed in the first session, long-term identity of connected remote host
-    hostDhPubKey :: C.PublicKeyX25519
-  }
-
-data RCCtrlAddress = RCCtrlAddress
-  { address :: TransportHost, -- allows any interface when found exactly
-    interface :: Text
-  }
-  deriving (Show, Eq)
-
-- | Long-term part of host (mobile) connection to controller (desktop)
-data RCCtrlPairing = RCCtrlPairing
-  { caKey :: C.APrivateSignKey,
-    caCert :: C.SignedCertificate,
-    ctrlFingerprint :: C.KeyHash, -- long-term identity of connected remote controller
-    idPubKey :: C.PublicKeyEd25519,
-    dhPrivKey :: C.PrivateKeyX25519,
-    prevDhPrivKey :: Maybe C.PrivateKeyX25519
-  }
-
-data RCHostKeys = RCHostKeys
-  { sessKeys :: C.KeyPair 'C.Ed25519,
-    dhKeys :: C.KeyPair 'C.X25519
-  }
-
-- Connected session with Host
-data RCHostSession = RCHostSession
-  { tls :: TLS,
-    sessionKeys :: HostSessKeys
-  }
-
-data HostSessKeys = HostSessKeys
-  { hybridKey :: KEMHybridSecret,
-    idPrivKey :: C.PrivateKeyEd25519,
-    sessPrivKey :: C.PrivateKeyEd25519
-  }
-
-- Host: RCCtrlPairing + RCInvitation => (RCCtrlSession, RCCtrlPairing)
-
-data RCCtrlSession = RCCtrlSession
-  { tls :: TLS,
-    sessionKeys :: CtrlSessKeys
-  }
-
-data CtrlSessKeys = CtrlSessKeys
-  { hybridKey :: KEMHybridSecret,
-    idPubKey :: C.PublicKeyEd25519,
-    sessPubKey :: C.PublicKeyEd25519
-  }
-
-data RCHostEncHello = RCHostEncHello
-  { dhPubKey :: C.PublicKeyX25519,
-    nonce :: C.CbNonce,
-    encBody :: ByteString
-  }
-  deriving (Show)
-
-instance Encoding RCHostEncHello where
-  smpEncode RCHostEncHello {dhPubKey, nonce, encBody} =
-    "HELLO " <> smpEncode (dhPubKey, nonce, Tail encBody)
-  smpP = do
-    (dhPubKey, nonce, Tail encBody) <- "HELLO " *> smpP
-    pure RCHostEncHello {dhPubKey, nonce, encBody}
-
-data RCCtrlEncHello
-  = RCCtrlEncHello {kem :: KEMCiphertext, nonce :: C.CbNonce, encBody :: ByteString}
-  | RCCtrlEncError {nonce :: C.CbNonce, encMessage :: ByteString}
-  deriving (Show)
-
-instance Encoding RCCtrlEncHello where
-  smpEncode = \case
-    RCCtrlEncHello {kem, nonce, encBody} -> "HELLO " <> smpEncode (kem, nonce, Tail encBody)
-    RCCtrlEncError {nonce, encMessage} -> "ERROR " <> smpEncode (nonce, Tail encMessage)
-  smpP =
-    A.takeTill (== ' ') >>= \case
-      "HELLO" -> do
-        (kem, nonce, Tail encBody) <- _smpP
-        pure RCCtrlEncHello {kem, nonce, encBody}
-      "ERROR" -> do
-        (nonce, Tail encMessage) <- _smpP
-        pure RCCtrlEncError {nonce, encMessage}
-      _ -> fail "bad RCCtrlEncHello"
-
-- * Utils
-
-- | tlsunique channel binding
-type SessionCode = ByteString
-
-type RCStepTMVar a = TMVar (Either RCErrorType a)
-
-type Tasks = TVar [Async ()]
-
-asyncRegistered :: MonadUnliftIO m => Tasks -> m () -> m ()
-asyncRegistered tasks action = async action >>= registerAsync tasks
-
-registerAsync :: MonadIO m => Tasks -> Async () -> m ()
-registerAsync tasks = atomically . modifyTVar tasks . (:)
-
-cancelTasks :: MonadIO m => Tasks -> m ()
-cancelTasks tasks = readTVarIO tasks >>= mapM_ cancel
-
-$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RCErrorType)
-
-$(JQ.deriveJSON defaultJSON ''RCCtrlAddress)
@@ -0,0 +1,88 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: nightly-2023-08-22
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+  - .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+extra-deps:
+  - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
+  - network-3.1.2.7@sha256:e3d78b13db9512aeb106e44a334ab42b7aa48d26c097299084084cb8be5c5568,4888
+  - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
+  - tls-1.6.0@sha256:7ae39373fd2de27fb80e90f76d22aeeb9a074a0ddd120cbd02c9c52f516a9e55,6987
+  # below dependencies are to update Aeson to 2.0.3
+  - OneTuple-0.3.1@sha256:a848c096c9d29e82ffdd30a9998aa2931cbccb3a1bc137539d80f6174d31603e,2262
+  - attoparsec-0.14.4@sha256:79584bdada8b730cb5138fca8c35c76fbef75fc1d1e01e6b1d815a5ee9843191,5810
+  - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005
+  - semialign-1.2.0.1@sha256:0e179b4d3a8eff79001d374d6c91917c6221696b9620f0a4d86852fc6a9b9501,2836
+  - text-short-0.1.5@sha256:962c6228555debdc46f758d0317dea16e5240d01419b42966674b08a5c3d8fa6,3498
+  - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
+  - github: simplex-chat/aeson
+    commit: aab7b5a14d6c5ea64c64dcaee418de1bb00dcc2b
+  - github: kazu-yamamoto/http2
+    commit: 804fa283f067bd3fd89b8c5f8d25b3047813a517
+  # - ../direct-sqlcipher
+  - github: simplex-chat/direct-sqlcipher
+    commit: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
+  # - ../sqlcipher-simple
+  - github: simplex-chat/sqlcipher-simple
+    commit: a46bd361a19376c5211f1058908fc0ae6bf42446
+  - github: simplex-chat/network-transport
+    commit: 0013798272a683e35ca38d2fdaf480942311fba8
+  # - ../hs-tls/core
+  # - github: simplex-chat/hs-tls
+  #   commit: f6cc753611f80af300401cfae63846e9d7c40d9e
+  #   subdirs:
+  #     - core
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.1"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
@@ -20,7 +20,6 @@ import Control.Concurrent
 import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Maybe (fromJust)
 import Data.Type.Equality
 import GHC.Stack (withFrozenCallStack)
 import Network.HTTP.Types (urlEncode)
@@ -45,11 +44,10 @@ agentTests (ATransport t) = do
  describe "SQLite store" storeTests
  describe "Migration tests" migrationTests
  describe "SMP agent protocol syntax" $ syntaxTests t
-  describe "Establishing duplex connection (via agent protocol)" $ do
-    -- These tests are disabled because the agent does not work correctly with multiple connected TCP clients
-    xit "should connect via one server and one agent" $ do
+  describe "Establishing duplex connection" $ do
+    it "should connect via one server and one agent" $ do
      smpAgentTest2_1_1 $ testDuplexConnection t
-    xit "should connect via one server and one agent (random IDs)" $ do
+    it "should connect via one server and one agent (random IDs)" $ do
      smpAgentTest2_1_1 $ testDuplexConnRandomIds t
    it "should connect via one server and 2 agents" $ do
      smpAgentTest2_2_1 $ testDuplexConnection t
@@ -139,18 +137,18 @@ correctTransmission (corrId, connId, cmdOrErr) = case cmdOrErr of
  Left e -> error $ show e

 -- | receive message to handle `h` and validate that it is the expected one
-(<#) :: (HasCallStack, Transport c) => c -> AEntityTransmission 'Agent 'AEConn -> Expectation
-h <# (corrId, connId, cmd) = timeout 5000000 (h <#:) `shouldReturn` Just (corrId, connId, Right cmd)
+(<#) :: Transport c => c -> AEntityTransmission 'Agent 'AEConn -> Expectation
+h <# (corrId, connId, cmd) = (h <#:) `shouldReturn` (corrId, connId, Right cmd)

-(<#.) :: (HasCallStack, Transport c) => c -> AEntityTransmission 'Agent 'AENone -> Expectation
-h <#. (corrId, connId, cmd) = timeout 5000000 (h <#:.) `shouldReturn` Just (corrId, connId, Right cmd)
+(<#.) :: Transport c => c -> AEntityTransmission 'Agent 'AENone -> Expectation
+h <#. (corrId, connId, cmd) = (h <#:.) `shouldReturn` (corrId, connId, Right cmd)

 -- | receive message to handle `h` and validate it using predicate `p`
-(<#=) :: (HasCallStack, Transport c) => c -> (AEntityTransmission 'Agent 'AEConn -> Bool) -> Expectation
-h <#= p = timeout 5000000 (h <#:) >>= (`shouldSatisfy` p . correctTransmission . fromJust)
+(<#=) :: Transport c => c -> (AEntityTransmission 'Agent 'AEConn -> Bool) -> Expectation
+h <#= p = (h <#:) >>= (`shouldSatisfy` p . correctTransmission)

-(<#=?) :: (HasCallStack, Transport c) => c -> (ATransmission 'Agent -> Bool) -> Expectation
-h <#=? p = timeout 5000000 (h <#:?) >>= (`shouldSatisfy` p . correctTransmission . fromJust)
+(<#=?) :: Transport c => c -> (ATransmission 'Agent -> Bool) -> Expectation
+h <#=? p = (h <#:?) >>= (`shouldSatisfy` p . correctTransmission)

 -- | test that nothing is delivered to handle `h` during 10ms
 (#:#) :: Transport c => c -> String -> Expectation
@@ -164,10 +162,7 @@ h #:# err = tryGet `shouldReturn` ()
 pattern Msg :: MsgBody -> ACommand 'Agent e
 pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} _ msgBody

-pattern Msg' :: AgentMsgId -> MsgBody -> ACommand 'Agent e
-pattern Msg' aMsgId msgBody <- MSG MsgMeta {integrity = MsgOk, recipient = (aMsgId, _)} _ msgBody
-
-testDuplexConnection :: (HasCallStack, Transport c) => TProxy c -> c -> c -> IO ()
+testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnection _ alice bob = do
  ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW T INV subscribe")
  let cReq' = strEncode cReq
@@ -180,19 +175,19 @@ testDuplexConnection _ alice bob = do
  -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
  alice #: ("3", "bob", "SEND F :hello") #> ("3", "bob", MID 4)
  alice <# ("", "bob", SENT 4)
-  bob <#= \case ("", "alice", Msg' 4 "hello") -> True; _ -> False
+  bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
  bob #: ("12", "alice", "ACK 4") #> ("12", "alice", OK)
  alice #: ("4", "bob", "SEND F :how are you?") #> ("4", "bob", MID 5)
  alice <# ("", "bob", SENT 5)
-  bob <#= \case ("", "alice", Msg' 5 "how are you?") -> True; _ -> False
+  bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
  bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
  bob #: ("14", "alice", "SEND F 9\nhello too") #> ("14", "alice", MID 6)
  bob <# ("", "alice", SENT 6)
-  alice <#= \case ("", "bob", Msg' 6 "hello too") -> True; _ -> False
+  alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
  alice #: ("3a", "bob", "ACK 6") #> ("3a", "bob", OK)
  bob #: ("15", "alice", "SEND F 9\nmessage 1") #> ("15", "alice", MID 7)
  bob <# ("", "alice", SENT 7)
-  alice <#= \case ("", "bob", Msg' 7 "message 1") -> True; _ -> False
+  alice <#= \case ("", "bob", Msg "message 1") -> True; _ -> False
  alice #: ("4a", "bob", "ACK 7") #> ("4a", "bob", OK)
  alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
  bob #: ("17", "alice", "SEND F 9\nmessage 3") #> ("17", "alice", MID 8)
@@ -11,7 +11,6 @@ module AgentTests.DoubleRatchetTests where

 import Control.Concurrent.STM
 import Control.Monad.Except
-import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
@@ -59,14 +58,14 @@ fullMsgLen = 1 + fullHeaderLen + C.authTagSize + paddedMsgLen

 testMessageHeader :: Expectation
 testMessageHeader = do
-  (k, _) <- atomically . C.generateKeyPair @X25519 =<< C.newRandom
+  (k, _) <- C.generateKeyPair' @X25519
  let hdr = MsgHeader {msgMaxVersion = currentE2EEncryptVersion, msgDHRs = k, msgPN = 0, msgNs = 0}
  parseAll (smpP @(MsgHeader 'X25519)) (smpEncode hdr) `shouldBe` Right hdr

 pattern Decrypted :: ByteString -> Either CryptoError (Either CryptoError ByteString)
 pattern Decrypted msg <- Right (Right msg)

-type TestRatchets a = (AlgorithmI a, DhAlgorithm a) => TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> IO ()
+type TestRatchets a = (AlgorithmI a, DhAlgorithm a) => TVar (Ratchet a, SkippedMsgKeys) -> TVar (Ratchet a, SkippedMsgKeys) -> IO ()

 testEncryptDecrypt :: TestRatchets a
 testEncryptDecrypt alice bob = do
@@ -154,7 +153,7 @@ testSkippedAfterRatchetAdvance alice bob = do

 testKeyJSON :: forall a. AlgorithmI a => C.SAlgorithm a -> IO ()
 testKeyJSON _ = do
-  (k, pk) <- atomically . C.generateKeyPair @a =<< C.newRandom
+  (k, pk) <- C.generateKeyPair' @a
  testEncodeDecode k
  testEncodeDecode pk

@@ -172,51 +171,46 @@ testEncodeDecode x = do

 testX3dh :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
 testX3dh _ = do
-  g <- C.newRandom
-  (pkBob1, pkBob2, e2eBob) <- atomically $ generateE2EParams @a g currentE2EEncryptVersion
-  (pkAlice1, pkAlice2, e2eAlice) <- atomically $ generateE2EParams @a g currentE2EEncryptVersion
+  (pkBob1, pkBob2, e2eBob) <- generateE2EParams @a currentE2EEncryptVersion
+  (pkAlice1, pkAlice2, e2eAlice) <- generateE2EParams @a currentE2EEncryptVersion
  let paramsBob = x3dhSnd pkBob1 pkBob2 e2eAlice
      paramsAlice = x3dhRcv pkAlice1 pkAlice2 e2eBob
  paramsAlice `shouldBe` paramsBob

 testX3dhV1 :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
 testX3dhV1 _ = do
-  g <- C.newRandom
-  (pkBob1, pkBob2, e2eBob) <- atomically $ generateE2EParams @a g 1
-  (pkAlice1, pkAlice2, e2eAlice) <- atomically $ generateE2EParams @a g 1
+  (pkBob1, pkBob2, e2eBob) <- generateE2EParams @a 1
+  (pkAlice1, pkAlice2, e2eAlice) <- generateE2EParams @a 1
  let paramsBob = x3dhSnd pkBob1 pkBob2 e2eAlice
      paramsAlice = x3dhRcv pkAlice1 pkAlice2 e2eBob
  paramsAlice `shouldBe` paramsBob

-(#>) :: (AlgorithmI a, DhAlgorithm a) => (TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys), ByteString) -> TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> Expectation
+(#>) :: (AlgorithmI a, DhAlgorithm a) => (TVar (Ratchet a, SkippedMsgKeys), ByteString) -> TVar (Ratchet a, SkippedMsgKeys) -> Expectation
 (alice, msg) #> bob = do
  Right msg' <- encrypt alice msg
  Decrypted msg'' <- decrypt bob msg'
  msg'' `shouldBe` msg

-withRatchets :: forall a. (AlgorithmI a, DhAlgorithm a) => (TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> IO ()) -> Expectation
+withRatchets :: forall a. (AlgorithmI a, DhAlgorithm a) => (TVar (Ratchet a, SkippedMsgKeys) -> TVar (Ratchet a, SkippedMsgKeys) -> IO ()) -> Expectation
 withRatchets test = do
-  ga <- C.newRandom
-  gb <- C.newRandom
  (a, b) <- initRatchets @a
-  alice <- newTVarIO (ga, a, M.empty)
-  bob <- newTVarIO (gb, b, M.empty)
+  alice <- newTVarIO (a, M.empty)
+  bob <- newTVarIO (b, M.empty)
  test alice bob `shouldReturn` ()

 initRatchets :: (AlgorithmI a, DhAlgorithm a) => IO (Ratchet a, Ratchet a)
 initRatchets = do
-  g <- C.newRandom
-  (pkBob1, pkBob2, e2eBob) <- atomically $ generateE2EParams g currentE2EEncryptVersion
-  (pkAlice1, pkAlice2, e2eAlice) <- atomically $ generateE2EParams g currentE2EEncryptVersion
+  (pkBob1, pkBob2, e2eBob) <- generateE2EParams currentE2EEncryptVersion
+  (pkAlice1, pkAlice2, e2eAlice) <- generateE2EParams currentE2EEncryptVersion
  let paramsBob = x3dhSnd pkBob1 pkBob2 e2eAlice
      paramsAlice = x3dhRcv pkAlice1 pkAlice2 e2eBob
-  (_, pkBob3) <- atomically $ C.generateKeyPair g
+  (_, pkBob3) <- C.generateKeyPair'
  let bob = initSndRatchet supportedE2EEncryptVRange (C.publicKey pkAlice2) pkBob3 paramsBob
      alice = initRcvRatchet supportedE2EEncryptVRange pkAlice2 paramsAlice
  pure (alice, bob)

-encrypt_ :: AlgorithmI a => (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
-encrypt_ (_, rc, _) msg =
+encrypt_ :: AlgorithmI a => (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
+encrypt_ (rc, _) msg =
  runExceptT (rcEncrypt rc paddedMsgLen msg)
    >>= either (pure . Left) checkLength
  where
@@ -224,26 +218,26 @@ encrypt_ (_, rc, _) msg =
      B.length msg' `shouldBe` fullMsgLen
      pure $ Right (msg', rc', SMDNoChange)

-decrypt_ :: (AlgorithmI a, DhAlgorithm a) => (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff))
-decrypt_ (g, rc, smks) msg = runExceptT $ rcDecrypt g rc smks msg
+decrypt_ :: (AlgorithmI a, DhAlgorithm a) => (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff))
+decrypt_ (rc, smks) msg = runExceptT $ rcDecrypt rc smks msg

-encrypt :: AlgorithmI a => TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError ByteString)
+encrypt :: AlgorithmI a => TVar (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError ByteString)
 encrypt = withTVar encrypt_

-decrypt :: (AlgorithmI a, DhAlgorithm a) => TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString))
+decrypt :: (AlgorithmI a, DhAlgorithm a) => TVar (Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString))
 decrypt = withTVar decrypt_

 withTVar ::
  AlgorithmI a =>
-  ((TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either e (r, Ratchet a, SkippedMsgDiff))) ->
-  TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
+  ((Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either e (r, Ratchet a, SkippedMsgDiff))) ->
+  TVar (Ratchet a, SkippedMsgKeys) ->
  ByteString ->
  IO (Either e r)
-withTVar op rcVar msg = do
-  (g, rc, smks) <- readTVarIO rcVar
-  applyDiff smks <$$> (testEncodeDecode rc >> op (g, rc, smks) msg)
+withTVar op rcVar msg =
+  readTVarIO rcVar
+    >>= (\(rc, smks) -> applyDiff smks <$$> (testEncodeDecode rc >> op (rc, smks) msg))
    >>= \case
-      Right (res, rc', smks') -> atomically (writeTVar rcVar (g, rc', smks')) >> pure (Right res)
+      Right (res, rc', smks') -> atomically (writeTVar rcVar (rc', smks')) >> pure (Right res)
      Left e -> pure $ Left e
  where
    applyDiff smks (res, rc', smDiff) = (res, rc', applySMDiff smks smDiff)
@@ -115,45 +115,35 @@ pattern Rcvd :: AgentMsgId -> ACommand 'Agent e
 pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMsgId, msgRcptStatus = MROk}]

 smpCfgVPrev :: ProtocolClientConfig
-smpCfgVPrev = (smpCfg agentCfg) {serverVRange = prevRange $ serverVRange $ smpCfg agentCfg}
-
-smpCfgV1 :: ProtocolClientConfig
-smpCfgV1 = (smpCfg agentCfg) {serverVRange = v1Range}
+smpCfgVPrev = (smpCfg agentCfg) {serverVRange = serverVRangePrev}
+  where
+    serverVRangePrev = prevRange $ serverVRange $ smpCfg agentCfg

 agentCfgVPrev :: AgentConfig
 agentCfgVPrev =
  agentCfg
-    { smpAgentVRange = prevRange $ smpAgentVRange agentCfg,
-      smpClientVRange = prevRange $ smpClientVRange agentCfg,
-      e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg,
+    { smpAgentVRange = smpAgentVRangePrev,
+      smpClientVRange = smpClientVRangePrev,
+      e2eEncryptVRange = e2eEncryptVRangePrev,
      smpCfg = smpCfgVPrev
    }
-
-agentCfgV1 :: AgentConfig
-agentCfgV1 =
-  agentCfg
-    { smpAgentVRange = v1Range,
-      smpClientVRange = v1Range,
-      e2eEncryptVRange = v1Range,
-      smpCfg = smpCfgV1
-    }
+  where
+    smpAgentVRangePrev = prevRange $ smpAgentVRange agentCfg
+    smpClientVRangePrev = prevRange $ smpClientVRange agentCfg
+    e2eEncryptVRangePrev = prevRange $ e2eEncryptVRange agentCfg

 agentCfgRatchetVPrev :: AgentConfig
-agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
-
-agentCfgRatchetV1 :: AgentConfig
-agentCfgRatchetV1 = agentCfg {e2eEncryptVRange = v1Range}
+agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = e2eEncryptVRangePrev}
+  where
+    e2eEncryptVRangePrev = prevRange $ e2eEncryptVRange agentCfg

 prevRange :: VersionRange -> VersionRange
 prevRange vr = vr {maxVersion = maxVersion vr - 1}

-v1Range :: VersionRange
-v1Range = mkVersionRange 1 1
-
 runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation
 runRight_ action = runExceptT action `shouldReturn` Right ()

-runRight :: (Show e, HasCallStack) => ExceptT e IO a -> IO a
+runRight :: HasCallStack => ExceptT AgentErrorType IO a -> IO a
 runRight action =
  runExceptT action >>= \case
    Right x -> pure x
@@ -177,8 +167,6 @@ functionalAPITests t = do
    testMatrix2 t runAgentClientTest
    it "should connect when server with multiple identities is stored" $
      withSmpServer t testServerMultipleIdentities
-    it "should connect with two peers" $
-      withSmpServer t testAgentClient3
  describe "Establishing duplex connection v2, different Ratchet versions" $
    testRatchetMatrix2 t runAgentClientTest
  describe "Establish duplex connection via contact address" $
@@ -227,10 +215,8 @@ functionalAPITests t = do
      it "messages delivered only when polled" $
        withSmpServer t testOnlyCreatePull
  describe "Inactive client disconnection" $ do
-    it "should disconnect clients without subs if they were inactive longer than TTL" $
-      testInactiveNoSubs t
-    it "should NOT disconnect inactive clients when they have subscriptions" $
-      testInactiveWithSubs t
+    it "should disconnect clients if it was inactive longer than TTL" $
+      testInactiveClientDisconnected t
    it "should NOT disconnect active clients" $
      testActiveClientNotDisconnected t
  describe "Suspending agent" $ do
@@ -350,9 +336,6 @@ testMatrix2 t runTest = do
  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 runTest
  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 runTest
  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 runTest
-  it "v1" $ withSmpServer t $ runTestCfg2 agentCfgV1 agentCfgV1 4 runTest
-  it "v1 to current" $ withSmpServer t $ runTestCfg2 agentCfgV1 agentCfg 4 runTest
-  it "current to v1" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgV1 4 runTest

 testRatchetMatrix2 :: ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 t runTest = do
@@ -360,9 +343,6 @@ testRatchetMatrix2 t runTest = do
  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 3 runTest
  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 3 runTest
  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 3 runTest
-  it "ratchet v1" $ withSmpServer t $ runTestCfg2 agentCfgRatchetV1 agentCfgRatchetV1 3 runTest
-  it "ratchets v1 to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetV1 agentCfg 3 runTest
-  it "ratchets current to v1" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetV1 3 runTest

 testServerMatrix2 :: ATransport -> (InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 t runTest = do
@@ -419,32 +399,6 @@ runAgentClientTest alice bob baseId = do
  where
    msgId = subtract baseId

-testAgentClient3 :: HasCallStack => IO ()
-testAgentClient3 = do
-  a <- getSMPAgentClient' agentCfg initAgentServers testDB
-  b <- getSMPAgentClient' agentCfg initAgentServers testDB2
-  c <- getSMPAgentClient' agentCfg initAgentServers testDB3
-  runRight_ $ do
-    (aIdForB, bId) <- makeConnection a b
-    (aIdForC, cId) <- makeConnection a c
-
-    4 <- sendMessage a bId SMP.noMsgFlags "b4"
-    4 <- sendMessage a cId SMP.noMsgFlags "c4"
-    5 <- sendMessage a bId SMP.noMsgFlags "b5"
-    5 <- sendMessage a cId SMP.noMsgFlags "c5"
-    get a =##> \case ("", connId, SENT 4) -> connId == bId || connId == cId; _ -> False
-    get a =##> \case ("", connId, SENT 4) -> connId == bId || connId == cId; _ -> False
-    get a =##> \case ("", connId, SENT 5) -> connId == bId || connId == cId; _ -> False
-    get a =##> \case ("", connId, SENT 5) -> connId == bId || connId == cId; _ -> False
-    get b =##> \case ("", connId, Msg "b4") -> connId == aIdForB; _ -> False
-    ackMessage b aIdForB 4 Nothing
-    get b =##> \case ("", connId, Msg "b5") -> connId == aIdForB; _ -> False
-    ackMessage b aIdForB 5 Nothing
-    get c =##> \case ("", connId, Msg "c4") -> connId == aIdForC; _ -> False
-    ackMessage c aIdForC 4 Nothing
-    get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
-    ackMessage c aIdForC 5 Nothing
-
 runAgentClientContactTest :: HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest alice bob baseId = do
  runRight_ $ do
@@ -565,6 +519,9 @@ testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do
 testAsyncHelloTimeout :: HasCallStack => IO ()
 testAsyncHelloTimeout = do
  -- this test would only work if any of the agent is v1, there is no HELLO timeout in v2
+  let vr11 = mkVersionRange 1 1
+      smpCfgV1 = (smpCfg agentCfg) {serverVRange = vr11}
+      agentCfgV1 = agentCfg {smpAgentVRange = vr11, smpClientVRange = vr11, e2eEncryptVRange = vr11, smpCfg = smpCfgV1}
  withAgentClientsCfg2 agentCfgV1 agentCfg {helloTimeout = 1} $ \alice bob -> runRight_ $ do
    (_, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    disconnectAgentClient alice
@@ -1053,35 +1010,34 @@ testOnlyCreatePull :: IO ()
 testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
-  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
+  getMsg alice bobId
+  Just ("", _, CONF confId _ "bob's connInfo") <- timeout 5_000000 $ get alice
  allowConnection alice bobId confId "alice's connInfo"
  liftIO $ threadDelay 1_000000
-  getMsg bob aliceId $
-    get bob ##> ("", aliceId, INFO "alice's connInfo")
+  getMsg bob aliceId
+  get bob ##> ("", aliceId, INFO "alice's connInfo")
  liftIO $ threadDelay 1_000000
-  getMsg alice bobId $ pure ()
+  getMsg alice bobId
  get alice ##> ("", bobId, CON)
-  getMsg bob aliceId $
-    get bob ##> ("", aliceId, CON)
+  getMsg bob aliceId
+  get bob ##> ("", aliceId, CON)
  -- exchange messages
  4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
  get alice ##> ("", bobId, SENT 4)
-  getMsg bob aliceId $
-    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+  getMsg bob aliceId
+  get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
  ackMessage bob aliceId 4 Nothing
  5 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
  get bob ##> ("", aliceId, SENT 5)
-  getMsg alice bobId $
-    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+  getMsg alice bobId
+  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
  ackMessage alice bobId 5 Nothing
  where
-    getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
-    getMsg c cId action = do
+    getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+    getMsg c cId = do
      liftIO $ noMessages c "nothing should be delivered before GET"
      Just _ <- getConnectionMessage c cId
-      r <- action
-      get c =##> \case ("", cId', MSGNTF _) -> cId == cId'; _ -> False
-      pure r
+      pure ()

 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnection alice bob = makeConnectionForUsers alice 1 bob 1
@@ -1097,26 +1053,14 @@ makeConnectionForUsers alice aliceUserId bob bobUserId = do
  get bob ##> ("", aliceId, CON)
  pure (aliceId, bobId)

-testInactiveNoSubs :: ATransport -> IO ()
-testInactiveNoSubs t = do
+testInactiveClientDisconnected :: ATransport -> IO ()
+testInactiveClientDisconnected t = do
  let cfg' = cfg {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
  withSmpServerConfigOn t cfg' testPort $ \_ -> do
    alice <- getSMPAgentClient' agentCfg initAgentServers testDB
-    runRight_ . void $ createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate -- do not subscribe to pass noSubscriptions check
-    Just (_, _, APC SAENone (CONNECT _ _)) <- timeout 2000000 $ atomically (readTBQueue $ subQ alice)
-    Just (_, _, APC SAENone (DISCONNECT _ _)) <- timeout 5000000 $ atomically (readTBQueue $ subQ alice)
-    disconnectAgentClient alice
-
-testInactiveWithSubs :: ATransport -> IO ()
-testInactiveWithSubs t = do
-  let cfg' = cfg {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
-  withSmpServerConfigOn t cfg' testPort $ \_ -> do
-    alice <- getSMPAgentClient' agentCfg initAgentServers testDB
-    runRight_ . void $ createConnection alice 1 True SCMInvitation Nothing SMSubscribe
-    Nothing <- 800000 `timeout` get alice
-    liftIO $ threadDelay 1200000
-    -- and after 2 sec of inactivity no DOWN is sent as we have a live subscription
-    liftIO $ timeout 1200000 (get alice) `shouldReturn` Nothing
+    runRight_ $ do
+      (connId, _cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
+      nGet alice ##> ("", "", DOWN testSMPServer [connId])
    disconnectAgentClient alice

 testActiveClientNotDisconnected :: ATransport -> IO ()
@@ -1143,8 +1087,8 @@ testActiveClientNotDisconnected t = do
          -- check that nothing is sent from agent
          Nothing <- 800000 `timeout` get alice
          liftIO $ threadDelay 1200000
-          -- and after 2 sec of inactivity no DOWN is sent as we have a live subscription
-          liftIO $ timeout 1200000 (get alice) `shouldReturn` Nothing
+          -- and after 2 sec of inactivity DOWN is sent
+          nGet alice ##> ("", "", DOWN testSMPServer [connId])
    milliseconds ts = systemSeconds ts * 1000 + fromIntegral (systemNanoseconds ts `div` 1000000)

 testSuspendingAgent :: IO ()
@@ -1878,8 +1822,8 @@ testSwitch2ConnectionsAbort1 servers = do

 testCreateQueueAuth :: HasCallStack => (Maybe BasicAuth, Version) -> (Maybe BasicAuth, Version) -> IO Int
 testCreateQueueAuth clnt1 clnt2 = do
-  a <- getClient clnt1 testDB
-  b <- getClient clnt2 testDB2
+  a <- getClient clnt1
+  b <- getClient clnt2
  r <- runRight $ do
    tryError (createConnection a 1 True SCMInvitation Nothing SMSubscribe) >>= \case
      Left (SMP AUTH) -> pure 0
@@ -1900,10 +1844,10 @@ testCreateQueueAuth clnt1 clnt2 = do
  disconnectAgentClient b
  pure r
  where
-    getClient (clntAuth, clntVersion) db =
+    getClient (clntAuth, clntVersion) =
      let servers = initAgentServers {smp = userServers [ProtoServerWithAuth testSMPServer clntAuth]}
          smpCfg = (defaultClientConfig :: ProtocolClientConfig) {serverVRange = mkVersionRange 4 clntVersion}
-       in getSMPAgentClient' agentCfg {smpCfg} servers db
+       in getSMPAgentClient' agentCfg {smpCfg} servers testDB

 testSMPServerConnectionTest :: ATransport -> Maybe BasicAuth -> SMPServerWithAuth -> IO (Maybe ProtocolTestFailure)
 testSMPServerConnectionTest t newQueueBasicAuth srv =
@@ -2105,8 +2049,8 @@ testTwoUsers = withAgentClients2 $ \a b -> do

 getSMPAgentClient' :: AgentConfig -> InitialAgentServers -> FilePath -> IO AgentClient
 getSMPAgentClient' cfg' initServers dbPath = do
-  Right st <- liftIO $ createAgentStore dbPath "" False MCError
-  getSMPAgentClient cfg' initServers st False
+  Right st <- liftIO $ createAgentStore dbPath "" MCError
+  getSMPAgentClient cfg' initServers st

 testServerMultipleIdentities :: HasCallStack => IO ()
 testServerMultipleIdentities =
@@ -178,16 +178,16 @@ testMigration ::
 testMigration (initMs, initTables) (finalMs, confirmModes, tablesOrError) = forM_ confirmModes $ \confirmMode -> do
  r <- randomIO :: IO Word32
  let dpPath = testDB <> show r
-  Right st <- createSQLiteStore dpPath "" False initMs MCError
+  Right st <- createSQLiteStore dpPath "" initMs MCError
  st `shouldHaveTables` initTables
  closeSQLiteStore st
  case tablesOrError of
    Right tables -> do
-      Right st' <- createSQLiteStore dpPath "" False finalMs confirmMode
+      Right st' <- createSQLiteStore dpPath "" finalMs confirmMode
      st' `shouldHaveTables` tables
      closeSQLiteStore st'
    Left e -> do
-      Left e' <- createSQLiteStore dpPath "" False finalMs confirmMode
+      Left e' <- createSQLiteStore dpPath "" finalMs confirmMode
      e `shouldBe` e'
  removeFile dpPath
  where
--- a/Show More
+++ b/Show More
Author	SHA1	Message	Date
IC Rainbow	054edd04ac	WIP: move to cryptonite cbits instead of openssl and haskell-funptrs	2023-10-30 16:01:37 +02:00
IC Rainbow	f9f7781f09	remove sha512 wrapper and use openssl directly	2023-10-30 14:00:24 +02:00
IC Rainbow	533e5737eb	add "ssl" library dep Attempt to fix missing _SHA512 symbol on macos.	2023-10-29 22:04:09 +02:00
Evgeny Poberezkin	27e29e8a43	style	2023-10-29 16:44:17 +00:00
IC Rainbow	18496c3269	Add iOS smoke test at createAgentStore	2023-10-29 16:21:09 +02:00
IC Rainbow	0dd52aea18	pass ChaChaDRG via FunPtr	2023-10-29 16:13:41 +02:00
IC Rainbow	bcd2b99cce	Merge remote-tracking branch 'origin/master' into ep/sntrup761	2023-10-28 19:27:24 +03:00
IC Rainbow	6bbbf0ac4b	Wrap bindings in non-FFI types Test passes with a dummy RNG.	2023-10-28 19:25:44 +03:00
Evgeny Poberezkin	9452450385	it compiles	2023-10-17 23:07:34 +01:00
Evgeny Poberezkin	22c50a77f7	add sntrup761 source	2023-10-17 14:21:54 +01:00