Merge branch 'master' into short-links

* smp server: add created/updated/used date to queues to manage expiration, all: make Map updates strict in value

* remove strict

* remove time precision

* diff

* style

* only update when time changed

CHANGELOG.md

@@ -1,3 +1,82 @@
+# 6.0.3
+
+Agent:
+- fix possible stuck queue rotation (#1290).
+
+SMP server:
+- batch END responses when subscribed client switches to reduce server and client traffic.
+- reduce STM transactions for better performance.
+- add stats for END events and for SUB/DEL event batches.
+- remove "expensive" stats to save memory.
+
+# 6.0.2
+
+SMP agent:
+- fix stuck connection commands when a server is not responding.
+- store query errors, reduce slow query threshold to 1ms.
+
+Notification server:
+- reduce PING interval to 1 minute.
+- fix subscriptions disabled on race condition (only mark subscriptions with END status when received via the active connection).
+
+# 6.0.1
+
+SMP agent:
+- support changing user of the new connection.
+- do not start delivery workers when there are no messages to deliver.
+- enable notifications for all connections.
+- combine database transactions when subscribing.
+
+SMP server:
+- safe compacting of store log.
+- fix possible race when creating client that might lead to memory leak.
+
+Dependencies: upgrade tls to 1.9
+
+# 6.0.0
+
+Version 6.0.0.8
+
+Agent:
+- enabled fast handshake support.
+- batch-send multiple messages in each connection.
+- resume subscriptions as soon as agent moves to foreground or as network connection resumes.
+- "known" servers to determine whether to use SMP proxy.
+- retry on SMP proxy NO_SESSION error.
+- fixes to notification subscriptions.
+- persistent server statistics.
+- better concurrency.
+
+SMP server:
+- reduce threads usage.
+- additional statistics.
+- improve disabling inactive clients.
+- additional control port commands for monitoring.
+
+Notification server:
+- support onion-only SMP servers.
+
+# 5.8.2
+
+Agent:
+- fast handshake support (disabled).
+- new statistics api.
+
+SMP server:
+- fast handshake support (SKEY command).
+- minor changes to reduce memory usage.
+
+# 5.8.1
+
+Agent:
+- API to reconnect one server.
+- Better error handling of file errors and remote control connection errors.
+- Only start uploading file once all chunks were registered on the servers.
+
+SMP server:
+- additional stats for sent message notifications.
+- fix server page layout.
+
 # 5.8.0
 
 Version 5.8.0.10

README.md

@@ -150,7 +150,7 @@ You can install and setup servers automatically using our script:
 
 ```sh
 curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
-&& if echo 'b8cf2be103f21f9461d9a500bcd3db06ab7d01d68871b07f4bd245195cbead1d simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
+&& if echo 'c90886104cd640b2ed64921dba80e90691db36788e8d6dcc13d8f33f92f0ea54 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
 ```
 
 ### Build from source
@@ -208,14 +208,17 @@ On Linux, you can build smp server using Docker.
 
 #### Using your distribution
 
-1. Install [Haskell GHCup](https://www.haskell.org/ghcup/), GHC 8.10.7 and cabal:
+1. Install dependencies and build tools (`GHC`, `cabal` and dev libs):
 
    ```sh
-   curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
-   ghcup install ghc 8.10.7
-   ghcup install cabal
-   ghcup set ghc 8.10.7
-   ghcup set cabal
+   # On Ubuntu. Depending on your distribution, use your package manager to determine package names.
+   sudo apt-get update && apt-get install -y build-essential curl libffi-dev libffi7 libgmp3-dev libgmp10 libncurses-dev libncurses5 libtinfo5 pkg-config zlib1g-dev libnuma-dev libssl-dev
+   export BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
+   export BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.3.0
+   curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+   ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}"
+   ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
+   source ~/.ghcup/env
    ```
 
 2. Build the project:
@@ -224,10 +227,20 @@ On Linux, you can build smp server using Docker.
    git clone https://github.com/simplex-chat/simplexmq
    cd simplexmq
    git checkout stable
-   # On Ubuntu. Depending on your distribution, use your package manager to determine package names.
-   apt-get update && apt-get install -y build-essential libgmp3-dev zlib1g-dev
    cabal update
-   cabal install
+   cabal build exe:smp-server exe:xftp-server
+   ```
+
+3. List compiled binaries:
+
+   `smp-server`
+   ```sh
+   cabal list-bin exe:smp-server
+   ```
+
+   `xftp-server`
+   ```sh
+   cabal list-bin exe:xftp-server 
    ```
 
 - Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.

apps/ntf-server/Main.hs

@@ -15,7 +15,7 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 main :: IO ()
 main = do
-  setLogLevel LogDebug -- change to LogError in production
+  setLogLevel LogInfo
   cfgPath <- getEnvPath "NTF_SERVER_CFG_PATH" defaultCfgPath
   logPath <- getEnvPath "NTF_SERVER_LOG_PATH" defaultLogPath
   withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath

apps/smp-server/static/index.html

@@ -15,6 +15,12 @@
   <link rel="stylesheet" href="/media/style.css">
 
   <style>
+    body,
+    html {
+      width: 100%;
+      overflow-x: hidden;
+    }
+
     table#config {
       border-collapse: collapse;
       margin-bottom: 4px;
@@ -42,6 +48,17 @@
       }
     }
 
+    @media screen and (max-width: 440px) {
+      table {
+        width: 100%;
+        table-layout: fixed;
+      }
+
+      tr td:not(:last-child) {
+        width: 40%;
+      }
+    }
+
     .dark tr td:not(:last-child) {
       color: #fff;
     }

apps/smp-server/static/media/style.css

@@ -50,6 +50,10 @@ img {
   /* For Internet Explorer and Edge */
 }
 
+a{
+  word-wrap: break-word;
+}
+
 /* NEW SITE */
 .container,
 .container-fluid,

cbits/tweetnacl.c

@@ -1,814 +0,0 @@
-#include "tweetnacl.h"
-#define FOR(i,n) for (i = 0;i < n;++i)
-#define sv static void
-
-typedef unsigned char u8;
-typedef unsigned long u32;
-typedef unsigned long long u64;
-typedef long long i64;
-typedef i64 gf[16];
-// extern void randombytes(u8 *,u64);
-// fudge unused function
-#include "string.h"
-static void randombytes(u8 * dst, u64 len) {
-  memset(dst, 42, len);
-}
-
-static const u8
-  _0[16],
-  _9[32] = {9};
-static const gf
-  gf0,
-  gf1 = {1},
-  _121665 = {0xDB41,1},
-  D = {0x78a3, 0x1359, 0x4dca, 0x75eb, 0xd8ab, 0x4141, 0x0a4d, 0x0070, 0xe898, 0x7779, 0x4079, 0x8cc7, 0xfe73, 0x2b6f, 0x6cee, 0x5203},
-  D2 = {0xf159, 0x26b2, 0x9b94, 0xebd6, 0xb156, 0x8283, 0x149a, 0x00e0, 0xd130, 0xeef3, 0x80f2, 0x198e, 0xfce7, 0x56df, 0xd9dc, 0x2406},
-  X = {0xd51a, 0x8f25, 0x2d60, 0xc956, 0xa7b2, 0x9525, 0xc760, 0x692c, 0xdc5c, 0xfdd6, 0xe231, 0xc0a4, 0x53fe, 0xcd6e, 0x36d3, 0x2169},
-  Y = {0x6658, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666},
-  I = {0xa0b0, 0x4a0e, 0x1b27, 0xc4ee, 0xe478, 0xad2f, 0x1806, 0x2f43, 0xd7a7, 0x3dfb, 0x0099, 0x2b4d, 0xdf0b, 0x4fc1, 0x2480, 0x2b83};
-
-static u32 L32(u32 x,int c) { return (x << c) | ((x&0xffffffff) >> (32 - c)); }
-
-static u32 ld32(const u8 *x)
-{
-  u32 u = x[3];
-  u = (u<<8)|x[2];
-  u = (u<<8)|x[1];
-  return (u<<8)|x[0];
-}
-
-static u64 dl64(const u8 *x)
-{
-  u64 i,u=0;
-  FOR(i,8) u=(u<<8)|x[i];
-  return u;
-}
-
-sv st32(u8 *x,u32 u)
-{
-  int i;
-  FOR(i,4) { x[i] = u; u >>= 8; }
-}
-
-sv ts64(u8 *x,u64 u)
-{
-  int i;
-  for (i = 7;i >= 0;--i) { x[i] = u; u >>= 8; }
-}
-
-static int vn(const u8 *x,const u8 *y,int n)
-{
-  u32 i,d = 0;
-  FOR(i,n) d |= x[i]^y[i];
-  return (1 & ((d - 1) >> 8)) - 1;
-}
-
-int crypto_verify_16(const u8 *x,const u8 *y)
-{
-  return vn(x,y,16);
-}
-
-int crypto_verify_32(const u8 *x,const u8 *y)
-{
-  return vn(x,y,32);
-}
-
-sv core(u8 *out,const u8 *in,const u8 *k,const u8 *c,int h)
-{
-  u32 w[16],x[16],y[16],t[4];
-  int i,j,m;
-
-  FOR(i,4) {
-    x[5*i] = ld32(c+4*i);
-    x[1+i] = ld32(k+4*i);
-    x[6+i] = ld32(in+4*i);
-    x[11+i] = ld32(k+16+4*i);
-  }
-
-  FOR(i,16) y[i] = x[i];
-
-  FOR(i,20) {
-    FOR(j,4) {
-      FOR(m,4) t[m] = x[(5*j+4*m)%16];
-      t[1] ^= L32(t[0]+t[3], 7);
-      t[2] ^= L32(t[1]+t[0], 9);
-      t[3] ^= L32(t[2]+t[1],13);
-      t[0] ^= L32(t[3]+t[2],18);
-      FOR(m,4) w[4*j+(j+m)%4] = t[m];
-    }
-    FOR(m,16) x[m] = w[m];
-  }
-
-  if (h) {
-    FOR(i,16) x[i] += y[i];
-    FOR(i,4) {
-      x[5*i] -= ld32(c+4*i);
-      x[6+i] -= ld32(in+4*i);
-    }
-    FOR(i,4) {
-      st32(out+4*i,x[5*i]);
-      st32(out+16+4*i,x[6+i]);
-    }
-  } else
-    FOR(i,16) st32(out + 4 * i,x[i] + y[i]);
-}
-
-int crypto_core_salsa20(u8 *out,const u8 *in,const u8 *k,const u8 *c)
-{
-  core(out,in,k,c,0);
-  return 0;
-}
-
-int crypto_core_hsalsa20(u8 *out,const u8 *in,const u8 *k,const u8 *c)
-{
-  core(out,in,k,c,1);
-  return 0;
-}
-
-static const u8 sigma[16] = "expand 32-byte k";
-
-int crypto_stream_salsa20_xor(u8 *c,const u8 *m,u64 b,const u8 *n,const u8 *k)
-{
-  u8 z[16],x[64];
-  u32 u,i;
-  if (!b) return 0;
-  FOR(i,16) z[i] = 0;
-  FOR(i,8) z[i] = n[i];
-  while (b >= 64) {
-    crypto_core_salsa20(x,z,k,sigma);
-    FOR(i,64) c[i] = (m?m[i]:0) ^ x[i];
-    u = 1;
-    for (i = 8;i < 16;++i) {
-      u += (u32) z[i];
-      z[i] = u;
-      u >>= 8;
-    }
-    b -= 64;
-    c += 64;
-    if (m) m += 64;
-  }
-  if (b) {
-    crypto_core_salsa20(x,z,k,sigma);
-    FOR(i,b) c[i] = (m?m[i]:0) ^ x[i];
-  }
-  return 0;
-}
-
-int crypto_stream_salsa20(u8 *c,u64 d,const u8 *n,const u8 *k)
-{
-  return crypto_stream_salsa20_xor(c,0,d,n,k);
-}
-
-int crypto_stream(u8 *c,u64 d,const u8 *n,const u8 *k)
-{
-  u8 s[32];
-  crypto_core_hsalsa20(s,n,k,sigma);
-  return crypto_stream_salsa20(c,d,n+16,s);
-}
-
-int crypto_stream_xor(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
-{
-  u8 s[32];
-  crypto_core_hsalsa20(s,n,k,sigma);
-  return crypto_stream_salsa20_xor(c,m,d,n+16,s);
-}
-
-sv add1305(u32 *h,const u32 *c)
-{
-  u32 j,u = 0;
-  FOR(j,17) {
-    u += h[j] + c[j];
-    h[j] = u & 255;
-    u >>= 8;
-  }
-}
-
-static const u32 minusp[17] = {
-  5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 252
-} ;
-
-int crypto_onetimeauth(u8 *out,const u8 *m,u64 n,const u8 *k)
-{
-  u32 s,i,j,u,x[17],r[17],h[17],c[17],g[17];
-
-  FOR(j,17) r[j]=h[j]=0;
-  FOR(j,16) r[j]=k[j];
-  r[3]&=15;
-  r[4]&=252;
-  r[7]&=15;
-  r[8]&=252;
-  r[11]&=15;
-  r[12]&=252;
-  r[15]&=15;
-
-  while (n > 0) {
-    FOR(j,17) c[j] = 0;
-    for (j = 0;(j < 16) && (j < n);++j) c[j] = m[j];
-    c[j] = 1;
-    m += j; n -= j;
-    add1305(h,c);
-    FOR(i,17) {
-      x[i] = 0;
-      FOR(j,17) x[i] += h[j] * ((j <= i) ? r[i - j] : 320 * r[i + 17 - j]);
-    }
-    FOR(i,17) h[i] = x[i];
-    u = 0;
-    FOR(j,16) {
-      u += h[j];
-      h[j] = u & 255;
-      u >>= 8;
-    }
-    u += h[16]; h[16] = u & 3;
-    u = 5 * (u >> 2);
-    FOR(j,16) {
-      u += h[j];
-      h[j] = u & 255;
-      u >>= 8;
-    }
-    u += h[16]; h[16] = u;
-  }
-
-  FOR(j,17) g[j] = h[j];
-  add1305(h,minusp);
-  s = -(h[16] >> 7);
-  FOR(j,17) h[j] ^= s & (g[j] ^ h[j]);
-
-  FOR(j,16) c[j] = k[j + 16];
-  c[16] = 0;
-  add1305(h,c);
-  FOR(j,16) out[j] = h[j];
-  return 0;
-}
-
-int crypto_onetimeauth_verify(const u8 *h,const u8 *m,u64 n,const u8 *k)
-{
-  u8 x[16];
-  crypto_onetimeauth(x,m,n,k);
-  return crypto_verify_16(h,x);
-}
-
-int crypto_secretbox(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
-{
-  int i;
-  if (d < 32) return -1;
-  crypto_stream_xor(c,m,d,n,k);
-  crypto_onetimeauth(c + 16,c + 32,d - 32,c);
-  FOR(i,16) c[i] = 0;
-  return 0;
-}
-
-int crypto_secretbox_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k)
-{
-  int i;
-  u8 x[32];
-  if (d < 32) return -1;
-  crypto_stream(x,32,n,k);
-  if (crypto_onetimeauth_verify(c + 16,c + 32,d - 32,x) != 0) return -1;
-  crypto_stream_xor(m,c,d,n,k);
-  FOR(i,32) m[i] = 0;
-  return 0;
-}
-
-sv set25519(gf r, const gf a)
-{
-  int i;
-  FOR(i,16) r[i]=a[i];
-}
-
-sv car25519(gf o)
-{
-  int i;
-  i64 c;
-  FOR(i,16) {
-    o[i]+=(1LL<<16);
-    c=o[i]>>16;
-    o[(i+1)*(i<15)]+=c-1+37*(c-1)*(i==15);
-    o[i]-=c<<16;
-  }
-}
-
-sv sel25519(gf p,gf q,int b)
-{
-  i64 t,i,c=~(b-1);
-  FOR(i,16) {
-    t= c&(p[i]^q[i]);
-    p[i]^=t;
-    q[i]^=t;
-  }
-}
-
-sv pack25519(u8 *o,const gf n)
-{
-  int i,j,b;
-  gf m,t;
-  FOR(i,16) t[i]=n[i];
-  car25519(t);
-  car25519(t);
-  car25519(t);
-  FOR(j,2) {
-    m[0]=t[0]-0xffed;
-    for(i=1;i<15;i++) {
-      m[i]=t[i]-0xffff-((m[i-1]>>16)&1);
-      m[i-1]&=0xffff;
-    }
-    m[15]=t[15]-0x7fff-((m[14]>>16)&1);
-    b=(m[15]>>16)&1;
-    m[14]&=0xffff;
-    sel25519(t,m,1-b);
-  }
-  FOR(i,16) {
-    o[2*i]=t[i]&0xff;
-    o[2*i+1]=t[i]>>8;
-  }
-}
-
-static int neq25519(const gf a, const gf b)
-{
-  u8 c[32],d[32];
-  pack25519(c,a);
-  pack25519(d,b);
-  return crypto_verify_32(c,d);
-}
-
-static u8 par25519(const gf a)
-{
-  u8 d[32];
-  pack25519(d,a);
-  return d[0]&1;
-}
-
-sv unpack25519(gf o, const u8 *n)
-{
-  int i;
-  FOR(i,16) o[i]=n[2*i]+((i64)n[2*i+1]<<8);
-  o[15]&=0x7fff;
-}
-
-sv A(gf o,const gf a,const gf b)
-{
-  int i;
-  FOR(i,16) o[i]=a[i]+b[i];
-}
-
-sv Z(gf o,const gf a,const gf b)
-{
-  int i;
-  FOR(i,16) o[i]=a[i]-b[i];
-}
-
-sv M(gf o,const gf a,const gf b)
-{
-  i64 i,j,t[31];
-  FOR(i,31) t[i]=0;
-  FOR(i,16) FOR(j,16) t[i+j]+=a[i]*b[j];
-  FOR(i,15) t[i]+=38*t[i+16];
-  FOR(i,16) o[i]=t[i];
-  car25519(o);
-  car25519(o);
-}
-
-sv S(gf o,const gf a)
-{
-  M(o,a,a);
-}
-
-sv inv25519(gf o,const gf i)
-{
-  gf c;
-  int a;
-  FOR(a,16) c[a]=i[a];
-  for(a=253;a>=0;a--) {
-    S(c,c);
-    if(a!=2&&a!=4) M(c,c,i);
-  }
-  FOR(a,16) o[a]=c[a];
-}
-
-sv pow2523(gf o,const gf i)
-{
-  gf c;
-  int a;
-  FOR(a,16) c[a]=i[a];
-  for(a=250;a>=0;a--) {
-    S(c,c);
-    if(a!=1) M(c,c,i);
-  }
-  FOR(a,16) o[a]=c[a];
-}
-
-int crypto_scalarmult(u8 *q,const u8 *n,const u8 *p)
-{
-  u8 z[32];
-  i64 x[80],r,i;
-  gf a,b,c,d,e,f;
-  FOR(i,31) z[i]=n[i];
-  z[31]=(n[31]&127)|64;
-  z[0]&=248;
-  unpack25519(x,p);
-  FOR(i,16) {
-    b[i]=x[i];
-    d[i]=a[i]=c[i]=0;
-  }
-  a[0]=d[0]=1;
-  for(i=254;i>=0;--i) {
-    r=(z[i>>3]>>(i&7))&1;
-    sel25519(a,b,r);
-    sel25519(c,d,r);
-    A(e,a,c);
-    Z(a,a,c);
-    A(c,b,d);
-    Z(b,b,d);
-    S(d,e);
-    S(f,a);
-    M(a,c,a);
-    M(c,b,e);
-    A(e,a,c);
-    Z(a,a,c);
-    S(b,a);
-    Z(c,d,f);
-    M(a,c,_121665);
-    A(a,a,d);
-    M(c,c,a);
-    M(a,d,f);
-    M(d,b,x);
-    S(b,e);
-    sel25519(a,b,r);
-    sel25519(c,d,r);
-  }
-  FOR(i,16) {
-    x[i+16]=a[i];
-    x[i+32]=c[i];
-    x[i+48]=b[i];
-    x[i+64]=d[i];
-  }
-  inv25519(x+32,x+32);
-  M(x+16,x+16,x+32);
-  pack25519(q,x+16);
-  return 0;
-}
-
-int crypto_scalarmult_base(u8 *q,const u8 *n)
-{ 
-  return crypto_scalarmult(q,n,_9);
-}
-
-int crypto_box_keypair(u8 *y,u8 *x)
-{
-  randombytes(x,32);
-  return crypto_scalarmult_base(y,x);
-}
-
-int crypto_box_beforenm(u8 *k,const u8 *y,const u8 *x)
-{
-  u8 s[32];
-  crypto_scalarmult(s,x,y);
-  return crypto_core_hsalsa20(k,_0,s,sigma);
-}
-
-int crypto_box_afternm(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
-{
-  return crypto_secretbox(c,m,d,n,k);
-}
-
-int crypto_box_open_afternm(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *k)
-{
-  return crypto_secretbox_open(m,c,d,n,k);
-}
-
-int crypto_box(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *y,const u8 *x)
-{
-  u8 k[32];
-  crypto_box_beforenm(k,y,x);
-  return crypto_box_afternm(c,m,d,n,k);
-}
-
-int crypto_box_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *y,const u8 *x)
-{
-  u8 k[32];
-  crypto_box_beforenm(k,y,x);
-  return crypto_box_open_afternm(m,c,d,n,k);
-}
-
-static u64 R(u64 x,int c) { return (x >> c) | (x << (64 - c)); }
-static u64 Ch(u64 x,u64 y,u64 z) { return (x & y) ^ (~x & z); }
-static u64 Maj(u64 x,u64 y,u64 z) { return (x & y) ^ (x & z) ^ (y & z); }
-static u64 Sigma0(u64 x) { return R(x,28) ^ R(x,34) ^ R(x,39); }
-static u64 Sigma1(u64 x) { return R(x,14) ^ R(x,18) ^ R(x,41); }
-static u64 sigma0(u64 x) { return R(x, 1) ^ R(x, 8) ^ (x >> 7); }
-static u64 sigma1(u64 x) { return R(x,19) ^ R(x,61) ^ (x >> 6); }
-
-static const u64 K[80] = 
-{
-  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
-};
-
-int crypto_hashblocks(u8 *x,const u8 *m,u64 n)
-{
-  u64 z[8],b[8],a[8],w[16],t;
-  int i,j;
-
-  FOR(i,8) z[i] = a[i] = dl64(x + 8 * i);
-
-  while (n >= 128) {
-    FOR(i,16) w[i] = dl64(m + 8 * i);
-
-    FOR(i,80) {
-      FOR(j,8) b[j] = a[j];
-      t = a[7] + Sigma1(a[4]) + Ch(a[4],a[5],a[6]) + K[i] + w[i%16];
-      b[7] = t + Sigma0(a[0]) + Maj(a[0],a[1],a[2]);
-      b[3] += t;
-      FOR(j,8) a[(j+1)%8] = b[j];
-      if (i%16 == 15)
-	FOR(j,16)
-	  w[j] += w[(j+9)%16] + sigma0(w[(j+1)%16]) + sigma1(w[(j+14)%16]);
-    }
-
-    FOR(i,8) { a[i] += z[i]; z[i] = a[i]; }
-
-    m += 128;
-    n -= 128;
-  }
-
-  FOR(i,8) ts64(x+8*i,z[i]);
-
-  return n;
-}
-
-static const u8 iv[64] = {
-  0x6a,0x09,0xe6,0x67,0xf3,0xbc,0xc9,0x08,
-  0xbb,0x67,0xae,0x85,0x84,0xca,0xa7,0x3b,
-  0x3c,0x6e,0xf3,0x72,0xfe,0x94,0xf8,0x2b,
-  0xa5,0x4f,0xf5,0x3a,0x5f,0x1d,0x36,0xf1,
-  0x51,0x0e,0x52,0x7f,0xad,0xe6,0x82,0xd1,
-  0x9b,0x05,0x68,0x8c,0x2b,0x3e,0x6c,0x1f,
-  0x1f,0x83,0xd9,0xab,0xfb,0x41,0xbd,0x6b,
-  0x5b,0xe0,0xcd,0x19,0x13,0x7e,0x21,0x79
-} ;
-
-int crypto_hash(u8 *out,const u8 *m,u64 n)
-{
-  u8 h[64],x[256];
-  u64 i,b = n;
-
-  FOR(i,64) h[i] = iv[i];
-
-  crypto_hashblocks(h,m,n);
-  m += n;
-  n &= 127;
-  m -= n;
-
-  FOR(i,256) x[i] = 0;
-  FOR(i,n) x[i] = m[i];
-  x[n] = 128;
-
-  n = 256-128*(n<112);
-  x[n-9] = b >> 61;
-  ts64(x+n-8,b<<3);
-  crypto_hashblocks(h,x,n);
-
-  FOR(i,64) out[i] = h[i];
-
-  return 0;
-}
-
-sv add(gf p[4],gf q[4])
-{
-  gf a,b,c,d,t,e,f,g,h;
-  
-  Z(a, p[1], p[0]);
-  Z(t, q[1], q[0]);
-  M(a, a, t);
-  A(b, p[0], p[1]);
-  A(t, q[0], q[1]);
-  M(b, b, t);
-  M(c, p[3], q[3]);
-  M(c, c, D2);
-  M(d, p[2], q[2]);
-  A(d, d, d);
-  Z(e, b, a);
-  Z(f, d, c);
-  A(g, d, c);
-  A(h, b, a);
-
-  M(p[0], e, f);
-  M(p[1], h, g);
-  M(p[2], g, f);
-  M(p[3], e, h);
-}
-
-sv cswap(gf p[4],gf q[4],u8 b)
-{
-  int i;
-  FOR(i,4)
-    sel25519(p[i],q[i],b);
-}
-
-sv pack(u8 *r,gf p[4])
-{
-  gf tx, ty, zi;
-  inv25519(zi, p[2]); 
-  M(tx, p[0], zi);
-  M(ty, p[1], zi);
-  pack25519(r, ty);
-  r[31] ^= par25519(tx) << 7;
-}
-
-sv scalarmult(gf p[4],gf q[4],const u8 *s)
-{
-  int i;
-  set25519(p[0],gf0);
-  set25519(p[1],gf1);
-  set25519(p[2],gf1);
-  set25519(p[3],gf0);
-  for (i = 255;i >= 0;--i) {
-    u8 b = (s[i/8]>>(i&7))&1;
-    cswap(p,q,b);
-    add(q,p);
-    add(p,p);
-    cswap(p,q,b);
-  }
-}
-
-sv scalarbase(gf p[4],const u8 *s)
-{
-  gf q[4];
-  set25519(q[0],X);
-  set25519(q[1],Y);
-  set25519(q[2],gf1);
-  M(q[3],X,Y);
-  scalarmult(p,q,s);
-}
-
-int crypto_sign_keypair(u8 *pk, u8 *sk)
-{
-  u8 d[64];
-  gf p[4];
-  int i;
-
-  randombytes(sk, 32);
-  crypto_hash(d, sk, 32);
-  d[0] &= 248;
-  d[31] &= 127;
-  d[31] |= 64;
-
-  scalarbase(p,d);
-  pack(pk,p);
-
-  FOR(i,32) sk[32 + i] = pk[i];
-  return 0;
-}
-
-static const u64 L[32] = {0xed, 0xd3, 0xf5, 0x5c, 0x1a, 0x63, 0x12, 0x58, 0xd6, 0x9c, 0xf7, 0xa2, 0xde, 0xf9, 0xde, 0x14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0x10};
-
-sv modL(u8 *r,i64 x[64])
-{
-  i64 carry,i,j;
-  for (i = 63;i >= 32;--i) {
-    carry = 0;
-    for (j = i - 32;j < i - 12;++j) {
-      x[j] += carry - 16 * x[i] * L[j - (i - 32)];
-      carry = (x[j] + 128) >> 8;
-      x[j] -= carry << 8;
-    }
-    x[j] += carry;
-    x[i] = 0;
-  }
-  carry = 0;
-  FOR(j,32) {
-    x[j] += carry - (x[31] >> 4) * L[j];
-    carry = x[j] >> 8;
-    x[j] &= 255;
-  }
-  FOR(j,32) x[j] -= carry * L[j];
-  FOR(i,32) {
-    x[i+1] += x[i] >> 8;
-    r[i] = x[i] & 255;
-  }
-}
-
-sv reduce(u8 *r)
-{
-  i64 x[64],i;
-  FOR(i,64) x[i] = (u64) r[i];
-  FOR(i,64) r[i] = 0;
-  modL(r,x);
-}
-
-int crypto_sign(u8 *sm,u64 *smlen,const u8 *m,u64 n,const u8 *sk)
-{
-  u8 d[64],h[64],r[64];
-  i64 i,j,x[64];
-  gf p[4];
-
-  crypto_hash(d, sk, 32);
-  d[0] &= 248;
-  d[31] &= 127;
-  d[31] |= 64;
-
-  *smlen = n+64;
-  FOR(i,n) sm[64 + i] = m[i];
-  FOR(i,32) sm[32 + i] = d[32 + i];
-
-  crypto_hash(r, sm+32, n+32);
-  reduce(r);
-  scalarbase(p,r);
-  pack(sm,p);
-
-  FOR(i,32) sm[i+32] = sk[i+32];
-  crypto_hash(h,sm,n + 64);
-  reduce(h);
-
-  FOR(i,64) x[i] = 0;
-  FOR(i,32) x[i] = (u64) r[i];
-  FOR(i,32) FOR(j,32) x[i+j] += h[i] * (u64) d[j];
-  modL(sm + 32,x);
-
-  return 0;
-}
-
-static int unpackneg(gf r[4],const u8 p[32])
-{
-  gf t, chk, num, den, den2, den4, den6;
-  set25519(r[2],gf1);
-  unpack25519(r[1],p);
-  S(num,r[1]);
-  M(den,num,D);
-  Z(num,num,r[2]);
-  A(den,r[2],den);
-
-  S(den2,den);
-  S(den4,den2);
-  M(den6,den4,den2);
-  M(t,den6,num);
-  M(t,t,den);
-
-  pow2523(t,t);
-  M(t,t,num);
-  M(t,t,den);
-  M(t,t,den);
-  M(r[0],t,den);
-
-  S(chk,r[0]);
-  M(chk,chk,den);
-  if (neq25519(chk, num)) M(r[0],r[0],I);
-
-  S(chk,r[0]);
-  M(chk,chk,den);
-  if (neq25519(chk, num)) return -1;
-
-  if (par25519(r[0]) == (p[31]>>7)) Z(r[0],gf0,r[0]);
-
-  M(r[3],r[0],r[1]);
-  return 0;
-}
-
-int crypto_sign_open(u8 *m,u64 *mlen,const u8 *sm,u64 n,const u8 *pk)
-{
-  int i;
-  u8 t[32],h[64];
-  gf p[4],q[4];
-
-  *mlen = -1;
-  if (n < 64) return -1;
-
-  if (unpackneg(q,pk)) return -1;
-
-  FOR(i,n) m[i] = sm[i];
-  FOR(i,32) m[i+32] = pk[i];
-  crypto_hash(h,m,n);
-  reduce(h);
-  scalarmult(p,q,h);
-
-  scalarbase(q,sm + 32);
-  add(p,q);
-  pack(t,p);
-
-  n -= 64;
-  if (crypto_verify_32(sm, t)) {
-    FOR(i,n) m[i] = 0;
-    return -1;
-  }
-
-  FOR(i,n) m[i] = sm[i + 64];
-  *mlen = n;
-  return 0;
-}

cbits/tweetnacl.h

@@ -1,272 +0,0 @@
-#ifndef TWEETNACL_H
-#define TWEETNACL_H
-#define crypto_auth_PRIMITIVE "hmacsha512256"
-#define crypto_auth crypto_auth_hmacsha512256
-#define crypto_auth_verify crypto_auth_hmacsha512256_verify
-#define crypto_auth_BYTES crypto_auth_hmacsha512256_BYTES
-#define crypto_auth_KEYBYTES crypto_auth_hmacsha512256_KEYBYTES
-#define crypto_auth_IMPLEMENTATION crypto_auth_hmacsha512256_IMPLEMENTATION
-#define crypto_auth_VERSION crypto_auth_hmacsha512256_VERSION
-#define crypto_auth_hmacsha512256_tweet_BYTES 32
-#define crypto_auth_hmacsha512256_tweet_KEYBYTES 32
-extern int crypto_auth_hmacsha512256_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
-extern int crypto_auth_hmacsha512256_tweet_verify(const unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
-#define crypto_auth_hmacsha512256_tweet_VERSION "-"
-#define crypto_auth_hmacsha512256 crypto_auth_hmacsha512256_tweet
-#define crypto_auth_hmacsha512256_verify crypto_auth_hmacsha512256_tweet_verify
-#define crypto_auth_hmacsha512256_BYTES crypto_auth_hmacsha512256_tweet_BYTES
-#define crypto_auth_hmacsha512256_KEYBYTES crypto_auth_hmacsha512256_tweet_KEYBYTES
-#define crypto_auth_hmacsha512256_VERSION crypto_auth_hmacsha512256_tweet_VERSION
-#define crypto_auth_hmacsha512256_IMPLEMENTATION "crypto_auth/hmacsha512256/tweet"
-#define crypto_box_PRIMITIVE "curve25519xsalsa20poly1305"
-#define crypto_box crypto_box_curve25519xsalsa20poly1305
-#define crypto_box_open crypto_box_curve25519xsalsa20poly1305_open
-#define crypto_box_keypair crypto_box_curve25519xsalsa20poly1305_keypair
-#define crypto_box_beforenm crypto_box_curve25519xsalsa20poly1305_beforenm
-#define crypto_box_afternm crypto_box_curve25519xsalsa20poly1305_afternm
-#define crypto_box_open_afternm crypto_box_curve25519xsalsa20poly1305_open_afternm
-#define crypto_box_PUBLICKEYBYTES crypto_box_curve25519xsalsa20poly1305_PUBLICKEYBYTES
-#define crypto_box_SECRETKEYBYTES crypto_box_curve25519xsalsa20poly1305_SECRETKEYBYTES
-#define crypto_box_BEFORENMBYTES crypto_box_curve25519xsalsa20poly1305_BEFORENMBYTES
-#define crypto_box_NONCEBYTES crypto_box_curve25519xsalsa20poly1305_NONCEBYTES
-#define crypto_box_ZEROBYTES crypto_box_curve25519xsalsa20poly1305_ZEROBYTES
-#define crypto_box_BOXZEROBYTES crypto_box_curve25519xsalsa20poly1305_BOXZEROBYTES
-#define crypto_box_IMPLEMENTATION crypto_box_curve25519xsalsa20poly1305_IMPLEMENTATION
-#define crypto_box_VERSION crypto_box_curve25519xsalsa20poly1305_VERSION
-#define crypto_box_curve25519xsalsa20poly1305_tweet_PUBLICKEYBYTES 32
-#define crypto_box_curve25519xsalsa20poly1305_tweet_SECRETKEYBYTES 32
-#define crypto_box_curve25519xsalsa20poly1305_tweet_BEFORENMBYTES 32
-#define crypto_box_curve25519xsalsa20poly1305_tweet_NONCEBYTES 24
-#define crypto_box_curve25519xsalsa20poly1305_tweet_ZEROBYTES 32
-#define crypto_box_curve25519xsalsa20poly1305_tweet_BOXZEROBYTES 16
-extern int crypto_box_curve25519xsalsa20poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *,const unsigned char *);
-extern int crypto_box_curve25519xsalsa20poly1305_tweet_open(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *,const unsigned char *);
-extern int crypto_box_curve25519xsalsa20poly1305_tweet_keypair(unsigned char *,unsigned char *);
-extern int crypto_box_curve25519xsalsa20poly1305_tweet_beforenm(unsigned char *,const unsigned char *,const unsigned char *);
-extern int crypto_box_curve25519xsalsa20poly1305_tweet_afternm(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-extern int crypto_box_curve25519xsalsa20poly1305_tweet_open_afternm(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-#define crypto_box_curve25519xsalsa20poly1305_tweet_VERSION "-"
-#define crypto_box_curve25519xsalsa20poly1305 crypto_box_curve25519xsalsa20poly1305_tweet
-#define crypto_box_curve25519xsalsa20poly1305_open crypto_box_curve25519xsalsa20poly1305_tweet_open
-#define crypto_box_curve25519xsalsa20poly1305_keypair crypto_box_curve25519xsalsa20poly1305_tweet_keypair
-#define crypto_box_curve25519xsalsa20poly1305_beforenm crypto_box_curve25519xsalsa20poly1305_tweet_beforenm
-#define crypto_box_curve25519xsalsa20poly1305_afternm crypto_box_curve25519xsalsa20poly1305_tweet_afternm
-#define crypto_box_curve25519xsalsa20poly1305_open_afternm crypto_box_curve25519xsalsa20poly1305_tweet_open_afternm
-#define crypto_box_curve25519xsalsa20poly1305_PUBLICKEYBYTES crypto_box_curve25519xsalsa20poly1305_tweet_PUBLICKEYBYTES
-#define crypto_box_curve25519xsalsa20poly1305_SECRETKEYBYTES crypto_box_curve25519xsalsa20poly1305_tweet_SECRETKEYBYTES
-#define crypto_box_curve25519xsalsa20poly1305_BEFORENMBYTES crypto_box_curve25519xsalsa20poly1305_tweet_BEFORENMBYTES
-#define crypto_box_curve25519xsalsa20poly1305_NONCEBYTES crypto_box_curve25519xsalsa20poly1305_tweet_NONCEBYTES
-#define crypto_box_curve25519xsalsa20poly1305_ZEROBYTES crypto_box_curve25519xsalsa20poly1305_tweet_ZEROBYTES
-#define crypto_box_curve25519xsalsa20poly1305_BOXZEROBYTES crypto_box_curve25519xsalsa20poly1305_tweet_BOXZEROBYTES
-#define crypto_box_curve25519xsalsa20poly1305_VERSION crypto_box_curve25519xsalsa20poly1305_tweet_VERSION
-#define crypto_box_curve25519xsalsa20poly1305_IMPLEMENTATION "crypto_box/curve25519xsalsa20poly1305/tweet"
-#define crypto_core_PRIMITIVE "salsa20"
-#define crypto_core crypto_core_salsa20
-#define crypto_core_OUTPUTBYTES crypto_core_salsa20_OUTPUTBYTES
-#define crypto_core_INPUTBYTES crypto_core_salsa20_INPUTBYTES
-#define crypto_core_KEYBYTES crypto_core_salsa20_KEYBYTES
-#define crypto_core_CONSTBYTES crypto_core_salsa20_CONSTBYTES
-#define crypto_core_IMPLEMENTATION crypto_core_salsa20_IMPLEMENTATION
-#define crypto_core_VERSION crypto_core_salsa20_VERSION
-#define crypto_core_salsa20_tweet_OUTPUTBYTES 64
-#define crypto_core_salsa20_tweet_INPUTBYTES 16
-#define crypto_core_salsa20_tweet_KEYBYTES 32
-#define crypto_core_salsa20_tweet_CONSTBYTES 16
-extern int crypto_core_salsa20_tweet(unsigned char *,const unsigned char *,const unsigned char *,const unsigned char *);
-#define crypto_core_salsa20_tweet_VERSION "-"
-#define crypto_core_salsa20 crypto_core_salsa20_tweet
-#define crypto_core_salsa20_OUTPUTBYTES crypto_core_salsa20_tweet_OUTPUTBYTES
-#define crypto_core_salsa20_INPUTBYTES crypto_core_salsa20_tweet_INPUTBYTES
-#define crypto_core_salsa20_KEYBYTES crypto_core_salsa20_tweet_KEYBYTES
-#define crypto_core_salsa20_CONSTBYTES crypto_core_salsa20_tweet_CONSTBYTES
-#define crypto_core_salsa20_VERSION crypto_core_salsa20_tweet_VERSION
-#define crypto_core_salsa20_IMPLEMENTATION "crypto_core/salsa20/tweet"
-#define crypto_core_hsalsa20_tweet_OUTPUTBYTES 32
-#define crypto_core_hsalsa20_tweet_INPUTBYTES 16
-#define crypto_core_hsalsa20_tweet_KEYBYTES 32
-#define crypto_core_hsalsa20_tweet_CONSTBYTES 16
-extern int crypto_core_hsalsa20_tweet(unsigned char *,const unsigned char *,const unsigned char *,const unsigned char *);
-#define crypto_core_hsalsa20_tweet_VERSION "-"
-#define crypto_core_hsalsa20 crypto_core_hsalsa20_tweet
-#define crypto_core_hsalsa20_OUTPUTBYTES crypto_core_hsalsa20_tweet_OUTPUTBYTES
-#define crypto_core_hsalsa20_INPUTBYTES crypto_core_hsalsa20_tweet_INPUTBYTES
-#define crypto_core_hsalsa20_KEYBYTES crypto_core_hsalsa20_tweet_KEYBYTES
-#define crypto_core_hsalsa20_CONSTBYTES crypto_core_hsalsa20_tweet_CONSTBYTES
-#define crypto_core_hsalsa20_VERSION crypto_core_hsalsa20_tweet_VERSION
-#define crypto_core_hsalsa20_IMPLEMENTATION "crypto_core/hsalsa20/tweet"
-#define crypto_hashblocks_PRIMITIVE "sha512"
-#define crypto_hashblocks crypto_hashblocks_sha512
-#define crypto_hashblocks_STATEBYTES crypto_hashblocks_sha512_STATEBYTES
-#define crypto_hashblocks_BLOCKBYTES crypto_hashblocks_sha512_BLOCKBYTES
-#define crypto_hashblocks_IMPLEMENTATION crypto_hashblocks_sha512_IMPLEMENTATION
-#define crypto_hashblocks_VERSION crypto_hashblocks_sha512_VERSION
-#define crypto_hashblocks_sha512_tweet_STATEBYTES 64
-#define crypto_hashblocks_sha512_tweet_BLOCKBYTES 128
-extern int crypto_hashblocks_sha512_tweet(unsigned char *,const unsigned char *,unsigned long long);
-#define crypto_hashblocks_sha512_tweet_VERSION "-"
-#define crypto_hashblocks_sha512 crypto_hashblocks_sha512_tweet
-#define crypto_hashblocks_sha512_STATEBYTES crypto_hashblocks_sha512_tweet_STATEBYTES
-#define crypto_hashblocks_sha512_BLOCKBYTES crypto_hashblocks_sha512_tweet_BLOCKBYTES
-#define crypto_hashblocks_sha512_VERSION crypto_hashblocks_sha512_tweet_VERSION
-#define crypto_hashblocks_sha512_IMPLEMENTATION "crypto_hashblocks/sha512/tweet"
-#define crypto_hashblocks_sha256_tweet_STATEBYTES 32
-#define crypto_hashblocks_sha256_tweet_BLOCKBYTES 64
-extern int crypto_hashblocks_sha256_tweet(unsigned char *,const unsigned char *,unsigned long long);
-#define crypto_hashblocks_sha256_tweet_VERSION "-"
-#define crypto_hashblocks_sha256 crypto_hashblocks_sha256_tweet
-#define crypto_hashblocks_sha256_STATEBYTES crypto_hashblocks_sha256_tweet_STATEBYTES
-#define crypto_hashblocks_sha256_BLOCKBYTES crypto_hashblocks_sha256_tweet_BLOCKBYTES
-#define crypto_hashblocks_sha256_VERSION crypto_hashblocks_sha256_tweet_VERSION
-#define crypto_hashblocks_sha256_IMPLEMENTATION "crypto_hashblocks/sha256/tweet"
-#define crypto_hash_PRIMITIVE "sha512"
-#define crypto_hash crypto_hash_sha512
-#define crypto_hash_BYTES crypto_hash_sha512_BYTES
-#define crypto_hash_IMPLEMENTATION crypto_hash_sha512_IMPLEMENTATION
-#define crypto_hash_VERSION crypto_hash_sha512_VERSION
-#define crypto_hash_sha512_tweet_BYTES 64
-extern int crypto_hash_sha512_tweet(unsigned char *,const unsigned char *,unsigned long long);
-#define crypto_hash_sha512_tweet_VERSION "-"
-#define crypto_hash_sha512 crypto_hash_sha512_tweet
-#define crypto_hash_sha512_BYTES crypto_hash_sha512_tweet_BYTES
-#define crypto_hash_sha512_VERSION crypto_hash_sha512_tweet_VERSION
-#define crypto_hash_sha512_IMPLEMENTATION "crypto_hash/sha512/tweet"
-#define crypto_hash_sha256_tweet_BYTES 32
-extern int crypto_hash_sha256_tweet(unsigned char *,const unsigned char *,unsigned long long);
-#define crypto_hash_sha256_tweet_VERSION "-"
-#define crypto_hash_sha256 crypto_hash_sha256_tweet
-#define crypto_hash_sha256_BYTES crypto_hash_sha256_tweet_BYTES
-#define crypto_hash_sha256_VERSION crypto_hash_sha256_tweet_VERSION
-#define crypto_hash_sha256_IMPLEMENTATION "crypto_hash/sha256/tweet"
-#define crypto_onetimeauth_PRIMITIVE "poly1305"
-#define crypto_onetimeauth crypto_onetimeauth_poly1305
-#define crypto_onetimeauth_verify crypto_onetimeauth_poly1305_verify
-#define crypto_onetimeauth_BYTES crypto_onetimeauth_poly1305_BYTES
-#define crypto_onetimeauth_KEYBYTES crypto_onetimeauth_poly1305_KEYBYTES
-#define crypto_onetimeauth_IMPLEMENTATION crypto_onetimeauth_poly1305_IMPLEMENTATION
-#define crypto_onetimeauth_VERSION crypto_onetimeauth_poly1305_VERSION
-#define crypto_onetimeauth_poly1305_tweet_BYTES 16
-#define crypto_onetimeauth_poly1305_tweet_KEYBYTES 32
-extern int crypto_onetimeauth_poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
-extern int crypto_onetimeauth_poly1305_tweet_verify(const unsigned char *,const unsigned char *,unsigned long long,const unsigned char *);
-#define crypto_onetimeauth_poly1305_tweet_VERSION "-"
-#define crypto_onetimeauth_poly1305 crypto_onetimeauth_poly1305_tweet
-#define crypto_onetimeauth_poly1305_verify crypto_onetimeauth_poly1305_tweet_verify
-#define crypto_onetimeauth_poly1305_BYTES crypto_onetimeauth_poly1305_tweet_BYTES
-#define crypto_onetimeauth_poly1305_KEYBYTES crypto_onetimeauth_poly1305_tweet_KEYBYTES
-#define crypto_onetimeauth_poly1305_VERSION crypto_onetimeauth_poly1305_tweet_VERSION
-#define crypto_onetimeauth_poly1305_IMPLEMENTATION "crypto_onetimeauth/poly1305/tweet"
-#define crypto_scalarmult_PRIMITIVE "curve25519"
-#define crypto_scalarmult crypto_scalarmult_curve25519
-#define crypto_scalarmult_base crypto_scalarmult_curve25519_base
-#define crypto_scalarmult_BYTES crypto_scalarmult_curve25519_BYTES
-#define crypto_scalarmult_SCALARBYTES crypto_scalarmult_curve25519_SCALARBYTES
-#define crypto_scalarmult_IMPLEMENTATION crypto_scalarmult_curve25519_IMPLEMENTATION
-#define crypto_scalarmult_VERSION crypto_scalarmult_curve25519_VERSION
-#define crypto_scalarmult_curve25519_tweet_BYTES 32
-#define crypto_scalarmult_curve25519_tweet_SCALARBYTES 32
-extern int crypto_scalarmult_curve25519_tweet(unsigned char *,const unsigned char *,const unsigned char *);
-extern int crypto_scalarmult_curve25519_tweet_base(unsigned char *,const unsigned char *);
-#define crypto_scalarmult_curve25519_tweet_VERSION "-"
-#define crypto_scalarmult_curve25519 crypto_scalarmult_curve25519_tweet
-#define crypto_scalarmult_curve25519_base crypto_scalarmult_curve25519_tweet_base
-#define crypto_scalarmult_curve25519_BYTES crypto_scalarmult_curve25519_tweet_BYTES
-#define crypto_scalarmult_curve25519_SCALARBYTES crypto_scalarmult_curve25519_tweet_SCALARBYTES
-#define crypto_scalarmult_curve25519_VERSION crypto_scalarmult_curve25519_tweet_VERSION
-#define crypto_scalarmult_curve25519_IMPLEMENTATION "crypto_scalarmult/curve25519/tweet"
-#define crypto_secretbox_PRIMITIVE "xsalsa20poly1305"
-#define crypto_secretbox crypto_secretbox_xsalsa20poly1305
-#define crypto_secretbox_open crypto_secretbox_xsalsa20poly1305_open
-#define crypto_secretbox_KEYBYTES crypto_secretbox_xsalsa20poly1305_KEYBYTES
-#define crypto_secretbox_NONCEBYTES crypto_secretbox_xsalsa20poly1305_NONCEBYTES
-#define crypto_secretbox_ZEROBYTES crypto_secretbox_xsalsa20poly1305_ZEROBYTES
-#define crypto_secretbox_BOXZEROBYTES crypto_secretbox_xsalsa20poly1305_BOXZEROBYTES
-#define crypto_secretbox_IMPLEMENTATION crypto_secretbox_xsalsa20poly1305_IMPLEMENTATION
-#define crypto_secretbox_VERSION crypto_secretbox_xsalsa20poly1305_VERSION
-#define crypto_secretbox_xsalsa20poly1305_tweet_KEYBYTES 32
-#define crypto_secretbox_xsalsa20poly1305_tweet_NONCEBYTES 24
-#define crypto_secretbox_xsalsa20poly1305_tweet_ZEROBYTES 32
-#define crypto_secretbox_xsalsa20poly1305_tweet_BOXZEROBYTES 16
-extern int crypto_secretbox_xsalsa20poly1305_tweet(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-extern int crypto_secretbox_xsalsa20poly1305_tweet_open(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-#define crypto_secretbox_xsalsa20poly1305_tweet_VERSION "-"
-#define crypto_secretbox_xsalsa20poly1305 crypto_secretbox_xsalsa20poly1305_tweet
-#define crypto_secretbox_xsalsa20poly1305_open crypto_secretbox_xsalsa20poly1305_tweet_open
-#define crypto_secretbox_xsalsa20poly1305_KEYBYTES crypto_secretbox_xsalsa20poly1305_tweet_KEYBYTES
-#define crypto_secretbox_xsalsa20poly1305_NONCEBYTES crypto_secretbox_xsalsa20poly1305_tweet_NONCEBYTES
-#define crypto_secretbox_xsalsa20poly1305_ZEROBYTES crypto_secretbox_xsalsa20poly1305_tweet_ZEROBYTES
-#define crypto_secretbox_xsalsa20poly1305_BOXZEROBYTES crypto_secretbox_xsalsa20poly1305_tweet_BOXZEROBYTES
-#define crypto_secretbox_xsalsa20poly1305_VERSION crypto_secretbox_xsalsa20poly1305_tweet_VERSION
-#define crypto_secretbox_xsalsa20poly1305_IMPLEMENTATION "crypto_secretbox/xsalsa20poly1305/tweet"
-#define crypto_sign_PRIMITIVE "ed25519"
-#define crypto_sign crypto_sign_ed25519
-#define crypto_sign_open crypto_sign_ed25519_open
-#define crypto_sign_keypair crypto_sign_ed25519_keypair
-#define crypto_sign_BYTES crypto_sign_ed25519_BYTES
-#define crypto_sign_PUBLICKEYBYTES crypto_sign_ed25519_PUBLICKEYBYTES
-#define crypto_sign_SECRETKEYBYTES crypto_sign_ed25519_SECRETKEYBYTES
-#define crypto_sign_IMPLEMENTATION crypto_sign_ed25519_IMPLEMENTATION
-#define crypto_sign_VERSION crypto_sign_ed25519_VERSION
-#define crypto_sign_ed25519_tweet_BYTES 64
-#define crypto_sign_ed25519_tweet_PUBLICKEYBYTES 32
-#define crypto_sign_ed25519_tweet_SECRETKEYBYTES 64
-extern int crypto_sign_ed25519_tweet(unsigned char *,unsigned long long *,const unsigned char *,unsigned long long,const unsigned char *);
-extern int crypto_sign_ed25519_tweet_open(unsigned char *,unsigned long long *,const unsigned char *,unsigned long long,const unsigned char *);
-extern int crypto_sign_ed25519_tweet_keypair(unsigned char *,unsigned char *);
-#define crypto_sign_ed25519_tweet_VERSION "-"
-#define crypto_sign_ed25519 crypto_sign_ed25519_tweet
-#define crypto_sign_ed25519_open crypto_sign_ed25519_tweet_open
-#define crypto_sign_ed25519_keypair crypto_sign_ed25519_tweet_keypair
-#define crypto_sign_ed25519_BYTES crypto_sign_ed25519_tweet_BYTES
-#define crypto_sign_ed25519_PUBLICKEYBYTES crypto_sign_ed25519_tweet_PUBLICKEYBYTES
-#define crypto_sign_ed25519_SECRETKEYBYTES crypto_sign_ed25519_tweet_SECRETKEYBYTES
-#define crypto_sign_ed25519_VERSION crypto_sign_ed25519_tweet_VERSION
-#define crypto_sign_ed25519_IMPLEMENTATION "crypto_sign/ed25519/tweet"
-#define crypto_stream_PRIMITIVE "xsalsa20"
-#define crypto_stream crypto_stream_xsalsa20
-#define crypto_stream_xor crypto_stream_xsalsa20_xor
-#define crypto_stream_KEYBYTES crypto_stream_xsalsa20_KEYBYTES
-#define crypto_stream_NONCEBYTES crypto_stream_xsalsa20_NONCEBYTES
-#define crypto_stream_IMPLEMENTATION crypto_stream_xsalsa20_IMPLEMENTATION
-#define crypto_stream_VERSION crypto_stream_xsalsa20_VERSION
-#define crypto_stream_xsalsa20_tweet_KEYBYTES 32
-#define crypto_stream_xsalsa20_tweet_NONCEBYTES 24
-extern int crypto_stream_xsalsa20_tweet(unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-extern int crypto_stream_xsalsa20_tweet_xor(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-#define crypto_stream_xsalsa20_tweet_VERSION "-"
-#define crypto_stream_xsalsa20 crypto_stream_xsalsa20_tweet
-#define crypto_stream_xsalsa20_xor crypto_stream_xsalsa20_tweet_xor
-#define crypto_stream_xsalsa20_KEYBYTES crypto_stream_xsalsa20_tweet_KEYBYTES
-#define crypto_stream_xsalsa20_NONCEBYTES crypto_stream_xsalsa20_tweet_NONCEBYTES
-#define crypto_stream_xsalsa20_VERSION crypto_stream_xsalsa20_tweet_VERSION
-#define crypto_stream_xsalsa20_IMPLEMENTATION "crypto_stream/xsalsa20/tweet"
-#define crypto_stream_salsa20_tweet_KEYBYTES 32
-#define crypto_stream_salsa20_tweet_NONCEBYTES 8
-extern int crypto_stream_salsa20_tweet(unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-extern int crypto_stream_salsa20_tweet_xor(unsigned char *,const unsigned char *,unsigned long long,const unsigned char *,const unsigned char *);
-#define crypto_stream_salsa20_tweet_VERSION "-"
-#define crypto_stream_salsa20 crypto_stream_salsa20_tweet
-#define crypto_stream_salsa20_xor crypto_stream_salsa20_tweet_xor
-#define crypto_stream_salsa20_KEYBYTES crypto_stream_salsa20_tweet_KEYBYTES
-#define crypto_stream_salsa20_NONCEBYTES crypto_stream_salsa20_tweet_NONCEBYTES
-#define crypto_stream_salsa20_VERSION crypto_stream_salsa20_tweet_VERSION
-#define crypto_stream_salsa20_IMPLEMENTATION "crypto_stream/salsa20/tweet"
-#define crypto_verify_PRIMITIVE "16"
-#define crypto_verify crypto_verify_16
-#define crypto_verify_BYTES crypto_verify_16_BYTES
-#define crypto_verify_IMPLEMENTATION crypto_verify_16_IMPLEMENTATION
-#define crypto_verify_VERSION crypto_verify_16_VERSION
-#define crypto_verify_16_tweet_BYTES 16
-extern int crypto_verify_16_tweet(const unsigned char *,const unsigned char *);
-#define crypto_verify_16_tweet_VERSION "-"
-#define crypto_verify_16 crypto_verify_16_tweet
-#define crypto_verify_16_BYTES crypto_verify_16_tweet_BYTES
-#define crypto_verify_16_VERSION crypto_verify_16_tweet_VERSION
-#define crypto_verify_16_IMPLEMENTATION "crypto_verify/16/tweet"
-#define crypto_verify_32_tweet_BYTES 32
-extern int crypto_verify_32_tweet(const unsigned char *,const unsigned char *);
-#define crypto_verify_32_tweet_VERSION "-"
-#define crypto_verify_32 crypto_verify_32_tweet
-#define crypto_verify_32_BYTES crypto_verify_32_tweet_BYTES
-#define crypto_verify_32_VERSION crypto_verify_32_tweet_VERSION
-#define crypto_verify_32_IMPLEMENTATION "crypto_verify/32/tweet"
-#endif

install.sh

@@ -3,8 +3,7 @@ set -eu
 
 # Links to scripts/configs
 bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-bin_smp="$bin/smp-server-ubuntu-20_04-x86-64"
-bin_xftp="$bin/xftp-server-ubuntu-20_04-x86-64"
+remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
 
 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
@@ -26,6 +25,8 @@ path_conf_var="/var/opt"
 path_conf_smp="$path_conf_etc/simplex $path_conf_var/simplex"
 path_conf_xftp="$path_conf_etc/simplex-xftp $path_conf_var/simplex-xftp /srv/xftp"
 
+path_conf_info="$path_conf_etc/simplex-info"
+
 path_systemd="/etc/systemd/system"
 path_systemd_smp="$path_systemd/smp-server.service"
 path_systemd_xftp="$path_systemd/xftp-server.service"
@@ -65,7 +66,13 @@ ${GRN}4.${NC} Create systemd services:
 ${GRN}5.${NC} Install stopscript (systemd), update and uninstallation script:
     - all: ${YLW}${path_bin_update}${NC}, ${YLW}${path_bin_uninstall}${NC}, ${YLW}${path_bin_stopscript}${NC}
 
-Press ${GRN}ENTER${NC} to continue or ${RED}Ctrl+C${NC} to cancel installation"
+Press:
+  - ${GRN}ENTER${NC} to continue installing both xftp and smp servers
+  - ${GRN}1${NC} to install only smp server
+  - ${GRN}2${NC} to install only xftp server
+  - ${RED}Ctrl+C${NC} to cancel installation
+  
+Selection: "
 
 end="Installtion is complete!
 
@@ -76,27 +83,64 @@ Please checkout our server guides:
 To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
 "
 
+os_test() {
+ . /etc/os-release
+
+ case "$VERSION_ID" in
+  20.04|22.04) : ;;
+  24.04) VERSION_ID='22.04' ;;
+  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
+ esac
+
+ version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+ arch="$(uname -p)"
+
+ case "$arch" in
+  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
+  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
+ esac
+
+ bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
+ bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
+}
+
 setup_bins() {
- curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
- curl --proto '=https' --tlsv1.2 -sSf -L "$bin_xftp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+ eval "bin=\$bin_${1}"
+ eval "path=\$path_bin_${1}"
+
+ curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path" && chmod +x "$path"
+
+ unset bin path
 }
 
 setup_users() {
- useradd -M "$user_smp" 2> /dev/null || true
- useradd -M "$user_xftp" 2> /dev/null || true
+ eval "user=\$user_${1}"
+
+ useradd -M "$user" 2> /dev/null || true
+
+ unset user
 }
 
 setup_dirs() {
  # Unquoted varibles, so field splitting can occur
- mkdir -p $path_conf_smp
- chown "$user_smp":"$user_smp" $path_conf_smp
- mkdir -p $path_conf_xftp
- chown "$user_xftp":"$user_xftp" $path_conf_xftp
+ eval "path_conf=\$path_conf_${1}"
+ eval "user=\$user_${1}"
+
+ mkdir -p $path_conf
+ mkdir -p $path_conf_info
+ printf "local_version_%s='%s'\n" "$1" "$remote_version" >> "$path_conf_info/release"
+ chown -R "$user":"$user" $path_conf
+
+ unset path_conf user
 }
 
 setup_systemd() {
- curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_smp" -o "$path_systemd_smp"
- curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_xftp" -o "$path_systemd_xftp"
+ eval "scripts_systemd=\$scripts_systemd_${1}"
+ eval "path_systemd=\$path_systemd_${1}"
+
+ curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_systemd"
+
+ unset scripts_systemd path_systemd
 }
 
 setup_scripts() {
@@ -110,32 +154,62 @@ checks() {
   printf "This script is intended to be run with root privileges. Please re-run script using sudo."
   exit 1
  fi
+ 
+ os_test
+
+ mkdir -p $path_conf_info  
 }
 
 main() {
  checks
  
- printf "%b\n%b\n" "${BLU}$logo${NC}" "$welcome"
+ printf "%b\n%b" "${BLU}$logo${NC}" "$welcome"
  read ans
 
+ if [ "$ans" = '1' ]; then
+  setup='smp'
+ elif [ "$ans" = '2' ]; then
+  setup='xftp'
+ else
+  setup='smp xftp'
+ fi
+
  printf "Installing binaries..."
- setup_bins
+ 
+ for i in $setup; do
+  setup_bins "$i"
+ done
+ 
  printf "${GRN} Done!${NC}\n"
 
  printf "Creating users..."
- setup_users
+
+ for i in $setup; do
+  setup_users "$i"
+ done
+
  printf "${GRN} Done!${NC}\n"
  
  printf "Creating directories..."
- setup_dirs
+
+ for i in $setup; do
+  setup_dirs "$i"
+ done
+
  printf "${GRN} Done!${NC}\n"
 
  printf "Creating systemd services..."
- setup_systemd
+
+ for i in $setup; do
+  setup_systemd "$i"
+ done
+
  printf "${GRN} Done!${NC}\n"
 
  printf "Installing stopscript, update and uninstallation script..."
+
  setup_scripts
+
  printf "${GRN} Done!${NC}\n"
 
  printf "%b" "$end"

package.yaml

@@ -1,5 +1,5 @@
 name: simplexmq
-version: 5.8.0.10
+version: 6.0.3.0
 synopsis: SimpleXMQ message broker
 description: |
   This package includes <./docs/Simplex-Messaging-Server.html server>,
@@ -22,7 +22,6 @@ extra-source-files:
   - CHANGELOG.md
   - cbits/sha512.h
   - cbits/sntrup761.h
-  - cbits/tweetnacl.h
   - apps/smp-server/static/*.html
   - apps/smp-server/static/media/*
 
@@ -48,6 +47,7 @@ dependencies:
   - direct-sqlcipher == 2.3.*
   - directory == 1.3.*
   - filepath == 1.4.*
+  - hashable == 1.4.*
   - hourglass == 0.2.*
   - http-types == 0.12.*
   - http2 >= 4.2.2 && < 4.3
@@ -70,7 +70,7 @@ dependencies:
   - temporary == 1.3.*
   - time == 1.12.*
   - time-manager == 0.0.*
-  - tls >= 1.7.0 && < 1.8
+  - tls >= 1.9.0 && < 1.10
   - transformers == 0.6.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
@@ -111,7 +111,6 @@ library:
   c-sources:
     - cbits/sha512.c
     - cbits/sntrup761.c
-    - cbits/tweetnacl.c
   include-dirs: cbits
   extra-libraries: crypto
 
@@ -149,15 +148,6 @@ executables:
       - -threaded
       - -rtsopts
 
-  smp-agent:
-    source-dirs: apps/smp-agent
-    main: Main.hs
-    dependencies:
-      - simplexmq
-    ghc-options:
-      - -threaded
-      - -rtsopts
-
   xftp:
     source-dirs: apps/xftp
     main: Main.hs

protocol/agent-protocol.md

@@ -1,3 +1,5 @@
+Version 5, 2024-06-22
+
 # SMP agent protocol - duplex communication over SMP protocol
 
 ## Table of contents
@@ -5,69 +7,61 @@
 - [Abstract](#abstract)
 - [SMP agent](#smp-agent)
 - [SMP servers management](#smp-servers-management)
-- [SMP agent protocol components](#smp-agent-protocol-components)
+- [SMP agent protocol scope](#smp-agent-protocol-scope)
 - [Duplex connection procedure](#duplex-connection-procedure)
+- [Contact addresses](#contact-addresses)
 - [Communication between SMP agents](#communication-between-smp-agents)
   - [Message syntax](#messages-between-smp-agents)
     - [HELLO message](#hello-message)
-    - [REPLY message](#reply-message)
-    - [MSG message](#msg-message)
-    - [INV message](#inv-message)
-    - [ACK message](#ack-message)
-    - [NEW message](#new-message)
-    - [DEL message](#del-message)
-- [SMP agent commands](#smp-agent-commands)
-  - [Client commands and server responses](#client-commands-and-server-responses)
-    - [NEW command and INV response](#new-command-and-inv-response)
-    - [JOIN command](#join-command)
-    - [CONF notification and LET command](#conf-notification-and-let-command)
-    - [REQ notification and ACPT command](#req-notification-and-acpt-command)
-    - [INFO and CON notifications](#info-and-con-notifications)
-    - [SUB command](#sub-command)
-    - [SEND command and MID, SENT and MERR responses](#send-command-and-mid-sent-and-merr-responses)
-    - [MSG notification](#msg-notification)
-    - [END notification](#end-notification)
-    - [OFF command](#off-command)
-    - [DEL command](#del-command)
-- [Connection request](#connection-request)
+    - [A_MSG message](#a_msg-message)
+    - [A_RCVD message](#a_rcvd-message)
+    - [EREADY message](#eready-message)
+    - [A_QCONT message](#a_qcont-message)
+    - [Rotating messaging queue](#rotating-messaging-queue)
+- [End-to-end encryption](#end-to-end-encryption)
+- [Connection link: 1-time invitation and contact address](#connection-link-1-time-invitation-and-contact-address)
+- [Appendix A: SMP agent API](#smp-agent-api)
+  - [API functions](#api-functions)
+  - [API events](#api-events)
 
 ## Abstract
 
 The purpose of SMP agent protocol is to define the syntax and the semantics of communications between the client and the agent that connects to [SMP](./simplex-messaging.md) servers.
 
 It provides:
-- protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol.
+- API to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol.
 - management of E2E encryption between SMP agents, generating ephemeral asymmetric keys for each connection.
 - SMP command authentication on SMP servers, generating ephemeral keys for each SMP queue.
 - TCP/TLS transport handshake with SMP servers.
 - validation of message integrity.
 
-SMP agent protocol provides no encryption or security on the client side - it is assumed that the agent is executed in the trusted and secure environment, in one of three ways:
-- via TCP network using secure connection.
-- via local port (when the agent runs on the same device as a separate process).
-- via agent library, when the agent logic is included directly into the client application - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach.
+SMP agent API provides no security between the agent and the client - it is assumed that the agent is executed in the trusted and secure environment, via the agent library, when the agent logic is included directly into the client application - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach.
 
 ## SMP agent
 
-SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
+SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the API calls used by the client applications. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections").
 
 The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hashes and IDs of the last received and sent messages.
 
 ## SMP servers management
 
-SMP agent protocol commands do not contain the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation:
+SMP agent API does not use the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation:
 - by the client applications via any API that is outside of scope of this protocol.
 - by the agents themselves based on availability and latency of the configured servers.
 
-## SMP agent protocol components
+## SMP agent protocol scope
 
-SMP agent protocol has 3 main parts:
+SMP agent protocol has 2 main parts:
 
-- the syntax and semantics of the messages that SMP agents exchange with each other in order to:
+- the messages that SMP agents exchange with each other in order to:
   - negotiate establishing unidirectional (simplex) encrypted queues on SMP servers.
   - exchange client messages and delivery notifications, providing sequential message IDs and message integrity (by including the hash of the previous message).
-- the syntax and semantics of the commands that are sent by the agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues.
-- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]).
+  - re-negotiate messaging queues to use and connection e2e encryption.
+- the messages that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]).
+
+[Appendix A](#appendix-a-smp-agent-api) of this document describes:
+- the functional API used by the client application with the agent. This API allows to create and manage multiple connections, each consisting of two or more SMP queues.
+- events that the agent passes to the clients.
 
 ## Duplex connection procedure
 
@@ -75,54 +69,126 @@ SMP agent protocol has 3 main parts:
 
 The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection consisting of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps:
 
-1. Alice requests the new connection from the SMP agent A using SMP NEW command.
-2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection request](#connection-request).
-3. Alice sends the [connection request](#connection-request) to Bob via any secure channel (out-of-band message).
-4. Bob sends `JOIN` command with the connection request as a parameter to agent B to accept the connection.
-5. Establishing Alice's SMP queue (with SMP protocol commands):
-  - Agent B sends an "SMP confirmation" with SMP SEND command to the SMP queue specified in the connection request - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, etc.). This message is encrypted using key passed in the connection request (or with the derived key, in which case public key for key derivation should be sent in clear text).
-  - Agent A receives the SMP confirmation containing Bob's key and info as SMP MSG.
-  - Agent A notifies Alice sending REQ notification with Bob's info.
-  - Alice accepts connection request with ACPT command.
-  - Agent A secures the queue with SMP KEY command.
-  - Agent B tries sending authenticated SMP SEND command with agent `HELLO` message until it succeeds. Once it succeeds, Bob's agent "knows" the queue is secured.
-6. Agent B creates a new SMP queue on the server.
-7. Establish Bob's SMP queue:
-  - Agent B sends `REPLY` message (SMP SEND command) with the connection request to this 2nd queue to Alice's agent (via the 1st queue) - this connection request SHOULD use "simplex" URI scheme.
-  - Agent A, having received `REPLY` message, sends unauthenticated message (SMP SEND) to SMP queue with Alice agent's ephemeral key that will be used to authenticate Alice's commands to the queue, as described in SMP protocol, and Alice's info.
-  - Bob's agent receives the key and Alice's information and secures the queue (SMP KEY).
-  - Bob's agent sends the notification `INFO` with Alice's information to Bob.
-  - Alice's agent keeps sending `HELLO` message until it succeeds.
-8. Agents A and B notify Alice and Bob that connection is established.
-  - Once sending `HELLO` succeeds, Alice's agent sends to Alice `CON` notification that confirms that now both parties can communicate.
-  - Once Bob's agent receives `HELLO` from Alice's agent, it sends to Bob `CON` notification as well.
+1. Alice requests the new connection from the SMP agent A using agent `createConnection` api function.
+2. Agent A creates an SMP queue on the server (using [SMP protocol](./simplex-messaging.md) `NEW` command) and responds to Alice with the invitation that contains queue information and the encryption keys Bob's agent B should use. The invitation format is described in [Connection link](connection-link-1-time-invitation-and-contact-address).
+3. Alice sends the [connection link](#connection-link-1-time-invitation-and-contact-address) to Bob via any secure channel (out-of-band message) - as a link or as a QR code.
+4. Bob uses agent `joinConnection` api function with the connection link as a parameter to agent B to accept the connection.
+5. Agent B creates Bob's SMP reply queue with SMP server `NEW` command.
+6. Agent B confirms the connection: sends an "SMP confirmation" with SMP server `SEND` command to the SMP queue specified in the connection link - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, and the connection link to this 2nd queue to Agent A - this connection link SHOULD use "simplex" URI scheme). This message is encrypted using key passed in the connection link (or with the derived shared secret, in which case public key for key derivation should be sent in clear text).
+6. Alice confirms and continues the connection:
+  - Agent A receives the SMP confirmation containing Bob's key, reply queue and info as SMP server `MSG`.
+  - Agent A notifies Alice sending `CONF` notification with Bob's info.
+  - Alice allows connection to continue with agent `allowConnection` api function.
+  - Agent A secures the queue with SMP server `KEY` command.
+  - Agent A sends SMP confirmation with ephemeral sender key, ephemeral public encryption key and profile (but without reply queue).
+7. Agent B confirms the connection:
+  - receives the confirmation.
+  - sends the notification `INFO` with Alice's information to Bob.
+  - secures SMP queue that it sent to Alice in the first confirmation with SMP `KEY` command .
+  - sends `HELLO` message via SMP `SEND` command. This confirms that the reply queue is secured and also validates that Agent A secured the first SMP queue
+8. Agent A notifies Alice.
+  - receives `HELLO` message from Agent B.
+  - sends `HELLO` message to Agent B via SMP `SEND` command.
+  - sends `CON` notification to Alice, confirming that the connection is established.
+9. Agent B notifies Bob.
+  - Once Agent B receives `HELLO` from Agent A, it sends to Bob `CON` notification as well.
 
 At this point the duplex connection between Alice and Bob is established, they can use `SEND` command to send messages. The diagram also shows how the connection status changes for both parties, where the first part is the status of the SMP queue to receive messages, and the second part - the status of the queue to send messages.
 
 The most communication happens between the agents and servers, from the point of view of Alice and Bob there are 4 steps (not including notifications):
 
-1. Alice requests a new connection with `NEW` command and receives the invitation.
-2. Alice passes connection request out-of-band to Bob.
-3. Bob accepts the connection with `JOIN` command with the connection request to his agent.
-4. Alice accepts the connection with `ACPT` command.
+1. Alice requests a new connection with `createConnection` agent API function and receives the connection link.
+2. Alice passes connection link out-of-band to Bob.
+3. Bob accepts the connection with `joinConnection` agent API function with the connection link to his agent.
+4. Alice accepts the connection with `ACPT` agent API function.
 5. Both parties receive `CON` notification once duplex connection is established.
 
 Clients SHOULD support establishing duplex connection asynchronously (when parties are intermittently offline) by persisting intermediate states and resuming SMP queue subscriptions.
 
+## Fast duplex connection procedure
+
+Previously described duplex connection procedure requires sending 4 messages creating a bad UX for the users - it requires waiting until each party in online before the messages can be sent.
+
+It allows users validating connecting party profile before proceeding with the connection, but it turned out to be unnecessary UX step and is not used in the client applications.
+
+It also protects against an attacker who compromised TLS and uses the sender queue ID sent to the recipient to secure the queue before the sender can. This attack is very hard, and this accepting its risk is better than worse UX. Future protocol versions could mitigate this attack by encrypting entity IDs.
+
+Faster duplex connection process is possible with the `SKEY` command added in v9 of SMP protocol.
+
+![Fast duplex connection procedure](./diagrams/duplex-messaging/duplex-creating-fast.svg)
+
+1. Alice requests the new connection from the SMP agent A using agent `createConnection` api function
+2. Agent A creates an SMP queue on the server (using [SMP protocol](./simplex-messaging.md) `NEW` command with the flag allowing the sender to secure the queue) and responds to Alice with the invitation that contains queue information and the encryption keys Bob's agent B should use. The invitation format is described in [Connection link](connection-link-1-time-invitation-and-contact-address).
+3. Alice sends the [connection link](connection-link-1-time-invitation-and-contact-address) to Bob via any secure channel (out-of-band message) - as a link or as a QR code. This link contains the flag that the queue can be secured by the sender.
+4. Bob uses agent `joinConnection` api function with the connection link as a parameter to agent B to accept the connection.
+5. Agent B secures Alice's queue with SMP command `SKEY` - this command can be proxied.
+6. Agent B creates Bob's SMP reply queue with SMP server `NEW` command (with the flag allowing the sender to secure the queue).
+7. Agent B confirms the connection: sends an "SMP confirmation" with SMP server `SEND` command to the SMP queue specified in the connection link - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, and the connection link to this 2nd queue to Agent A - this connection link SHOULD use "simplex" URI scheme). This message is encrypted using key passed in the connection link (or with the derived shared secret, in which case public key for key derivation should be sent in clear text).
+8. Alice confirms the connection:
+  - Agent A receives the SMP confirmation containing Bob's key, reply queue and info as SMP server `MSG`.
+  - Agent A notifies Alice sending `CONF` notification with Bob's info (that indicates that Agent B already secured the queue).
+  - Alice allows connection to continue with agent `allowConnection` api function.
+  - Agent A secures Bob's queue with SMP command `SKEY`.
+  - Agent A sends SMP confirmation with ephemeral public encryption key and profile (but without reply queue, and without sender key).
+9. Agent A notifies Alice with `CON` notification.
+10. Agent B notifies Bob about connection success:
+  - receives confirmation message from Alice.
+  - sends the notification `INFO` with Alice's information to Bob.
+  - sends `CON` notification to Bob.
+
+## Contact addresses
+
+SMP agents support creating a special type of connection - a contact address - that allows to connect to multiple network users who can send connection requests by sending 1-time connection links to the message queue. 
+
+This connection address uses a messaging queue on SMP server to receive invitations to connect - see `agentInvitation` message below. Once connection request is accepted, a new connection is created and the address itself is no longer used to send the messages - deleting this address does not disrupt the connections that were created via it.
+
 ## Communication between SMP agents
 
 To establish duplex connections and to send messages on behalf of their clients, SMP agents communicate via SMP servers.
 
 Agents use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other.
 
-Each SMP message client body, once decrypted, contains 3 parts (one of them may include binary message body), as defined by `decryptedSmpMessageBody` syntax:
+These messages are encrypted with per-queue shared secret using NaCL crypto_box and can be of 4 types, as defined by `decryptedSMPClientMessage`:
+- `agentConfirmation` - used when confirming SMP queues, contains connection information encrypted with double ratchet. This envelope can only contain `agentConnInfo` or `agentConnInfoReply` encrypted with double ratchet.
+- `agentMsgEnvelope` - contains different agent messages encrypted with double ratchet, as defined in `agentMessage`.
+- `agentInvitation` - sent to SMP queue that is used as contact address, does not use double ratchet.
+- `agentRatchetKey` - used to re-negotiate double ratchet encryption - can contain additional information in `agentRatchetKey`.
 
+```abnf
+decryptedSMPClientMessage = agentConfirmation / agentMsgEnvelope / agentInvitation / agentRatchetKey
+agentConfirmation = agentVersion %s"C" ("0" / "1" sndE2EEncryptionParams) encConnInfo
+agentVersion = 2*2 OCTET
+sndE2EEncryptionParams = TODO
+encConnInfo = doubleRatchetEncryptedMessage
+
+agentMsgEnvelope = agentVersion %s"M" encAgentMessage
+encAgentMessage = doubleRatchetEncryptedMessage
+
+agentInvitation = agentVersion %s"I" connReqLength connReq connInfo
+connReqLength = 2*2 OCTET ; Word16
+
+agentRatchetKey = agentVersion %s"R" rcvE2EEncryptionParams agentRatchetInfo
+rcvE2EEncryptionParams = TODO
+
+doubleRatchetEncryptedMessage = TODO
+```
+
+This syntax of decrypted SMP client message body is defined by `decryptedAgentMessage` below.
+
+Decrypted SMP message client body can be one of 4 types:
+- `agentConnInfo` - used by the initiating party when confirming reply queue - sent in `agentConfirmation` envelope.
+- `agentConnInfoReply` - used by accepting party, includes reply queue(s) in the initial confirmation - sent in `agentConfirmation` envelope.
+- `agentRatchetInfo` - used to pass additional information when renegotiating double ratchet encryption - sent in `agentRatchetKey` envelope.
+- `agentMessage` - all other agent messages.
+
+`agentMessage` contains these parts:
 - `agentMsgHeader` - agent message header that contains sequential agent message ID for a particular SMP queue, agent timestamp (ISO8601) and the hash of the previous message.
-- `agentMessage` - a command/message to the other SMP agent:
-  - to establish the connection with two SMP queues (`helloMsg`, `replyQueueMsg`)
-  - to send and to acknowledge user messages (`clientMsg`, `acknowledgeMsg`)
-  - to manage SMP queue rotation (`newQueueMessage`, `deleteQueueMsg`)
-  - to manage encryption key rotation (TODO)
+- `aMessage` - a command/message to the other SMP agent:
+  - to confirm the connection (`HELLO`).
+  - to send and to confirm reception of user messages (`A_MSG`, `A_RCVD`).
+  - to confirm that the new double ratchet encryption is agreed (`EREADY`).
+  - to notify another party that it can continue sending messages after queue capacity was exceeded (`A_QCONT`).
+  - to manage SMP queue rotation (`QADD`, `QKEY`, `QUSE`, `QTEST`).
 - `msgPadding` - an optional message padding to make all SMP messages have constant size, to prevent servers from observing the actual message size. The only case the message padding can be absent is when the message has exactly the maximum size, in all other cases the message MUST be padded to a fixed size.
 
 ### Messages between SMP agents
@@ -130,269 +196,160 @@ Each SMP message client body, once decrypted, contains 3 parts (one of them may
 Message syntax below uses [ABNF][3] with [case-sensitive strings extension][4].
 
 ```abnf
-decryptedSmpMessageBody = agentMsgHeader CRLF agentMessage CRLF msgPadding
-agentMsgHeader = agentMsgId SP previousMsgHash ; here `agentMsgId` is sequential ID set by the sending agent
-agentMsgId = 1*DIGIT
-previousMsgHash = encoded
-encoded = <base64 encoded>
+decryptedAgentMessage = agentConnInfo / agentConnInfoReply / agentRatchetInfo / agentMessage
+agentConnInfo = %s"I" connInfo
+connInfo = *OCTET
+agentConnInfoReply = %s"D" smpQueues connInfo
+agentRatchetInfo = %s"R" ratchetInfo
 
-agentMessage = helloMsg / replyQueueMsg /
-               clientMsg / invitationMsg /
-               newQueueMessage / deleteQueueMsg 
+agentMessage = %s"M" agentMsgHeader aMessage msgPadding
+agentMsgHeader = agentMsgId prevMsgHash
+agentMsgId = 8*8 OCTET ; Int64
+prevMsgHash = shortString
 
-msgPadding = *OCTET ; optional random bytes to get messages to the same size (as defined in SMP message size)
+aMessage = HELLO / A_MSG / A_RCVD / EREADY / A_QCONT /
+           QADD / QKEY / QUSE / QTEST
 
-helloMsg = %s"H"
+HELLO = %s"H"
 
-replyQueueMsg = %s"R" connectionRequest ; `connectionRequest` is defined below
-; this message can only be sent by the second connection party
+A_MSG = %s"M" userMsgBody
+userMsgBody = *OCTET
 
-clientMsg = %s"M" clientMsgBody
-clientMsgBody = *OCTET
+A_RCVD = %s"V" msgReceipt
+msgReceipt = agentMsgId msgHash rcptLength rcptInfo
 
-; TODO remove and move to "public" header
-invitationMsg = %s"INV" SP connReqInvitation SP connInfo
-; `connReqInvitation` and `connInfo` are defined below
+EREADY = %s"E" agentMsgId
 
-newQueueMsg = %s"N" queueURI
-; this message can be sent by any party to add SMP queue to the connection.
-; NOT SUPPORTED in the current implementation
+A_QCONT = %s"QC" sndQueueAddr
 
-deleteQueueMsg = %s"D" queueURI
-; notification that the queue with passed URI will be deleted
-; no need to notify the other party about suspending queue separately, as suspended and deleted queues are indistinguishable to the sender
-; NOT SUPPORTED in the current implementation
+QADD = %s"QA" sndQueues
+sndQueues = length 1*(newQueueUri replacedSndQueue)
+newQueueUri = clientVRange smpServer senderId dhPublicKey [sndSecure]
+dhPublicKey = length x509encoded
+sndSecure = "T"
+replacedSndQueue = "0" / "1" sndQueueAddr
+
+QKEY = %s"QK" sndQueueKeys
+sndQueueKeys = length 1*(newQueueInfo senderKey)
+newQueueInfo = version smpServer senderId dhPublicKey [sndSecure]
+senderKey = length x509encoded
+
+QUSE = %s"QU" sndQueuesReady
+sndQueuesReady = length 1*(sndQueueAddr primary)
+primary = %s"T" / %s"F"
+
+QTEST = %s"QT" sndQueueAddrs
+sndQueueAddrs = length 1*sndQueueAddr
+
+sndQueueAddr = smpServer senderId
+smpServer = hosts port keyHash
+hosts = length 1*host
+host = shortString
+port = shortString
+keyHash = shortString
+senderId = shortString
+
+clientVRange = version version
+version = 2*2 OCTET
+
+msgPadding = *OCTET
+rcptLength = 2*2 OCTET
+shortString = length *OCTET
+length = 1*1 OCTET
 ```
 
 #### HELLO message
 
-This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It MAY contain the public key that the recipient would use to verify messages signed by the sender.
+This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram).
 
-Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SMP SEND command.
+This message is not used with [fast duplex connection](#fast-duplex-connection-procedure).
 
-#### REPLY message
+#### A_MSG message
 
-This is the message that is sent by the agent that received an out-of-band connection request to pass the connection request for the reply SMP queues to the agent that originated the connection (see diagram).
+This is the agent envelope used to send client messages once the connection is established. This is different from the MSG sent by SMP server to the agent and MSG event from SMP agent to the client that are sent in different contexts.
 
-#### MSG message
+#### A_RCVD message
 
-This is the agent envelope used to send client messages once the connection is established. Do not confuse it with the MSG response from SMP server to the agent and MSG response from SMP agent to the client that are sent in different contexts.
+This message is sent to confirm the client message reception. It includes received message number and message hash.
 
-#### INV message
+#### EREADY message
 
-This message is sent to the SMP queue(s) in `connReqContact`, to establish a new connection via existing unsecured queue, that acts as a permanent connection link of a user.
+This message is sent after re-negotiating a new double ratchet encryption with `agentRatchetKey`.
 
-#### ACK message
+#### A_QCONT message
 
-This message is sent to confirm the client message reception. It includes received message number, message hash and the reception status.
+This message is sent to notify the sender client that it can continue sending the messages after queue capacity was exhausted.
 
-#### NEW message
+### Rotating messaging queue
 
-This message is sent to add an additional SMP queue to the connection. Unlike REPLY message it can be sent at any time.
+SMP agents SHOULD support 4 messages to rotate message reception to another messaging server:
+`QADD`: add the new queue address(es) to the connection - sent by the client that initiates rotation.
+`QKEY`: pass sender's key via existing connection (SMP confirmation message will not be used, to avoid the same "race" of the initial key exchange that would create the risk of intercepting the queue for the attacker) - sent by the client accepting the rotation
+`QUSE`: instruct the sender to use the new queue with sender's queue ID as parameter. From this point some messages can be sent to both the new queue and the old queue.
+`QTEST`: send test message to the new connection. Any other message can be sent if available to continue rotation, the absence of this message is not an error. Once this message is successfully sent the sender will stop using the old queue. Once this message (or any other message in the new queue) is received, the recipient will stop using the old queue and delete it.
 
-#### DEL message 
+**Queue rotation procedure**
 
-This message is sent to notify that the queue with passed URI will be deleted - having received this message, the receiving agent should no longer send messages to this queue. In case it was the last remaining send queue in the duplex connection, the agent MAY also delete the reply queue(s) in the connection.
+![Queue rotation procedure](./diagrams/duplex-messaging/queue-rotation.svg)
 
-## SMP agent commands
+`SKEY` command added in v9 of SMP protocol allows for faster queue rotation procedure.
 
-This part describes the transmissions between users and client-side SMP agents: commands that the users send to create and operate duplex connections and SMP agent responses and messages they deliver.
+**Fast queue rotation procedure**
 
-Commands syntax below is provided using [ABNF][3] with [case-sensitive strings extension][4].
+![Fast queue rotation procedure](./diagrams/duplex-messaging/queue-rotation-fast.svg)
 
-Each transmission between the user and SMP agent must have this format/syntax:
+## End-to-end encryption
 
-```abnf
-agentTransmission = [corrId] CRLF [connId] CRLF agentCommand
+Messages between SMP agents have two layers of e2e encryption:
+- simple encryption agreed in SMP protocol with a fixed key agreed when the messaging queue is agreed by parties.
+- post-quantum resistant augmented double ratchet algorithm (PQDR) specified in [this document](./pqdr.md).
 
-corrId = 1*(%x21-7F) ; any characters other than control/whitespace
+The protocol supports adding and removing post-quantum KEM primitive to the key agreement in double ratchet:
+- to support migration of pre-existing connections to PQDR.
+- to be able to disable PQ key agreement.
+- to be able to use invitation links and contact addresses without large PQ keys.
 
-connId = encoded
+Possible scenarios below show the possible states of PQ key agreement, assuming that both clients support it.
 
-agentCommand = (userCmd / agentMsg) CRLF
-userCmd = newCmd / joinCmd / letCmd / acceptCmd / subscribeCmd / sendCmd / acknowledgeCmd / suspendCmd / deleteCmd
-agentMsg = invitation / confMsg / connReqMsg / connInfo / connected / unsubscribed / connDown / connUp / messageId / sent / messageError / message / received / ok / error
+Possible options for each stage are:
+- no KEM encapsulation key was sent (No PQ key),
+- only KEM encapsulation key was sent, but not ciphertext yet (PQ key sent),
+- both KEM encapsulation key from one KEM agreement and ciphertext from the previous agreement were sent (PQ key + PQ ct sent).
 
-newCmd = %s"NEW" SP connectionMode [SP %s"NO_ACK"] ; response is `invitation` or `error`
-; NO_ACK parameter currently not supported
+`+` in the table means that this scenario is possible, and `-` - that it is not possible.
 
-connectionMode = %s"INV" / %s"CON"
+| Connection stage                                       | No PQ key        | PQ key sent      | PQ key + PQ ct sent |
+|:------------------------------------------------------:|:----------------:|:----------------:|:-------------------:|
+| invitation                                             |         +        |         +        |          -          |
+| confirmation, in reply to: <br>no-pq inv <br>pq inv    | &nbsp;<br>+<br>+ | &nbsp;<br>+<br>- | &nbsp;<br>-<br>+    |
+| 1st msg, in reply to: <br>no-pq conf <br>pq/pq+ct conf | &nbsp;<br>+<br>+ | &nbsp;<br>+<br>- | &nbsp;<br>-<br>+    |
+| Nth msg, in reply to: <br>no-pq msg <br>pq/pq+ct msg   | &nbsp;<br>+<br>+ | &nbsp;<br>+<br>- | &nbsp;<br>-<br>+    |
 
-invitation = %s"INV" SP connectionRequest ; `connectionRequest` is defined below
+These scenarios can be reduced to:
+1. initial invitation optionally has PQ key, but must not have ciphertext.
+2. all subsequent messages should be allowed without PQ key/ciphertext, but:
+  - if the previous message had PQ key or PQ key with ciphertext, they must either have no PQ key, or have PQ key with ciphertext (PQ key without ciphertext is an error).
+  - if the previous message had no PQ key, they must either have no PQ key, or have PQ key without ciphertext (PQ key with ciphertext is an error).
 
-confMsg = %s"CONF" SP confirmationId SP msgBody
-; msgBody here is any binary information identifying connection request
+The rules for calculating the shared secret for received/sent messages are (assuming received message is valid according to the above rules):
 
-letCmd = %s"LET" SP confirmationId SP msgBody
-; msgBody here is any binary information identifying connecting party
+|  sent msg > <br>V received msg | no-pq       | pq      | pq+ct           |
+|:------------------------------:|:-----------:|:-------:|:---------------:|
+| no-pq                          | DH / DH     | DH / DH | err             |
+| pq (sent msg was NOT pq)       | DH / DH     | err     | DH / DH+KEM     |
+| pq+ct (sent msg was NOT no-pq) | DH+KEM / DH | err     | DH+KEM / DH+KEM |
 
-confirmationId = 1*DIGIT
+To summarize, the upgrade to DH+KEM secret happens in a sent message that has PQ key with ciphertext sent in reply to message with PQ key only (without ciphertext), and the downgrade to DH secret happens in the message that has no PQ key.
 
-connReqMsg = %s"REQ" SP invitationId SP msgBody
-; msgBody here is any binary information identifying connection request
+## Connection link: 1-time invitation and contact address
 
-acceptCmd = %s"ACPT" SP invitationId SP msgBody
-; msgBody here is any binary information identifying connecting party
+Connection links are generated by SMP agent in response to `createConnection` api call, used by another party user with `joinConnection` api, and then another connection link is sent by the agent in `agentConnInfoReply` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
 
-invitationId = 1*DIGIT
-
-connInfo = %s"INFO" SP msgBody
-; msgBody here is any binary information identifying connecting party
-
-connected = %s"CON"
-
-subscribeCmd = %s"SUB" ; response is `ok` or `error`
-
-unsubscribed = %s"END"
-; when another agent (or another client of the same agent)
-; subscribes to the same SMP queue on the server
-
-connDown = %s"DOWN"
-; lost connection (e.g. because of Internet connectivity or server is down)
-
-connUp = %s"UP"
-; restored connection
-
-joinCmd = %s"JOIN" SP connectionRequest SP connInfo [SP %s"NO_REPLY"] [SP %s"NO_ACK"]
-; `connectionRequest` and `connInfo` are defined below
-; response is `connected` or `error`
-; parameters NO_REPLY and NO_ACK are currently not supported
-
-suspendCmd = %s"OFF" ; can be sent by either party, response `ok` or `error`
-
-deleteCmd = %s"DEL" ; can be sent by either party, response `ok` or `error`
-
-sendCmd = %s"SEND" SP msgBody
-; send syntax is similar to that of SMP protocol, but it is wrapped in SMP message
-msgBody = stringMsg | binaryMsg
-stringMsg = ":" string ; until CRLF in the transmission
-string = *(%x01-09 / %x0B-0C / %x0E-FF %) ; any characters other than NUL, CR and LF
-binaryMsg = size CRLF msgBody CRLF ; the last CRLF is in addition to CRLF in the transmission
-size = 1*DIGIT ; size in bytes
-msgBody = *OCTET ; any content of specified size - safe for binary
-
-messageId = %s"MID" SP agentMsgId
-
-sent = %s"SENT" SP agentMsgId
-
-messageError = %s"MERR" SP agentMsgId SP <errorType>
-
-message = %s"MSG" SP msgIntegrity SP recipientMeta SP brokerMeta SP senderMeta SP binaryMsg
-recipientMeta = %s"R=" agentMsgId "," agentTimestamp ; receiving agent message metadata 
-brokerMeta = %s"B=" brokerMsgId "," brokerTimestamp ; broker (server) message metadata
-senderMeta = %s"S=" agentMsgId ; sending agent message ID 
-brokerMsgId = encoded
-brokerTimestamp = <date-time>
-msgIntegrity = ok / msgIntegrityError
-
-msgIntegrityError = %s"ERR" SP msgIntegrityErrorType
-msgIntegrityErrorType = skippedMsgErr / badMsgIdErr / badHashErr
-
-skippedMsgErr = %s"NO_ID" SP missingFromMsgId SP missingToMsgId
-badMsgIdErr = %s"ID" SP previousMsgId ; ID is lower than the previous
-badHashErr = %s"HASH"
-
-missingFromMsgId = agentMsgId
-missingToMsgId = agentMsgId
-previousMsgId = agentMsgId
-
-acknowledgeCmd = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R")
-
-received = %s"RCVD" SP agentMsgId SP msgIntegrity
-; ID assigned by sending agent (in SENT response)
-; currently not implemented
-
-msgStatus = ok | error
-
-ok = %s"OK"
-
-error = %s"ERR" SP <errorType>
-```
-
-### Client commands and server responses
-
-#### NEW command and INV response
-
-`NEW` command is used to create a connection and a connection request to be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
-
-`INV` response is sent by the agent to the client of the initiating party.
-
-`NEW` command has `connectionMode` parameter to define the connection mode - to be used to communicate with a single contact (invitation mode, `connectionMode` is `INV`) or to accept connection requests from anybody (contact mode, `connectionMode` is `CON`). The type of connection request is determined by `connectionMode` parameter.
-
-#### JOIN command
-
-It is used to create a connection and accept the connection request received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
-
-#### CONF notification and LET command
-
-When the joining party uses `JOIN` command to accept connection invitation created with `NEW INV` command, the initiating party will receive `CONF` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
-
-To continue with the connection the initiating party should use `LET` command.
-
-#### REQ notification and ACPT command
-
-When the joining party uses `JOIN` command to connect to the contact created with `NEW CON` command, the initiating party will receive `REQ` notification with some numeric identifier and an additional binary information, that can be used to identify the joining party or for any other purpose.
-
-To continue with the connection the party that created the contact should use `ACPT` command.
-
-#### INFO and CON notifications
-
-After the initiating party proceeds with the connection using `ACPT` command, the joining party will receive `INFO` notification that can be used to identify the initiating party or for any other purpose.
-
-Once the connection is established and ready to accept client messages, both agents will send `CON` notification to their clients.
-
-#### SUB command
-
-This command can be used by the client to resume receiving messages from the connection that was created in another TCP/client session. Agent response to this command can be `OK` or `ERR` in case connection does not exist (or can only be used to send connections - e.g. when the reply queue was not created).
-
-#### SEND command and MID, SENT, RCVD and MERR responses
-
-`SEND` command is used by the client to send messages.
-
-`MID` response with the message ID (the sequential message number that includes both sent and received messages in the connection) is sent to the client to confirm that the message is accepted by the agent, before it is sent to the SMP server.
-
-`SENT` notification is sent by the agent to confirm that the message was delivered to at least one of SMP servers. This notification contains the same message ID as `MID` notification. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session.
-
-`RCVD` notification is sent by the agent when it receives `ACK` message from the receiving agent. This notification contains reception status, only one successful notification will be sent, and multiple error notifications will be sent in case `ACK` had error status.
-
-In case of the failure to send the message for any other reason than network connection or message queue quota - e.g. authentication error (`ERR AUTH`) or syntax error (`ERR CMD error`), the agent will send to the client `MERR` notification with the message ID, and this message delivery will no longer be attempted to this SMP queue.
-
-#### MSG notification
-
-It is sent by the agent to the client when agent receives the message from the SMP server. It has message ID and timestamp from both the receiving and sending agents and from SMP server:
-- recipient agent ID is intended to be used to refer to the message in the future.
-- sender agent ID is intended to be used to identify any missed / skipped message(s)
-- broker ID should be used to detect duplicate deliveries (it would happen if TCP connection is lost before the message is acknowledged by the agent - see [SMP protocol](./simplex-messaging.md))
-
-#### END notification
-
-It is sent by the agent to the client when agent receives SMP protocol `END` notification from SMP server. It indicates that another agent has subscribed to the same SMP queue on the server and the server terminated the subscription of the current agent.
-
-#### DOWN and UP notifications
-
-These notifications are sent when server or network connection is, respectively, `DOWN` or back `UP`.
-
-All the subscriptions made in the current client session will be automatically resumed when `UP` notification is received.
-
-#### OFF command
-
-It is used to suspend the receiving SMP queue - sender will no longer be able to send the messages to the connection, but the recipient can retrieve the remaining messages. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
-
-#### DEL command
-
-It is used to delete the connection and all messages in it, as well as the receiving SMP queue and all messages in it that were remaining on the server. Agent response to this command can be `OK` or `ERR`. This command is irreversible.
-
-## Connection request
-
-Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another connection request is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users).
-
-Connection request syntax:
+Connection link syntax:
 
 ```
-connectionRequest = connectionScheme "/" connReqType "#/?smp=" smpQueues "&e2e=" e2eEncryption
-connReqType = %s"invitation" / %s"contact"
-; this parameter has the same meaning as connectionMode in agent commands
-; `NEW INV` creates `invitation` connection request, `NEW CON` - `contact`
+connectionLink = connectionScheme "/" connLinkType "#/?smp=" smpQueues "&e2e=" e2eEncryption
+connLinkType = %s"invitation" / %s"contact"
 connectionScheme = (%s"https://" clientAppServer) | %s"simplex:"
 clientAppServer = hostname [ ":" port ]
 ; client app server, e.g. simplex.chat
@@ -407,12 +364,112 @@ smpQueue = <URL-encoded queueURI defined in SMP protocol>
 
 All parameters are passed via URI hash to avoid sending them to the server (in case "https" scheme is used) - they can be used by the client-side code and processed by the client application. Parameters `smp` and `e2e` can be present in any order, any unknown additional parameters SHOULD be ignored.
 
-`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
+`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection link. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
 
 "simplex" URI scheme in `connectionProtocol` can be used instead of client app server, to connect without creating any web traffic. Client apps MUST support this URI scheme.
 
 See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax of `queueURI`.
 
+## Appendix A: SMP agent API
+
+The exact specification of agent library API and of the events that the agent sends to the client application is out of scope of the protocol specification.
+
+The list of some of the API functions and events below is supported by the reference implementation, and they are likely to be required by the client applications.
+
+### API functions
+
+The list of APIs below is not exhaustive and provided for information only. Please consult the source code for more information.
+
+#### Create conection
+
+`createConnection` api is used to create a connection - it returns the connection link that should be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party).
+
+This api is also used to create a contact address - a special connection that can be used by multiple people to connect to the user.
+
+Some communication scenarios may require fault-tolerant mechanism of creating connections that retries on network failures and continue retrying after the client is restarted. Such asynchronous API would return its result via `INV` event once it succeeds.
+
+#### Join connection
+
+`joinConnection` is used to create a connection record and accept the connection invitation received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party).
+
+This api can also be required as asynchronous, in which case `OK` event will be dispatched to the client to indicate the success or `ERR` in case it permanently failed (e.g., in case connection was deleted by another party).
+
+#### Allow connection
+
+Once the client receives `CONF` event, it should use synchronous `allowConnection` api to proceed with the connection (both for the [standard](#duplex-connection-procedure) and for the [fast duplex procedure](#fast-duplex-connection-procedure)).
+
+In case this API is used as asynchronous it will return its result via `OK` or `ERR` event.
+
+#### Accept and reject connection requests
+
+Connection requests are delivered to the client application via `REQ` event.
+
+Client can `acceptContact` and `rejectContact`, with `OK` and `ERR` events in case of asynchronous calls.
+
+#### Send message
+
+`sendMessage` api is always asynchronous. The api call returns message ID, `SENT` event once the message is sent to the server, `MWARN` event in case of temporary delivery failure that can be resolved by the user (e.g., by connecting via Tor or by upgrading the client) and `MERR` in case of permanent delivery failure.
+
+#### Acknowledge received message
+
+Messages are delivered to the client application via `MSG` event.
+
+Client application must always `ackMessage` to receive the next one - failure to call it in reference implementation will prevent the delivery of subsequent messages until the client reconnects to the server.
+
+This api is also used to acknowledge message delivery to the sending party - that party client application will receive `RCVD` event.
+
+#### Subscribe connection
+
+`subscribeConnection` api is used by the client to resume receiving messages from the connection that was created in another TCP/client session.
+
+#### Get notification message
+
+`getNotificationMessage` is used by push notification subsystem of the client application to receive the message from a specific messaging queue mentioned in the notification. The client application would receive `MSG` and any other events from the agent, and then `MSGNTF` event once the message related to this notification is received.
+
+#### Rotate message queue to another server
+
+`switchConnection` api is used to rotate connection queues to another messaging server.
+
+#### Renegotiate e2e encryption
+
+`synchronizeRatchet` api is used to re-negotiate double ratchet encryption for the connection.
+
+#### Delete connection
+
+`deleteConnection` api is used to delete connection. In case of asynchronous call, the connection deletion will be confirmed with `DEL_RCVQ` and `DEL_CONN` events.
+
+#### Suspend connection
+
+`suspendConnection` api is used to prevent any further messages delivered to the connection without deleting it.
+
+### API events
+
+Agent API uses these events dispatch to notify client application about events related to the connections:
+- `INV` - connection invitation or connection address URI after connection is created.
+- `CONF` - confirmation that connection is accepted by another party. When the accepting party uses `joinConnection` api to accept connection invitation, the initiating party will receive `CONF` notification with some identifier and additional information from the accepting party (e.g., profile). To continue the connection the initiating party client should use `allowConnection` api.
+- `REQ` - connection request is sent when another party uses `joinConnection` api with contact address. The client application can use `acceptContact` or `rejectContact` api.
+- `INFO` - information from the party that initiated the connection with `createConnection` sent to the party accepting the connection with `joinConnection`.
+- `CON` - notification that connection is established sent to both parties of the connection.
+- `END` - notification that connection subscription is terminated when another client subscribed to the same messaging queue.  
+- `DOWN` - notification that connection server is temporarily unavailable.
+- `UP` - notification that the subscriptions made in the current client session are resumed after the server became available.
+- `SWITCH` - notification about queue rotation process.
+- `RSYNC` - notification about e2e encryption re-negotiation process.
+- `SENT` - notification to confirm that the message was delivered to at least one of SMP servers. This notification contains the same message ID as returned to `sendMessage` api. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session.
+- `MWARN` - temporary delivery failure that can be resolved by the user (e.g., by connecting via Tor or by upgrading the client).
+- `MERR` - notification about permanent message delivery failure.
+- `MERRS` - notification about permanent message delivery failure for multiple messages (e.g., when multiple messages expire).
+- `MSG` - sent when agent receives the message from the SMP server.
+- `MSGNTF` - sent after agent received and processed the message referenced in the push notification.
+- `RCVD` - notification confirming message receipt by another party.
+- `QCONT` - notification that the agent continued sending messages after queue capacity was exceeded and recipient received all messages.
+- `DEL_RCVQ` - confirmation that message queue was deleted.
+- `DEL_CONN` - confirmation that connection was deleted.
+- `OK` - confirmation that asynchronous api call was successful.
+- `ERR` - error of asynchronous api call or some other error event.
+
+This list of events is not exhaustive and provided for information only. Please consult the source code for more information.
+
 [1]: https://en.wikipedia.org/wiki/End-to-end_encryption
 [2]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack
 [3]: https://tools.ietf.org/html/rfc5234

protocol/diagrams/duplex-messaging/duplex-creating-fast.mmd

@@ -0,0 +1,65 @@
+sequenceDiagram
+  participant A as Alice
+  participant AA as Alice's<br>agent
+  participant AS as Alice's<br>server
+  participant BS as Bob's<br>server
+  participant BA as Bob's<br>agent
+  participant B as Bob
+
+  note over AA, BA: status (receive/send): NONE/NONE
+
+  note over A, AA: 1. request connection<br>from agent
+  A ->> AA: createConnection
+ 
+  note over AA, AS: 2. create Alice's SMP queue
+  AA ->> AS: NEW: create SMP queue<br>allow sender to secure
+  AS ->> AA: IDS: SMP queue IDs
+  note over AA: status: NEW/NONE
+
+  AA ->> A: INV: invitation<br>to connect
+
+  note over A, B: 3. out-of-band invitation
+  A ->> B: OOB: invitation to connect
+
+  note over BA, B: 4. accept connection
+  B ->> BA: joinConnection:<br>via invitation info
+  note over BA: status: NONE/NEW
+
+  note over BA, AS: 5. secure Alice's SMP queue
+  BA ->> AS: SKEY: secure queue (this command needs to be proxied)
+  note over BA: status: NONE/SECURED
+
+  note over BA, BS: 6. create Bob's SMP queue
+  BA ->> BS: NEW: create SMP queue<br>allow sender to secure
+  BS ->> BA: IDS: SMP queue IDs
+  note over BA: status: NEW/SECURED
+
+  note over BA, AA: 7. confirm Alice's SMP queue
+  BA ->> AS: SEND: Bob's info without sender's key (SMP confirmation with reply queues)
+  note over BA: status: NEW/CONFIRMED
+
+  AS ->> AA: MSG: Bob's info without<br>sender server key
+  note over AA: status: CONFIRMED/NEW
+  AA ->> AS: ACK: confirm message
+  AA ->> A: CONF: connection request ID<br>and Bob's info
+  A -> AA: allowConnection: accept connection request,<br>send Alice's info
+  
+  note over AA, BS: 8. secure Bob's SMP queue
+  AA ->> BS: SKEY: secure queue (this command needs to be proxied)
+  note over BA: status: CONFIRMED/SECURED
+
+  AA ->> BS: SEND: Alice's info without sender's server key (SMP confirmation without reply queues)
+  note over AA: status: CONFIRMED/CONFIRMED
+
+  note over AA, A: 9. notify Alice<br>about connection success<br>(no HELLO needed in v6)
+  AA ->> A: CON: connected
+  note over AA: status: ACTIVE/ACTIVE
+
+  note over BA, B: 10. notify Bob<br>about connection success
+  BS ->> BA: MSG: Alice's info without<br>sender's server key
+  note over BA: status: CONFIRMED/CONFIRMED
+  BA ->> B: INFO: Alice's info
+  BA ->> BS: ACK: confirm message
+
+  BA ->> B: CON: connected
+  note over BA: status: ACTIVE/ACTIVE

protocol/diagrams/duplex-messaging/duplex-creating-v2.mmd

@@ -1,71 +0,0 @@
-sequenceDiagram
-  participant A as Alice
-  participant AA as Alice's<br>agent
-  participant AS as Alice's<br>server
-  participant BS as Bob's<br>server
-  participant BA as Bob's<br>agent
-  participant B as Bob
-
-  note over AA, BA: status (receive/send): NONE/NONE
-
-  note over A, AA: 1. request connection<br>from agent
-  A ->> AA: NEW: create<br>duplex connection
- 
-  note over AA, AS: 2. create Alice's SMP queue
-  AA ->> AS: NEW: create SMP queue
-  AS ->> AA: IDS: SMP queue IDs
-  note over AA: status: NEW/NONE
-
-  AA ->> A: INV: invitation<br>to connect
-
-  note over A, B: 3. out-of-band invitation
-  A ->> B: OOB: invitation to connect
-
-  note over BA, B: 4. accept connection
-  B ->> BA: JOIN:<br>via invitation info
-  note over BA: status: NONE/NEW
-
-  note over BA, BS: 5. create Bob's SMP queue
-  BA ->> BS: NEW: create SMP queue
-  BS ->> BA: IDS: SMP queue IDs
-  note over BA: status: NEW/NEW
-
-  note over BA, AA: 6. establish Alice's SMP queue
-  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation with reply queues)
-  note over BA: status: NEW/CONFIRMED
-
-  AS ->> AA: MSG: Bob's info and<br>sender server key
-  note over AA: status: CONFIRMED/NONE
-  AA ->> AS: ACK: confirm message
-  AA ->> A: CONF: connection request ID<br>and Bob's info
-  A ->> AA: LET: accept connection request,<br>send Alice's info
-  AA ->> AS: KEY: secure queue
-  note over AA: status: SECURED/NONE
-
-  AA ->> BS: SEND: Alice's info and sender's server key (SMP confirmation without reply queues)
-  note over AA: status: SECURED/CONFIRMED
-
-  BS ->> BA: MSG: Alice's info and<br>sender's server key
-  note over BA: status: CONFIRMED/CONFIRMED
-  BA ->> B: INFO: Alice's info
-  BA ->> BS: ACK: confirm message
-  BA ->> BS: KEY: secure queue
-  note over BA: status: SECURED/CONFIRMED
-
-  BA ->> AS: SEND: HELLO: only needs to be sent once in v2
-
-  note over BA: status: SECURED/ACTIVE
-  note over BA, B: 7a. notify Bob<br>about connection success
-  BA ->> B: CON: connected
-
-  AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
-  note over AA: status: SECURED/ACTIVE
-  AA ->> AS: ACK: confirm message
-  note over A, AA: 7a. notify Alice<br>about connection success
-  AA ->> A: CON: connected
-
-  AA ->> BS: SEND: HELLO: only needs to be sent once in v2
-  note over AA: status: ACTIVE/ACTIVE
-  BS ->> BA: MSG: HELLO: Bob's agent<br>knows Alice can send
-  note over BA: status: ACTIVE/ACTIVE
-  BA ->> BS: ACK: confirm message

protocol/diagrams/duplex-messaging/duplex-creating.mmd

@@ -8,8 +8,8 @@ sequenceDiagram
 
   note over AA, BA: status (receive/send): NONE/NONE
 
-  note over A, AA: 1. request connection from agent
-  A ->> AA: NEW: create<br>duplex connection
+  note over A, AA: 1. request connection<br>from agent
+  A ->> AA: createConnection
  
   note over AA, AS: 2. create Alice's SMP queue
   AA ->> AS: NEW: create SMP queue
@@ -17,63 +17,58 @@ sequenceDiagram
   note over AA: status: NEW/NONE
 
   AA ->> A: INV: invitation<br>to connect
-  note over AA: status: PENDING/NONE
 
   note over A, B: 3. out-of-band invitation
   A ->> B: OOB: invitation to connect
 
   note over BA, B: 4. accept connection
-  B ->> BA: JOIN:<br>via invitation info
+  B ->> BA: joinConnection:<br>via invitation info
   note over BA: status: NONE/NEW
 
-  note over BA, AA: 5. establish Alice's SMP queue
-  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation)
-  note over BA: status: NONE/CONFIRMED
-  activate BA
+  note over BA, BS: 5. create Bob's SMP queue
+  BA ->> BS: NEW: create SMP queue
+  BS ->> BA: IDS: SMP queue IDs
+  note over BA: status: NEW/NEW
+
+  note over BA, AA: 6. confirm Alice's SMP queue
+  BA ->> AS: SEND: Bob's info and sender server key (SMP confirmation with reply queues)
+  note over BA: status: NEW/CONFIRMED
+
   AS ->> AA: MSG: Bob's info and<br>sender server key
   note over AA: status: CONFIRMED/NONE
   AA ->> AS: ACK: confirm message
   AA ->> A: CONF: connection request ID<br>and Bob's info
-  A ->> AA: LET: accept connection request,<br>send Alice's info
+  A ->> AA: allowConnection: accept connection request,<br>send Alice's info
   AA ->> AS: KEY: secure queue
   note over AA: status: SECURED/NONE
 
-  BA ->> AS: SEND: HELLO: try sending until successful
-  deactivate BA
-  note over BA: status: NONE/ACTIVE
-  AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
-  note over AA: status: ACTIVE/NONE
-  AA ->> AS: ACK: confirm message
+  AA ->> BS: SEND: Alice's info and sender's server key (SMP confirmation without reply queues)
+  note over AA: status: SECURED/CONFIRMED
 
-  note over BA, BS: 6. create Bob's SMP queue
-  BA ->> BS: NEW: create SMP queue
-  BS ->> BA: IDS: SMP queue IDs
-  note over BA: status: NEW/ACTIVE
-
-  note over AA, BA: 7. establish Bob's SMP queue
-  BA ->> AS: SEND: REPLY: invitation to the connect
-  note over BA: status: PENDING/ACTIVE
-  AS ->> AA: MSG: REPLY: invitation<br>to connect
-  note over AA: status: ACTIVE/NEW
-  AA ->> AS: ACK: confirm message
-
-  AA ->> BS: SEND: Alice's info and sender's server key
-  note over AA: status: ACTIVE/CONFIRMED
-  activate AA
+  note over BA, AA: 7. confirm Bob's SMP queue
   BS ->> BA: MSG: Alice's info and<br>sender's server key
-  note over BA: status: CONFIRMED/ACTIVE
+  note over BA: status: CONFIRMED/CONFIRMED
   BA ->> B: INFO: Alice's info
   BA ->> BS: ACK: confirm message
   BA ->> BS: KEY: secure queue
+  note over BA: status: SECURED/CONFIRMED
+
+  BA ->> AS: SEND: HELLO message
+
   note over BA: status: SECURED/ACTIVE
 
-  AA ->> BS: SEND: HELLO: try sending until successful
-  deactivate AA
+  AS ->> AA: MSG: HELLO: Alice's agent<br>knows Bob can send
+  note over AA: status: SECURED/ACTIVE
+  AA ->> AS: ACK: confirm message
+  AA ->> BS: SEND: HELLO
+
+  note over A, AA: 8. notify Alice<br>about connection success
+  AA ->> A: CON: connected
   note over AA: status: ACTIVE/ACTIVE
+
   BS ->> BA: MSG: HELLO: Bob's agent<br>knows Alice can send
   note over BA: status: ACTIVE/ACTIVE
   BA ->> BS: ACK: confirm message
 
-  note over A, B: 8. notify users about connection success
-  AA ->> A: CON: connected
+  note over BA, B: 9. notify Bob<br>about connection success
   BA ->> B: CON: connected

protocol/diagrams/duplex-messaging/queue-rotation-fast.mmd

@@ -0,0 +1,17 @@
+sequenceDiagram
+  participant A as Alice
+  participant R as Current server<br>that has A's<br>receive queue
+  participant R' as New server<br>that has the new A's<br>receive queue
+  participant S as Server<br>that has A's send queue<br>(B's receive queue)
+  participant B as Bob
+
+  A ->> R': NEW: create new queue<br>(allow SKEY)
+  A ->> S: SEND: QADD (R'): send address<br>of the new queue(s)
+  S ->> B: MSG: QADD (R')
+  B ->> R': SKEY: secure new queue
+  B ->> R': SEND: QTEST
+  R' ->> A: MSG: QTEST
+  A ->> R: DEL: delete the old queue
+  B ->> R': SEND: send messages to the new queue
+  R' ->> A: MSG: receive messages from the new queue
+  

protocol/diagrams/duplex-messaging/queue-rotation.mmd

@@ -0,0 +1,21 @@
+sequenceDiagram
+  participant A as Alice
+  participant R as Current server<br>that has A's<br>receive queue
+  participant R' as New server<br>that has the new A's<br>receive queue
+  participant S as Server<br>that has A's send queue<br>(B's receive queue)
+  participant B as Bob
+
+  A ->> R': NEW: create new queue
+  A ->> S: SEND: QADD (R'): send address<br>of the new queue(s)
+  S ->> B: MSG: QADD (R')
+  B ->> R: SEND: QKEY (R'): sender's key<br>for the new queue(s)
+  R ->> A: MSG: QKEY(R')
+  A ->> R': KEY: secure new queue
+  A ->> S: SEND: QUSE (R'): instruction to use new queue(s)
+  S ->> B: MSG: QUSE (R')
+  B ->> R': SEND: QTEST
+  R' ->> A: MSG: QTEST
+  A ->> R: DEL: delete the old queue
+  B ->> R': SEND: send messages to the new queue
+  R' ->> A: MSG: receive messages from the new queue
+  

protocol/diagrams/notifications/register-token-detailed.mmd

@@ -0,0 +1,30 @@
+sequenceDiagram
+  participant M as mobile app
+  participant C as chat core
+  participant A as agent
+  participant P as push server
+  participant APN as APN
+
+  note over M, APN: get device token
+  M ->> APN: registerForRemoteNotifications()
+  APN ->> M: device token
+
+  note over M, P: register device token with push server
+  M ->> C: /_ntf register <token>
+  C ->> A: registerNtfToken(<token>)
+  A ->> P: TNEW
+  P ->> A: ID (tokenId)
+  A ->> C: registered
+  C ->> M: registered
+
+  note over M, APN: verify device token
+  P ->> APN: E2E encrypted code<br>in background<br>notification
+  APN ->> M: deliver background notification with e2ee verification token
+  M ->> C: /_ntf verify <e2ee code>
+  C ->> A: verifyNtfToken(<e2ee code>)
+  A ->> P: TVFY code
+  P ->> A: OK / ERR
+  A ->> C: verified
+  C ->> M: verified
+
+  note over M, APN: now token ID can be used

protocol/diagrams/notifications/register-token.mmd

@@ -1,30 +1,26 @@
 sequenceDiagram
-  participant M as mobile app
-  participant C as chat core
+  participant C as client app
   participant A as agent
-  participant P as push server
-  participant APN as APN
+  participant P as SimpleX<br>Notification<br>Server
+  participant APN as Apple<br>Push Notifications<br>Server
 
-  note over M, APN: get device token
-  M ->> APN: registerForRemoteNotifications()
-  APN ->> M: device token
+  note over C, APN: get device token
+  C ->> APN: registerForRemoteNotifications()
+  APN ->> C: device token
 
-  note over M, P: register device token with push server
-  M ->> C: /_ntf register <token>
-  C ->> A: registerNtfToken(<token>)
+  note over C, P: register device token with push server
+  C ->> A: registerToken
   A ->> P: TNEW
   P ->> A: ID (tokenId)
   A ->> C: registered
-  C ->> M: registered
 
-  note over M, APN: verify device token
+  note over C, APN: verify device token
   P ->> APN: E2E encrypted code<br>in background<br>notification
-  APN ->> M: deliver background notification with e2ee verification token
-  M ->> C: /_ntf verify <e2ee code>
-  C ->> A: verifyNtfToken(<e2ee code>)
+  APN ->> C: deliver background notification with e2ee verification token
+  C ->> A: verifyToken<br>(<e2ee code>)
   A ->> P: TVFY code
   P ->> A: OK / ERR
   A ->> C: verified
-  C ->> M: verified
 
-  note over M, APN: now token ID can be used
+  note over C, APN: now token ID can be used
+  

protocol/diagrams/notifications/subscription-detailed.mmd

@@ -0,0 +1,40 @@
+sequenceDiagram
+  participant M as mobile app
+  participant C as chat core
+  participant A as agent
+  participant S as SMP server
+  participant N as NTF server
+  participant APN as APN
+
+  note over M, APN: register subscription
+
+  alt register existing
+    M -->> A: on /_ntf register, for subscribed queues
+  else create new connection
+    A -->> S: NEW / JOIN
+    note over A, S: ...<br>Connection handshake<br>...
+    S -->> A: CON
+  end
+  A ->> S: NKEY nKey
+  S ->> A: NID nId
+  A ->> N: SNEW tknId dhKey (smpServer, nId, nKey)
+  N ->> A: ID subId dhKey
+  N ->> S: NSUB nId
+  S ->> N: OK [/ NMSG]
+
+  note over M, APN: notify about message
+
+  S ->> N: NMSG
+  N ->> APN: APNSMutableContent<br>ntfQueue, nonce
+  APN ->> M: UNMutableNotificationContent
+  note over M, S: ...<br>Client awaken, message is received<br>...
+  S ->> M: message
+  note over M: mutate notification
+
+  note over M, APN: change APN token
+
+  APN ->> M: new device token
+  M -->> C: /_ntf_sub update tkn
+  C -->> A: updateNtfToken()
+  A -->> N: TUPD tknId newDeviceToken
+  note over M, N: ...<br>Verify token<br>...

protocol/diagrams/notifications/subscription.mmd

@@ -1,17 +1,16 @@
 sequenceDiagram
-  participant M as mobile app
-  participant C as chat core
+  participant C as client app
   participant A as agent
   participant S as SMP server
   participant N as NTF server
   participant APN as APN
 
-  note over M, APN: register subscription
+  note over C, APN: register subscription
 
   alt register existing
-    M -->> A: on /_ntf register, for subscribed queues
+    C -->> A: registerToken
   else create new connection
-    A -->> S: NEW / JOIN
+    A -->> S: create/joinConnection
     note over A, S: ...<br>Connection handshake<br>...
     S -->> A: CON
   end
@@ -20,21 +19,20 @@ sequenceDiagram
   A ->> N: SNEW tknId dhKey (smpServer, nId, nKey)
   N ->> A: ID subId dhKey
   N ->> S: NSUB nId
-  S ->> N: OK [/ NMSG]
+  S ->> N: OK / NMSG:<br>confirm subscription
 
-  note over M, APN: notify about message
+  note over C, APN: notify about message
 
   S ->> N: NMSG
   N ->> APN: APNSMutableContent<br>ntfQueue, nonce
-  APN ->> M: UNMutableNotificationContent
-  note over M, S: ...<br>Client awaken, message is received<br>...
-  S ->> M: message
-  note over M: mutate notification
+  APN ->> C: UNMutableNotificationContent
+  note over C, S: ...<br>Client awaken, message is received<br>...
+  S ->> C: message
+  note over C: show notification
 
-  note over M, APN: change APN token
+  note over C, APN: change APN token
 
-  APN ->> M: new device token
-  M -->> C: /_ntf_sub update tkn
-  C -->> A: updateNtfToken()
+  APN ->> C: new device token
+  C -->> A: updateToken()
   A -->> N: TUPD tknId newDeviceToken
-  note over M, N: ...<br>Verify token<br>...
+  note over C, N: ...<br>Verify token<br>...

protocol/diagrams/simplex-messaging/simplex-creating-fast.mmd

@@ -0,0 +1,23 @@
+sequenceDiagram
+  participant B as Bob (sender)
+  participant S as server (queue RID)
+  participant A as Alice (recipient)
+
+  note over A: creating queue<br>("public" key RK<br>for msg retrieval)
+  A ->> S: 1. create queue ("NEW")
+  S ->> A: respond with queue RID and SID ("IDS")
+
+  note over A: out-of-band msg<br>(sender's queue SID<br>and "public" key EK<br>to encrypt msgs)
+  A -->> B: 2. send out-of-band message
+
+  note over B: secure queue<br>(with "public" key SK for<br>sending messages)
+  B ->> S: 3. confirm queue ("SKEY" command authorized with SK)
+
+  note over B: confirm queue<br>(public key<br>for e2e encryption<br>and any optional<br>encrypted info.)
+  B ->> S: 4. confirm queue ("SEND" command authorized with SK)
+
+  S ->> A: 5. deliver Bob's message (MSG)
+  note over A: decrypt message<br>("private" key EK)
+  A ->> S: acknowledge message (ACK)
+
+  note over S: 6. simplex<br>queue RID<br>is ready to use!

protocol/diagrams/simplex-messaging/simplex-creating.mmd

@@ -10,11 +10,13 @@ sequenceDiagram
   note over A: out-of-band msg<br>(sender's queue SID<br>and "public" key EK<br>to encrypt msgs)
   A -->> B: 2. send out-of-band message
 
-  note over B: confirm queue<br>("public" key SK for<br>sending messages<br>and any optional<br>info encrypted with<br>"public" key EK)
+  note over B: confirm queue<br>("public" key SK for<br>sending messages,<br>public key for<br>e2e encryption<br>and any optional<br>encrypted info)
   B ->> S: 3. confirm queue ("SEND" command not signed)
 
-  S ->> A: 4. deliver Bob's message
+  S ->> A: 4. deliver Bob's message (MSG)
   note over A: decrypt message<br>("private" key EK)
+  A ->> S: acknowledge message (ACK)
+
   A ->> S: 5. secure queue ("KEY", RK-signed)
 
   note over S: 6. simplex<br>queue RID<br>is ready to use!

protocol/diagrams/xftp/xftp-receiving-file.mmd

@@ -0,0 +1,18 @@
+sequenceDiagram
+  participant B as Bob (recipient)
+  participant S as XFTP server(s)
+
+  note over B: having received file description<br>from sender
+
+  loop for each chunk
+    B ->> S: 1a. download chunk ("FGET")
+    S ->> B: send chunk body ("FILE")
+
+    opt
+      B ->> S: 1b. acknowledge chunk reception ("FACK")
+      note over S: delete recipient ID
+      S ->> B: respond with ok ("OK")
+    end
+  end
+
+  note over B: 2. combine chunks into a file<br>3. decrypt file using key from file description<br>4. extract file name and unpad the file<br>5. validate file digest with the file description

protocol/diagrams/xftp/xftp-sending-file.mmd

@@ -0,0 +1,23 @@
+sequenceDiagram
+  participant A as Alice (sender)
+  participant S as XFTP server(s)
+  participant B as recipient(s)
+
+  note over A: 1. prepare file:<br>encrypt,<br>split into chunks,<br>generate recipient<br>keys, etc.
+
+  loop for each chunk
+    A ->> S: 2a. register chunk ("FNEW")
+    S ->> A: respond with sender's and recipients' chunk IDs ("SIDS")
+
+    opt
+      A ->> S: 2b. request additional recipient IDs ("FADD")
+      S ->> A: respond with added recipients' chunk IDs ("RIDS")
+    end
+
+    A ->> S: 2c. upload chunk to chosen server ("FPUT")
+    S ->> A: respond with ok ("OK")
+  end
+
+  note over A: 3. prepare file description(s)
+
+  A -->> B: 4. send file description(s) out-of-band

protocol/diagrams/xrcp/session.mmd

@@ -0,0 +1,44 @@
+sequenceDiagram
+  participant CI as Controller UI
+  participant CC as Controller Core
+  participant HC as Host Core
+  participant HI as Host UI
+
+note over CI, HI: 1. Session invitation
+CI->>CC: "Link a mobile"
+CC-->>CI: Session invitation URI
+note over CC: Listen for TCP connection
+activate CC
+HI->>HC: Session invitation URI
+
+note over CI, HI: 2. Establishing TLS connection
+HC-->>CC: TCP connect
+note over CC, HC: TLS handshake
+par
+    note over CC: validate client X509 credentials
+    CC->>CI: session code from tlsUnique
+    CI-->>CC: user confirmation
+and
+    note over HC: validate server X509 credentials
+    HC->>HI: session code from tlsUnique
+    HI-->>HC: user confirmation
+end
+
+note over CI, HI: 3. Session verification and protocol negotiation
+HC->>CC: host HELLO
+note over CC: validate version, CA fingerprint
+alt
+    CC-->>HC: controller ERROR
+else
+    CC-->>HC: controller HELLO
+    note over CC, HC: update stored keys
+end
+deactivate CC
+
+note over CI, HI: 4. Session operation
+loop
+    CI->>CC: command
+    CC->>HC: XRCP command
+    HC-->>CC: XRCP response
+    CC-->>CI: response
+end

protocol/overview-tjr.md

@@ -1,4 +1,4 @@
-Revision 1, 2022-01-01
+Revision 2, 2024-06-22
 
 Evgeny Poberezkin
 
@@ -13,19 +13,23 @@ Evgeny Poberezkin
 - [Technical Details](#technical-details)
   - [Trust in Servers](#trust-in-servers)
   - [Client -> Server Communication](#client---server-communication)
+  - [2-hop Onion Message Routing](#2-hop-onion-message-routing)
   - [SimpleX Messaging Protocol](#simplex-messaging-protocol)
   - [SimpleX Agents](#simplex-agents)
   - [Encryption Primitives Used](#encryption-primitives-used)
 - [Threat model](#threat-model)
 - [Acknowledgements](#acknowledgements)
 
+
 ## Introduction
 
 #### What is SimpleX
 
 SimpleX as a whole is a platform upon which applications can be built. [SimpleX Chat](https://github.com/simplex-chat/simplex-chat) is one such application that also serves as an example and reference application.
 
- - [SimpleX Messaging Protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md) (SMP) is a protocol to send messages in one direction to a recipient, relying on a server in-between. The messages are delivered via uni-directional queues created by recipients.
+ - [SimpleX Messaging Protocol](./simplex-messaging.md) (SMP) is a protocol to send messages in one direction to a recipient, relying on a server in-between. The messages are delivered via uni-directional queues created by recipients.
+ 
+ - SMP protocol allows to send message via a SMP server playing proxy role using 2-hop onion routing (referred to as "private routing" in messaging clients) to protect transport information of the sender (IP address and session) from the server chosen (and possibly controlled) by the recipient.
 
  - SMP runs over a transport protocol (shown below as TLS) that provides integrity, server authentication, confidentiality, and transport channel binding.
 
@@ -35,7 +39,9 @@ SimpleX as a whole is a platform upon which applications can be built. [SimpleX
 
  - SimpleX Client libraries speak SMP to SimpleX Servers and provide a low-level API not generally intended to be used by applications.
 
- - SimpleX Agents interface with SimpleX Clients to provide a more high-level API intended to be used by applications. Typically they are embedded as libraries, but are designed so they can also be abstracted into local services.
+ - SimpleX Agents interface with SimpleX Clients to provide a more high-level API intended to be used by applications. Typically they are embedded as libraries, but can also be abstracted into local services.
+
+ - SimpleX Agents communicate with other agents inside e2e encrypted envelopes provided by SMP protocol - the syntax and semantics of the messages exchanged by the agent are defined by [SMP agent protocol](./agent-protocol.md)
 
 
 *Diagram showing the SimpleX Chat app, with logical layers of the chat application interfacing with a SimpleX Agent library, which in turn interfaces with a SimpleX Client library. The Client library in turn speaks the Messaging Protocol to a SimpleX Server.*
@@ -72,10 +78,11 @@ SimpleX as a whole is a platform upon which applications can be built. [SimpleX
 
    - Low latency: the delay introduced by the network should not be higher than 100ms-1s in addition to the underlying TCP network latency.
 
-2. Provide better communication security and privacy than the alternative instant messaging solutions.  In particular SimpleX provides better privacy of metadata (who talks to whom and when) and better security against active network attackers and malicious servers.
+2. Provide better communication security and privacy than the alternative instant messaging solutions. In particular SimpleX provides better privacy of metadata (who talks to whom and when) and better security against active network attackers and malicious servers.
 
 3. Balance user experience with privacy requirements, prioritizing experience of mobile device users.
 
+
 #### In Comparison
 
 SimpleX network has a design similar to P2P networks, but unlike most P2P networks it consists of clients and servers without depending on any centralized component.
@@ -91,53 +98,73 @@ In comparison to more traditional messaging applications (e.g. WhatsApp, Signal,
 
 - users can change servers with minimal disruption - even after an in-use server disappears, simply by changing the configuration on which servers the new queues are created.
 
+
 ## Technical Details
 
 #### Trust in Servers
 
 Clients communicate directly with servers (but not with other clients) using SimpleX Messaging Protocol (SMP) running over some transport protocol that provides integrity, server authentication, confidentiality, and transport channel binding. By default, we assume this transport protocol is TLS.
 
-Users use multiple servers, and choose where to receive their messages. Accordingly, they send messages to their communication partners' chosen servers.
+Users use multiple servers, and choose where to receive their messages. Accordingly, they send messages to their communication partners' chosen servers either directly, if this is a known/trusted server, or via another SMP server providing proxy functionality to protect IP address and session of the sender.
 
-Although end-to-end encryption is always present, users place a degree of trust in servers. This trust decision is very similar to a user's choice of email provider; however the trust placed in a SimpleX server is significantly less. Notably, there is no re-used identifier or credential between queues on the same (or different) servers. While a user *may* re-use a connection to fetch from multiple queues, or connect to a server from the same IP address, both are choices a user may opt into to break the promise of un-correlatable queues.
+Although end-to-end encryption is always present, users place a degree of trust in servers they connect to. This trust decision is very similar to a user's choice of email provider; however the trust placed in a SimpleX server is significantly less. Notably, there is no re-used identifier or credential between queues on the same (or different) servers. While a user *may* re-use a transport connection to fetch messages from multiple queues, or connect to a server from the same IP address, both are choices a user may opt into to break the promise of un-correlatable queues.
 
 Users may trust a server because:
 
-- They deploy and control the servers themselves from the available open-source code. This has the trade-offs of strong trust in the server but limited metadata obfuscation to a passive network observer. Techniques such as noise traffic, traffic mixing (incurring latency), and using an onion routing transport protocol can mitigate that latter.
+- They deploy and control the servers themselves from the available open-source code. This has the trade-offs of strong trust in the server but limited metadata obfuscation to a passive network observer. Techniques such as noise traffic, traffic mixing (incurring latency), and using an onion routing transport protocol can mitigate that.
 
 - They use servers from a trusted commercial provider. The more clients the provider has, the less metadata about the communication times is leaked to the network observers.
 
-- Users trust their contacts and the servers they chose.
+By default, servers do not retain access logs, and permanently delete messages and queues when requested. Messages persist only in memory until they cross a threshold of time, typically on the order of days.[0] There is still a risk that a server maliciously records all queues and messages (even though encrypted) sent via the same transport connection to gain a partial knowledge of the user’s communications graph and other meta-data.
 
-By default, servers do not retain access logs, and permanently delete messages and queues when requested.  Messages persist only in memory until they cross a threshold of time, typically on the order of days.[0] There is still a risk that a server maliciously records all queues and messages (even though encrypted) sent via the same transport connection to gain a partial knowledge of the user’s communications graph and other meta-data.
+SimpleX supports measures (managed transparently to the user at the agent level) to mitigate the trust placed in servers.  These include rotating the queues in use between users, noise traffic, supporting overlay networks such as Tor, and isolating traffic to different queues to different transport connections (and Tor circuits, if Tor is used).
 
-SimpleX supports measures (managed transparently to the user at the agent level) to mitigate the trust placed in servers.  These include rotating the queues in use between users, noise traffic, and supporting overlay networks such as Tor.
-
-[0] While configurable by servers, a minimum value is enforced by the default software. SimpleX Agents provide redundant routing over queues to mitigate against message loss.
+[0] While configurable by servers, a minimum value is enforced by the default software. SimpleX Agents can provide redundant routing over queues to mitigate against message loss.
 
 
 #### Client -> Server Communication
 
 Utilizing TLS grants the SimpleX Messaging Protocol (SMP) server authentication and metadata protection to a passive network observer. But SMP does not rely on the transport protocol for message confidentiality or client authentication. The SMP protocol itself provides end-to-end confidentiality, authentication, and integrity of messages between communicating parties.
 
-Servers have long-lived, self-signed, offline certificates whose hash is pre-shared with clients over secure channels - either provided with the client library or provided in the secure introduction between clients.  The offline certificate signs an online certificate used in the transport protocol handshake. [0]
+Servers have long-lived, self-signed, offline certificates whose hash is pre-shared with clients over secure channels - either provided with the client library or provided in the secure introduction between clients, as part of the server address.  The offline certificate signs an online certificate used in the transport protocol handshake. [0]
 
 If the transport protocol's confidentiality is broken, incoming and outgoing messages to the server cannot be correlated by message contents. Additionally, because of encryption at the SMP layer, impersonating the server is not sufficient to pass (and therefore correlate) a message from a sender to recipient - the only attack possible is to drop the messages. Only by additionally *compromising* the server can one pass and correlate messages.
 
 It's important to note that the SMP protocol does not do server authentication. Instead we rely upon the fact that an attacker who tricks the transport protocol into authenticating the server incorrectly cannot do anything with the SMP messages except drop them.
 
-After the connection is established, the client sends blocks of a fixed size 16Kb, and the server replies with the blocks of the same size to reduce metadata observable to a network adversary. The protocol has been designed to make traffic correlation attacks difficult, adapting ideas from Tor, remailers, and more general onion and mix networks. It does not try to replace Tor though - SimpleX servers can be deployed as onion services and SimpleX clients can communicate with servers over Tor to further improve participants privacy.
+After the connection is established, the client sends blocks of a fixed size 16KB, and the server replies with the blocks of the same size to reduce metadata observable to a network adversary. The protocol has been designed to make traffic correlation attacks difficult, adapting ideas from Tor, remailers, and more general onion and mix networks. It does not try to replace Tor though - SimpleX servers can be deployed as onion services and SimpleX clients can communicate with servers over Tor to further improve participants privacy.
 
-By using fixed-size blocks, oversized for the expected content, the vast majority of traffic is uniform in nature. When enough traffic is transiting a server simultaneously, the server acts as a (very) low-latency mix node.  We can't rely on this behavior to make a security claim, but we have engineered to take advantage of it when we can. As mentioned, this holds true even if the transport connection is compromised.
+By using fixed-size blocks, oversized for the expected content, the vast majority of traffic is uniform in nature. When enough traffic is transiting a server simultaneously, the server acts as a low-latency mix node. We can't rely on this behavior to make a security claim, but we have engineered to take advantage of it when we can. As mentioned, this holds true even if the transport connection is compromised.
 
-The protocol does not protect against attacks targeted at particular users with known identities - e.g., if the attacker wants to prove that two known users are communicating, they can achieve it. At the same time, it substantially complicates large-scale traffic correlation, making determining the real user identities much less effective.
+The protocol does not protect against attacks targeted at particular users with known identities - e.g., if the attacker wants to prove that two known users are communicating, they can achieve it by observing their local traffic. At the same time, it substantially complicates large-scale traffic correlation, making determining the real user identities much less effective.
 
 [0] Future versions of SMP may add support for revocation lists of certificates, presently this risk is mitigated by the SMP protocol itself.
 
 
+#### 2-hop Onion Message Routing
+
+As SimpleX Messaging Protocol servers providing messaging queues are chosen by the recipients, in case senders connect to these servers directly the server owners (who potentially can be the recipients themselves) can learn senders' IP addresses (if Tor is not used) and which other queues on the same server are accessed by the user in the same transport connection (even if Tor is used).
+
+While the clients support isolating the messages sent to different queues into different transport connections (and Tor circuits), this is not practical, as it consumes additional traffic and system resources.
+
+To mitigate this problem SimpleX Messaging Protocol servers support 2-hop onion message routing when the SMP server chosen by the sender forwards the messages to the servers chosen by the recipients, thus protecting both the senders IP addresses and sessions, even if connection isolation and Tor are not used.
+
+The design of 2-hop onion message routing prevents these potential attacks:
+
+- MITM by proxy (SMP server that forwards the messages).
+
+- Identification by the proxy which and how many queues the sender sends messages to (as messages are additionally e2e encrypted between the sender and the destination SMP server).
+
+- Correlation of messages sent to different queues via the same user session (as random correlation IDs and keys are used for each message).
+
+See more details about 2-hop onion message routing design in [SimpleX Messaging Protocol](./simplex-messaging.md#proxying-sender-commands)
+
+Also see [Threat model](#threat-model)
+
+
 #### SimpleX Messaging Protocol
 
-SMP is initialized with an in-person or out-of-band introduction message, where Alice provides Bob with details of a server (including IP, port, and hash of the long-lived offline certificate), a queue ID, and Alice's public key for her receiving queue. These introductions are similar to the PANDA key-exchange, in that if observed, the adversary can race to establish the communication channel instead of the intended participant. [0]
+SMP is initialized with an in-person or out-of-band introduction message, where Alice provides Bob with details of a server (including IP address or host name, port, and hash of the long-lived offline certificate), a queue ID, and Alice's public keys to agree e2e encryption. These introductions are similar to the PANDA key-exchange, in that if observed, the adversary can race to establish the communication channel instead of the intended participant. [0]
 
 Because queues are uni-directional, Bob provides an identically-formatted introduction message to Alice over Alice's now-established receiving queue.
 
@@ -145,6 +172,7 @@ When setting up a queue, the server will create separate sender and recipient qu
 
 [0] Users can additionally create public 'contact queues' that are only used to receive connection requests.  
 
+
 #### SimpleX Agents
 
 SimpleX agents provide higher-level operations compared to SimpleX Clients, who are primarily concerned with creating queues and communicating with servers using SMP.  Agent operations include:
@@ -157,9 +185,10 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
 
 - Noise traffic
 
+
 #### Encryption Primitives Used
 
-- Ed448 to sign/verify commands to SMP servers (Ed25519 is also supported via client/server configuration).
+- Ed25519 or Curve25519 to authorize/verify commands to SMP servers (authorization algorithm is set via client/server configuration).
 - Curve25519 for DH exchange to agree:
   - the shared secret between server and recipient (to encrypt message bodies - it avoids shared cipher-text in sender and recipient traffic)
   - the shared secret between sender and recipient (to encrypt messages end-to-end in each queue - it avoids shared cipher-text in redundant queues).
@@ -170,42 +199,44 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
   - AES-GCM AEAD cipher,
   - SHA512-based HKDF for key derivation.
 
+
 ## Threat Model
 
 #### Global Assumptions
 
- - A user protects their local database and key material
- - The user's application is authentic, and no local malware is running
- - The cryptographic primitives in use are not broken
+ - A user protects their local database and key material.
+ - The user's application is authentic, and no local malware is running.
+ - The cryptographic primitives in use are not broken.
  - A user's choice of servers is not directly tied to their identity or otherwise represents distinguishing information about the user.
+ - The user's client uses 2-hop onion message routing.
 
 #### A passive adversary able to monitor the traffic of one user
 
 *can:*
 
- - identify that and when a user is using SimpleX
+ - identify that and when a user is using SimpleX.
 
- - block SimpleX traffic
-
- - determine which servers the user communicates with
+ - determine which servers the user receives the messages from.
 
  - observe how much traffic is being sent, and make guesses as to its purpose.
 
 *cannot:*
 
- - see who sends messages to the user and who the user sends the messages to
+ - see who sends messages to the user and who the user sends the messages to.
+
+ - determine the servers used by users' contacts.
 
 #### A passive adversary able to monitor a set of senders and recipients
 
  *can:*
 
- - identify who and when is using SimpleX
+ - identify who and when is using SimpleX.
 
- - learn which SimpleX Messaging Protocol servers are used as receive queues for which users
+ - learn which SimpleX Messaging Protocol servers are used as receive queues for which users.
 
- - learn when messages are sent and received
+ - learn when messages are sent and received.
 
- - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers
+ - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
 
  - observe how much traffic is being sent, and make guesses as to its purpose
 
@@ -217,43 +248,83 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
 
 *can:*
 
-- learn when a queue recipient or sender is online
+- learn when a queue recipient is online
 
-- know how many messages are sent via the queue (although some may be noise)
+- know how many messages are sent via the queue (although some may be noise or not content messages).
 
-- perform queue correlation (matching multiple queues to a single user) via either a re-used transport connection, user's IP Address, or connection timing regularities
+- learn which messages would trigger notifications even if a user does not use [push notifications](./push-notifications.md).
 
-- learn a user'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, as long as Tor is not used.
+- perform the correlation of the queue used to receive messages (matching multiple queues to a single user) via either a re-used transport connection, user's IP Address, or connection timing regularities.
 
-- drop all future messages inserted into a queue, detectable only over other, redundant queues
+- learn a recipient'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, as long as Tor is not used.
+
+- drop all future messages inserted into a queue, detectable only over other, redundant queues.
 
 - lie about the state of a queue to the recipient and/or to the sender  (e.g. suspended or deleted when it is not).
 
-- spam a user with invalid messages
+- spam a user with invalid messages.
 
 *cannot:*
 
-- undetectably add, duplicate, or corrupt individual messages
+- undetectably add, duplicate, or corrupt individual messages.
 
-- undetectably drop individual messages, so long as a subsequent message is delivered
+- undetectably drop individual messages, so long as a subsequent message is delivered.
 
-- learn the contents of messages
+- learn the contents or type of messages.
 
-- distinguish noise messages from regular messages except via timing regularities
+- distinguish noise messages from regular messages except via timing regularities.
 
-- compromise the user's end-to-end encryption with an active attack
+- compromise the users' end-to-end encryption with an active attack.
+
+- 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 (provided messages are sent via proxy SMP server).
+
+- 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 the proxy SMP server (provided messages are sent via proxy SMP server).
+
+#### SimpleX Messaging Protocol server that proxies the messages to another SMP server
+
+*can:*
+
+- learn a sender's IP address, as long as Tor is not used.
+
+- learn when a sender with a given IP address is online.
+
+- know how many messages are sent from a given IP address and to a given destination SMP server.
+
+- drop all messages from a given IP address or to a given destination server.
+
+- unless destination SMP server detects repeated public DH keys of senders, replay messages to a destination server 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 server, 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 the destination SMP server.
+
+- undetectably add, duplicate, or corrupt individual messages.
+
+- undetectably drop individual messages, so long as a subsequent message is delivered.
+
+- learn the contents or type of messages.
+
+- learn which messages would trigger notifications.
+
+- 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 the destination SMP servers via an active attack.
 
 #### An attacker who obtained Alice's (decrypted) chat database
 
 *can:*
 
-- see the history of all messages exchanged by Alice with her communication partners
+- see the history of all messages exchanged by Alice with her communication partners.
 
-- see shared profiles of contacts and groups
+- see shared profiles of contacts and groups.
 
-- surreptitiously receive new messages sent to Alice via existing queues; until communication queues are rotated or the Double-Ratchet advances forward
+- surreptitiously receive new messages sent to Alice via existing queues; until communication queues are rotated or the Double-Ratchet advances forward.
 
-- prevent Alice from receiving all new messages sent to her - either surreptitiously by emptying the queues regularly or overtly by deleting them
+- prevent Alice from receiving all new messages sent to her - either surreptitiously by emptying the queues regularly or overtly by deleting them.
 
 - send messages from the user to their contacts; recipients will detect it as soon as the user sends the next message, because the previous message hash won’t match (and potentially won’t be able to decrypt them in case they don’t keep the previous ratchet keys).
 
@@ -269,41 +340,41 @@ SimpleX agents provide higher-level operations compared to SimpleX Clients, who
 
 *can:*
 
-- spam the user with messages
+- spam the user with messages.
 
-- forever retain messages from the user
+- forever retain messages from the user.
 
 *cannot:*
 
-- cryptographically prove to a third-party that a message came from a user (assuming the user’s device is not seized)
+- cryptographically prove to a third-party that a message came from a user (assuming the user’s device is not seized).
 
-- prove that two contacts they have is the same user
+- prove that two contacts they have is the same user.
 
-- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user
+- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user.
 
 #### An attacker who observes Alice showing an introduction message to Bob
 
 *can:*
 
- - Impersonate Bob to Alice
+ - Impersonate Bob to Alice.
 
 *cannot:*
 
- - Impersonate Alice to Bob
+ - Impersonate Alice to Bob.
 
 #### An attacker with Internet access
 
 *can:*
 
-- Denial of Service SimpleX messaging servers
+- Denial of Service SimpleX messaging servers.
 
-- spam a user's public “contact queue” with connection requests
+- spam a user's public “contact queue” with connection requests.
 
 *cannot:*
 
-- send messages to a user who they are not connected with
+- send messages to a user who they are not connected with.
 
-- enumerate queues on a SimpleX server
+- enumerate queues on a SimpleX server.
 
 
 ## Acknowledgements

protocol/pqdr.md

@@ -0,0 +1,222 @@
+Version 1, 2024-06-22
+
+# Post-quantum resistant augmented double ratchet algorithm (PQDR)
+
+## Table of contents
+
+- [Overview](#overview)
+- [Comparison with the other approaches](#comparison-with-the-other-approaches)
+  - [PQXDH for post-quantum key agreement](#pqxdh-for-post-quantum-key-agreement) (Signal)
+  - [Hybrid Signal protocol for post-quantum encryption](#hybrid-signal-protocol-for-post-quantum-encryption) (Tutanota)
+- [Augmented double ratchet algorithm](#augmented-double-ratchet-algorithm)
+- [Double ratchet with encrypted headers augmented with double PQ KEM](#double-ratchet-with-encrypted-headers-augmented-with-double-pq-kem)
+  - [Initialization](#initialization)
+  - [Encrypting messages](#encrypting-messages)
+  - [Decrypting messages](#decrypting-messages)
+- [Implementation considerations](#implementation-considerations)
+- [Chosen KEM algorithm](#chosen-kem-algorithm)
+- [Summary](#summary)
+
+## Overview
+
+It is a reasonable assumption that "record-now-decrypt-later" attacks are ongoing, so the users want to use cryptographic schemes for end-to-end encryption that are augmented with some post-quantum algorithm that is believed to be resistant to quantum computers.
+
+SimpleX Chat uses [double-ratchet with header encryption](https://signal.org/docs/specifications/doubleratchet/#double-ratchet-with-header-encryption) to provide end-to-end encryption to messages and files. This document describes augmented algorithm with post-quantum key encapsulation mechanism (KEM) making it resistant to quantum computers.
+
+Double-ratchet algorithm is a state of the art solution for end to end encryption offering a set of qualities that is not present in any other algorithm:
+
+- perfect forward secrecy, i.e. compromise of session or long term keys does not lead to the ability to decrypt any of the past messages.
+- deniability (also known as repudiation), i.e. the fact that the recipient of the message while having the proof of message authenticity, cannot prove to a third party that the sender actually sent this message.
+- break-in recovery (also know as post-compromise security or future secrecy), i.e. the ability of the end-to-end encryption security to recover from the compromise of the long term keys. This is achieved by generating a new random key pair whenever a new DH key is received (DH ratchet step).
+
+It is desirable to preserve all these qualities when augmenting the algorithm with a post-quantum algorithm, and having these qualities resistant to both conventional and quantum computers.
+
+## Comparison with the other approaches
+
+### PQXDH for post-quantum key agreement
+
+[The solution](https://signal.org/docs/specifications/pqxdh/) recently [introduced by Signal](https://signal.org/blog/pqxdh/) augments the initial key agreement ([X3DH](https://signal.org/docs/specifications/x3dh/)) that is made prior to double ratchet algorithm. This is believed to provide protection from "record-now-decrypt-later" attack, but if the attacker at any point obtains long term keys from any of the devices, the break-in recovery will not be post-quantum resistant, and the attacker with quantum computer will be able to decrypt all the subsequent messages.
+
+### Hybrid Signal protocol for post-quantum encryption
+
+[The solution](https://eprint.iacr.org/2021/875.pdf) [proposed by Tutanota](https://tutanota.com/blog/posts/pqmail-update/) aims to preserve the break-in recovery property of double ratchet, but in doing so it:
+- replaces rather than augments DH key agreement with post-quantum KEM mechanism, making it potentially vulnerable to conventional computers.
+- adds signature to the DH ratchet step, to compensate for not keeping DH key agreement, but losing the deniability property for some of the messages.
+
+## Augmented double ratchet algorithm
+
+The double ratchet algorithm is augmented with post-quantum KEM mechanism, preserving all properties of the double ratchet algorithm.
+
+It is possible, because although double ratchet uses DH (which is a non-interactive key exchanges), it uses it "interactively", when the new DH keys are generated by both parties in turns. Parties of double-ratchet encrypted communication can run two post-quantum key encapsulation mechanisms in parallel with both DH and KEM key agreements in each DH ratchet step, making break-in recovery of double ratchet algorithm post-quantum resistant, without losing deniability or resistance to conventional computers.
+
+Specifically, [double ratchet with encrypted headers](https://signal.org/docs/specifications/doubleratchet/#double-ratchet-with-header-encryption) is augmented with some post-quantum key encapsulation mechanism (KEM) as described below. A possible algorithm for PQ KEM is [NTRU-prime](https://ntruprime.cr.yp.to), that is currently adopted in SSH and has available implementations. It is important though that the proposed scheme can be used with any PQ KEM algorithm.
+
+The downside of the scheme is its substantial size overhead, as the encapsulation key and encapsulated shared secret are added to the header of each message. For the algorithm described below NTRU-prime adds ~2-4kb to each message (depending on the key size and the chosen variant). See [this table](https://ntruprime.cr.yp.to/security.html) for key and ciphertext sizes and the assessment of the security level for various key sizes.
+
+It is possible to reduce size overhead by using only one KEM agreement and making only one of two ratchet steps providing post-quantum resistant break-in recovery.
+
+## Double ratchet with encrypted headers augmented with double PQ KEM
+
+Algorithm below assumes that in addition to shared secret from the initial key agreement, there will be an encapsulation key available from the party that published its keys (Bob).
+
+### Initialization
+
+The double ratchet initialization is defined in pseudo-code. This pseudo-code is identical to Signal algorithm specification except for that parts that add post-quantum key agreement.
+
+```
+// Alice obtained Bob's keys and initializes ratchet first
+def RatchetInitAlicePQ2HE(state, SK, bob_dh_public_key, shared_hka, shared_nhkb, bob_pq_kem_encapsulation_key):
+    state.DHRs = GENERATE_DH()
+    state.DHRr = bob_dh_public_key
+    // below added for post-quantum KEM
+    state.PQRs = GENERATE_PQKEM()
+    state.PQRr = bob_pq_kem_encapsulation_key
+    state.PQRss = random // shared secret for KEM
+    state.PQRct = PQKEM-ENC(state.PQRr, state.PQRss) // encapsulated additional shared secret
+    // above added for KEM
+    // the next line augments DH key agreement with PQ shared secret
+    state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr) || state.PQRss) 
+    state.CKr = None
+    state.Ns = 0
+    state.Nr = 0
+    state.PN = 0
+    state.MKSKIPPED = {}
+    state.HKs = shared_hka
+    state.HKr = None
+    state.NHKr = shared_nhkb
+
+// Bob initializes ratchet second, having received Alice's connection request
+def RatchetInitBobPQ2HE(state, SK, bob_dh_key_pair, shared_hka, shared_nhkb, bob_pq_kem_key_pair):
+    state.DHRs = bob_dh_key_pair
+    state.DHRr = None
+    // below added for KEM
+    state.PQRs = bob_pq_kem_key_pair
+    state.PQRr = None
+    state.PQRss = None
+    state.PQRct = None
+    // above added for KEM
+    state.RK = SK 
+    state.CKs = None
+    state.CKr = None
+    state.Ns = 0
+    state.Nr = 0
+    state.PN = 0
+    state.MKSKIPPED = {}
+    state.HKs = None
+    state.NHKs = shared_nhkb
+    state.HKr = None
+    state.NHKr = shared_hka
+```
+
+`GENERATE_PQKEM` generates decapsulation/encapsulation key pair.
+
+`PQKEM-ENC` is key encapsulation algorithm.
+
+Other than commented lines, the above adds parameters `bob_pq_kem_encapsulation_key` and `bob_pq_kem_key_pair` to the ratchet initialization. Otherwise it is identical to the original double ratchet initialization.
+
+### Encrypting messages
+
+```
+def RatchetEncryptPQ2HE(state, plaintext, AD):
+    state.CKs, mk = KDF_CK(state.CKs)
+    // encapsulation key from PQRs and encapsulated shared secret is added to header
+    header = HEADER_PQ2(
+      dh = state.DHRs.public,
+      kem = state.PQRs.public, // added for KEM #2
+      ct = state.PQRct // added for KEM #1
+      pn = state.PN,
+      n = state.Ns,
+    )
+    enc_header = HENCRYPT(state.HKs, header)
+    state.Ns += 1
+    return enc_header, ENCRYPT(mk, plaintext, CONCAT(AD, enc_header))
+```
+
+Other than adding encapsulation key and encapsulated shared secret into the header, the above is identical to the original double ratchet message encryption step.
+
+### Decrypting messages
+
+```
+def RatchetDecryptPQ2HE(state, enc_header, ciphertext, AD):
+    plaintext = TrySkippedMessageKeysHE(state, enc_header, ciphertext, AD)
+    if plaintext != None:
+        return plaintext
+    header, dh_ratchet = DecryptHeader(state, enc_header) // DecryptHeader is the same as in double ratchet specification
+    if dh_ratchet:
+        SkipMessageKeysHE(state, header.pn) // SkipMessageKeysHE is the same as in double ratchet specification
+        DHRatchetPQ2HE(state, header)
+    SkipMessageKeysHE(state, header.n)
+    state.CKr, mk = KDF_CK(state.CKr)
+    state.Nr += 1
+    return DECRYPT(mk, ciphertext, CONCAT(AD, enc_header))
+
+// DecryptHeader is the same as in double ratchet specification
+def DecryptHeader(state, enc_header):
+    header = HDECRYPT(state.HKr, enc_header)
+    if header != None:
+        return header, False
+    header = HDECRYPT(state.NHKr, enc_header)
+    if header != None:
+        return header, True
+    raise Error()
+
+def DHRatchetPQ2HE(state, header):
+    state.PN = state.Ns
+    state.Ns = 0
+    state.Nr = 0
+    state.HKs = state.NHKs
+    state.HKr = state.NHKr
+    state.DHRr = header.dh
+    // save new encapsulation key from header
+    state.PQRr = header.kem
+    // decapsulate shared secret from header - KEM #2
+    ss = PQKEM-DEC(state.PQRs.private, header.ct)
+    // use decapsulated shared secret with receiving ratchet
+    state.RK, state.CKr, state.NHKr = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr) || ss)
+    state.DHRs = GENERATE_DH()
+    // below is added for KEM
+    state.PQRs = GENERATE_PQKEM() // generate new PQ key pair
+    state.PQRss = random // shared secret for KEM
+    state.PQRct = PQKEM-ENC(state.PQRr, state.PQRss) // encapsulated additional shared secret KEM #1
+    // above is added for KEM
+    // use new shared secret with sending ratchet
+    state.RK, state.CKs, state.NHKs = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr) || state.PQRss)
+```
+
+`PQKEM-DEC` is key decapsulation algorithm.
+
+`DHRatchetPQ2HE` augments both DH agreements with decapsulated shared secret from the received header and with the new shared secret, respectively. The new shared secret together with the new encapsulation key are saved in the state and will be added to the header in the next sent message.
+
+Other than augmenting DH key agreements with the shared secrets from KEM, the above is identical to the original double ratchet DH ratchet step.
+
+It is worth noting that while DH agreements work as ping-pong, when the new received DH key is used for both DH agreements (and only the sent DH key is updated for the second DH key agreement), PQ KEM agreements in the proposed scheme work as a "parallel ping-pong", with two balls in play all the time (two KEM agreements run in parallel).
+
+## Implementation considerations for SimpleX Messaging Protocol
+
+As SimpleX Messaging Protocol pads messages to a fixed size, using 16kb transport blocks, the size increase introduced by this scheme can be compensated for by using ZSTD encryption of JSON bodies and image previews encoded as base64. While there may be some rare cases of random texts that would fail to compress, in all real scenarios it would not cause the message size reduction.
+
+Sharing the initial keys in case of SimpleX Chat it is equivalent to sharing the invitation link. As encapsulation key is large, it may be inconvenient to share it in the link in some contexts, e.g. when QR codes are used.
+
+It is possible to postpone sharing the encapsulation key until the first message from Alice (confirmation message in SMP protocol), the party sending connection request. The upside here is that the invitation link size would not increase. The downside is that the user profile shared in this confirmation will not be encrypted with PQ-resistant algorithm.
+
+Another consideration is pairwise ratchets in groups. Key generation in sntrup761 is quite slow - on slow devices it can be as slow as 10-20 keys per second, so using this primitive in groups larger than 10-20 members would result in slow performance.
+
+For backward compatibility the implementation must support adding PQ-resistant key agreement to the existing connections.
+
+It is also beneficial to support removing PQ-resistant key agreement from the connections that have them, e.g. as the group size grows.
+
+### Chosen KEM algorithm
+
+The implementation uses Streamlined NTRU-Prime 761 (sntrup761) that was also used for OpenSSH for a long time.
+
+It was chosen over ML-KEM (Kyber) standardized by NIST for several reasons:
+
+- sntrup761 was used in OpenSSH for a long period of time.
+- ML-KEM standardization process raised [concerns](https://groups.google.com/a/list.nist.gov/g/pqc-forum/c/WFRDl8DqYQ4) [amongst](https://blog.cr.yp.to/20231003-countcorrectly.html) the experts.
+- ML-KEM (if modified) is likely to have conflicts with the existing patents, unlike sntrup761.
+
+It was chosen over non-interactive CTIDH due to its slower implementation, and lack of optimized code for aarch64 CPUs used in mobile devices.
+
+## Summary
+
+If chosen PQ KEM proves secure against quantum computer attacks, then the proposed augmented double ratchet will also be secure against quantum computer attack, including break-in recovery property, while keeping deniability and forward secrecy, because the [same proof](https://eprint.iacr.org/2016/1013.pdf) as for double ratchet algorithm would hold here, provided chosen KEM is secure.

protocol/push-notifications.md

@@ -0,0 +1,398 @@
+Version 2, 2024-06-22
+
+# Overview of push notifications for SimpleX Messaging Servers
+
+## Table of contents
+
+- [Introduction](#introduction)
+- [Participating servers](#participating-servers)
+- [Register device token to receive push notifications](#register-device-token-to-receive-push-notifications)
+- [Subscribe to connection notifications](#subscribe-to-connection-notifications)
+- [SimpleX Notification Server protocol](#simplex-notification-server-protocol)
+  - [Register new notification token](#register-new-notification-token)
+  - [Verify notification token](#verify-notification-token)
+  - [Check notification token status](#check-notification-token-status)
+  - [Replace notification token](#replace-notification-token)
+  - [Delete notification token](#delete-notification-token)
+  - [Subscribe to periodic notifications](#subscribe-to-periodic-notifications)
+  - [Create SMP message notification subscription](#create-smp-message-notification-subscription)
+  - [Check notification subscription status](#check-notification-subscription-status)
+  - [Delete notification subscription](#delete-notification-subscription)
+  - [Error responses](#error-responses)
+- [Threat model](#threat-model)
+
+## Introduction
+
+SimpleX Messaging servers already operate as push servers and deliver the messages to subscribed clients as soon as they are sent to the servers.
+
+The reason for push notifications is to support instant message notifications on iOS that does not allow background services.
+
+## Participating servers
+
+The diagram below shows which servers participate in message notification delivery.
+
+While push provider (e.g., APN) can learn how many notifications are delivered to the user, it cannot access message content, even encrypted, or any message metadata - the notifications are e2e encrypted between SimpleX Notification Server and the user's device.
+
+```
+  User's iOS device                Internet                           Servers
+---------------------   .   ------------------------   .   -----------------------------
+                        .                              .
+                        .                              .       can be self-hosted now
++--------------+        .                              .         +----------------+
+| SimpleX Chat |       -------------- TLS ---------------        | SimpleX        |
+|    client    |------> SimpleX Messaging Protocol (SMP) ------> | Messaging      |
++--------------+       ----------------------------------        | Server         |
+     ^    |             .                              .         +----------------+
+     |    |             .                              .          . . .  |   . . .
+     |    |             .                              .               | V |
+     |    |             .                              .               |SMP| TLS
+     |    |             .                              .               | | |               SimpleX
+     |    |             .                              .          . . .  V   . . .      NTF Server
+     |    |             .                              .       +----------------------------------+
+     |    |             .                              .       | +---------------+                |
+     |    |            -------------- TLS ---------------      | | SimpleX       | can be         | 
+     |    |----------->   Notification Server Protocol  -----> | | Notifications | self-hosted    |
+     |                 ----------------------------------      | | Subscriber    | in the future  |
+     |                  .                              .       | +---------------+                |
+     |                  .                              .       |         |                        |
+     |                  .                              .       |         V                        |
+     |                  .                              .       | +---------------+                |
+     |                  .                              .       | | SimpleX       |                |
+     |                  .                              .       | | Push          |                |
+     |                  .                              .       | | Server        |                |
+     |                  .                              .       | +---------------+                |
+     |                  .                              .       +----------------------------------+
+     |                  .                              .          . . .  |   . . .
+     |                  .                              .               | V |
+     |                  .                              .               |SMP| TLS
+     |                  .                              .               | | |
+     |                  .                              .          . . .  V   . . .
+     |                 -------------- TLS ---------------       +-----------------+
+     |-----------------       Notification delivery     <-------| Apple PN server |
+                       ----------------------------------       +-----------------+
+                        .                              .
+```
+
+## Register device token to receive push notifications
+
+This diagram shows the process of registering a device to receive PUSH notifications via Apple Push Notification (APN) servers.
+
+![Register device notification token](./diagrams/notifications/register-token.svg)
+
+## Subscribe to connection notifications
+
+This diagram shows the process of subscription to notifications, notification delivery and device token update.
+
+![Subscribe to notifications](./diagrams/notifications/subscription.svg)
+
+## SimpleX Notification Server protocol
+
+To manage notification subscriptions to SMP servers, SimpleX Notification Server provides an RPC protocol with a similar design to SimpleX Messaging Protocol server.
+
+This protocol sends requests and responses in a fixed size blocks of 512 bytes over TLS, uses the same [syntax of protocol transmissions](./simplex-messaging.md#smp-transmission-and-transport-block-structure) as SMP protocol, and has the same transport [handshake syntax](./simplex-messaging.md#transport-handshake) (except the server certificate is not included in the handshake).
+
+Protocol commands have this syntax:
+
+```
+ntfServerTransmission = 
+ntfServerCmd = newTokenCmd / verifyTokenCmd / checkTokenCmd /
+               replaceTokenCmd / deleteTokenCmd / cronCmd /
+               newSubCmd / checkSubCmd / deleteSubCmd
+```
+### Register new notification token
+
+This command should be used after the client app obtains a token from push notifications provider to register the token with the server.
+
+Having received this command the server will deliver a test notification via the push provider to validate that the client has this token.
+
+The command syntax:
+
+```abnf
+newTokenCmd = %s"TNEW" SP newToken
+newToken = %s"T" deviceToken authPubKey clientDhPubKey
+deviceToken = pushProvider tokenString
+pushProvider = apnsDev / apnsProd / apnsNull
+apnsDev = "AD" ; APNS token for development environment
+apnsProd = "AP" ; APNS token for production environment
+apnsNull = "AN" ; token that does not trigger any notification delivery - used for server testing
+tokenString = shortString
+authPubKey = length x509encoded ; Ed25519 key used to verify clients commands
+clientDhPubKey = length x509encoded ; X25519 key to agree e2e encryption between the server and client
+shortString = length *OCTET
+length = 1*1 OCTET
+```
+
+The server response syntax:
+
+```abnf
+tokenIdResp = %s"IDTKN" SP entityId serverDhPubKey
+entityId = shortString
+serverDhPubKey = length x509encoded ; X25519 key to agree e2e encryption between the server and client
+```
+
+### Verify notification token
+
+This command is used to verify the token after the device receives the test notification from the push provider.
+
+The command syntax:
+
+```abnf
+verifyTokenCmd = %s"TVFY" SP regCode
+regCode = shortString
+```
+
+The response to this command is `okResp` or `errorResp`
+
+```abnf
+okResp = %s"OK"
+```
+
+### Check notification token status
+
+This command is used to check the token status:
+
+```abnf
+checkTokenCmd = %s"TCHK"
+```
+
+The response to this command:
+
+```abnf
+tokenStatusResp = %s"TKN" SP tokenStatus
+tokenStatus = %s"NEW" / %s"REGISTERED" / %s"INVALID" / %s"CONFIRMED" / %s"ACTIVE" / %s"EXPIRED"
+```
+
+### Replace notification token
+
+This command should be used when push provider issues a new notification token.
+
+It happens when:
+- the app data is migrated to another device.
+- the app is re-installed on the same device.
+- can happen periodically, at push provider discretion.
+
+This command allows to replace the token without re-registering and re-subscribing all notification subscriptions.
+
+Using this command triggers the same verification flow as registering a new token.
+
+The command syntax:
+
+```abnf
+replaceTokenCmd = %s"TRPL" SP deviceToken
+```
+
+The response to this command is `okResp` or `errorResp`.
+
+### Delete notification token
+
+The command syntax:
+
+```abnf
+deleteTokenCmd = %s"TDEL"
+```
+
+The response to this command is `okResp` or `errorResp`.
+
+After this command all message notification subscriptions will be removed and no more notifications will be sent.
+
+### Subscribe to periodic notifications
+
+This command enables or disables periodic notifications sent to the client device irrespective of message notifications.
+
+This is useful for two reasons:
+- it provides better privacy from notification server, as while the server learns the device token, it doesn't learn anything else about user communications.
+- it allows to receive messages when notifications were dropped by push provider, e.g. while the device was offline, or lost by notification server, e.g. while it was restarting.
+
+The command syntax:
+
+```abnf
+cronCmd = %s"TCRN" SP interval
+interval = 2*2 OCTET ; Word16, minutes
+```
+
+The interval for periodic notifications is set in minutes, with the minimum of 20 minutes. The client should pass `0` to disable periodic notifications.
+
+### Create SMP message notification subscription
+
+This command makes notification server subscribe to message notifications from SMP server and to deliver them to push provider:
+
+```abnf
+newSubCmd = %s"SNEW" newSub
+newSub = %s "S" tokenId smpServer notifierId notifierKey
+tokenId = shortString ; returned in response to `TNEW` command
+smpServer = smpServer = hosts port fingerprint
+hosts = length 1*host
+host = shortString
+port = shortString
+fingerprint = shortString
+notifierId = shortString ; returned by SMP server in response to `NKEY` SMP command
+notifierKey = length x509encoded ; private key used to authorize requests to subscribe to message notifications
+```
+
+The response syntax:
+
+```abnf
+subIdResp = %s"IDSUB" SP entityId
+```
+
+### Check notification subscription status
+
+This command syntax:
+
+```abnf
+checkSubCmd = %s"SCHK"
+```
+
+The response:
+
+```abnf
+subStatusResp = %s"SUB" SP subStatus
+subStatus = %s"NEW" / %s"PENDING" / ; e.g., after SMP server disconnect/timeout while ntf server is retrying to connect
+            %s"ACTIVE" / %s"INACTIVE" / %s"END" / ; if another server subscribed to notifications
+            %s"AUTH" / subErrStatus
+subErrStatus = %s"ERR" SP shortString
+```
+
+### Delete notification subscription
+
+The command syntax:
+
+```abnf
+deleteSubCmd = %s"SDEL"
+```
+
+The response to this command is `okResp` or `errorResp`.
+
+After this command no more message notifications will be sent from this queue.
+
+### Error responses
+
+All commands can return error response:
+
+```abnf
+errorResp = %s"ERR" SP errorType
+```
+
+Where `errorType` has the same syntax as in [SimpleX Messaging Protocol](./simplex-messaging.md#error-responses)
+
+## Threat Model
+
+This threat model compliments SimpleX Messaging Protocol [threat model](./overview-tjr.md#threat-model)
+
+#### A passive adversary able to monitor the traffic of one user
+
+*can:*
+
+ - identify that and a user is using SimpleX push notifications.
+
+*cannot:*
+
+ - determine which servers a user subscribed to the notifications from.
+
+#### A passive adversary able to monitor a set of senders and recipients
+
+ *can:*
+
+ - perform more efficient traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
+
+#### SimpleX Messaging Protocol server
+
+*can:*
+
+- learn which messages trigger push notifications.
+
+- learn IP address of SimpleX notification servers used by the user.
+
+- drop message notifications.
+
+- spam a user with invalid notifications.
+
+*cannot:*
+
+- learn user device token for push notifications.
+
+- learn which queues belong to the same users with any additional efficiency compared with not using push notifications.
+
+#### SimpleX Notification Server subscribed to message notifications
+
+*can:*
+
+- learn a user device token.
+
+- learn how many messaging queues and servers a user receives messages from.
+
+- learn how many message notifications are delivered to the user from each queue.
+
+- undetectably drop notifications.
+
+- spam a user with background notifications.
+
+*cannot:*
+
+- learn queue addresses for receiving or sending messages.
+
+- learn the contents or type of messages (not even encrypted).
+
+- learn anything about messages sent without notification flag.
+
+- spam a user with visible notifications (provided the client app can filter push notifications).
+
+- add, duplicate, or corrupt individual messages that will be shown to the user.
+
+#### SimpleX Notification Server subscribed ONLY to periodic notifications
+
+*can:*
+
+- learn a user device token.
+
+- drop periodic notifications.
+
+- spam a user with background notifications.
+
+*cannot:*
+
+- learn how many messaging queues and servers a user receives messages from.
+
+- learn how many message notifications are delivered to the user from each queue.
+
+- learn queue addresses for receiving or sending messages.
+
+- learn the contents or type of messages (not even encrypted).
+
+- learn anything about messages sent without notification flag.
+
+- spam a user with visible notifications (provided the client app can filter push notifications).
+
+- add, duplicate, or corrupt individual messages that will be shown to the user.
+
+#### A user’s contact
+
+*cannot:*
+
+- determine if a user uses push notifications or not.
+
+#### Push notification provider (e.g., APN)
+
+*can:*
+
+- learn that a user uses SimpleX app.
+
+- learn how many notifications are delivered to user's device.
+
+- drop notifications (in fact, APN coalesces notifications delivered while user's device is offline, delivering only the last one).
+
+*cannot:*
+
+- learn which SimpleX Messaging Protocol servers are used by a user (notifications are e2e encrypted).
+
+- learn which or how many messaging queues a user receives notifications from.
+
+- learn the contents or type of messages (not even encrypted, notifications only contain encrypted metadata).
+
+#### An attacker with Internet access
+
+*cannot:*
+
+- register notification token not present on attacker's device.
+
+- enumerate tokens or subscriptions on a SimpleX Notification Server.

protocol/xftp.md

@@ -0,0 +1,632 @@
+Version 2, 2024-06-22
+
+# SimpleX File Transfer Protocol
+
+## Table of contents
+
+- [Abstract](#abstract)
+- [Introduction](#introduction)
+- [XFTP Model](#xftp-model)
+- [Persistence model](#persistence-model)
+- [XFTP procedure](#xftp-procedure)
+- [File description](#file-description)
+- [URIs syntax](#uris-syntax)
+  - [XFTP server URI](#xftp-server-uri)
+  - [File description URI](#file-description-URI)
+- [XFTP qualities and features](#xftp-qualities-and-features)
+- [Cryptographic algorithms](#cryptographic-algorithms)
+- [File chunk IDs](#file-chunk-ids)
+- [Server security requirements](#server-security-requirements)
+- [Transport protocol](#transport-protocol)
+  - [TLS ALPN](#tls-alpn)
+  - [Connection handshake](#connection-handshake)
+  - [Requests and responses](#requests-and-responses)
+- [XFTP commands](#xftp-commands)
+  - [Correlating responses with commands](#correlating-responses-with-commands)
+  - [Command authentication](#command-authentication)
+  - [Keep-alive command](#keep-alive-command)
+  - [File sender commands](#file-sender-commands)
+    - [Register new file chunk](#register-new-file-chunk)
+    - [Add file chunk recipients](#add-file-chunk-recipients)
+    - [Upload file chunk](#upload-file-chunk)
+    - [Delete file chunk](#delete-file-chunk)
+  - [File recipient commands](#file-recipient-commands)
+    - [Download file chunk](#download-file-chunk)
+    - [Acknowledge file chunk download](#acknowledge-file-chunk-download)
+- [Threat model](#threat-model)
+
+## Abstract
+
+SimpleX File Transfer Protocol is a client-server protocol for asynchronous unidirectional file transmission.
+
+It's designed with the focus on communication security, integrity and meta-data privacy, under the assumption that any part of the message transmission network can be compromised.
+
+It is designed as a application level protocol to solve the problem of secure and private file transmission, making [MITM attacks][1] very difficult at any part of the file transmission system, and preserving meta-data privacy of the sent files.
+
+## Introduction
+
+The objective of SimpleX File Transfer Protocol (XFTP) is to facilitate the secure and private unidirectional transfer of files from senders to recipients via persistent file chunks stored by the xftp server.
+
+XFTP is implemented as an application level protocol on top of HTTP2 and TLS.
+
+The protocol describes the set of commands that senders and recipients can send to XFTP servers to create, upload, download and delete file chunks of several pre-defined sizes. XFTP servers SHOULD support chunks of 4 sizes: 64KB, 256KB, 1MB and 4MB (1KB = 1024 bytes, 1MB = 1024KB).
+
+The protocol is designed with the focus on meta-data privacy and security. While using TLS, the protocol does not rely on TLS security by using additional encryption to achieve that there are no identifiers or ciphertext in common in received and sent server traffic, frustrating traffic correlation even if TLS is compromised.
+
+XFTP does not use any form of participants' identities. It relies on out-of-band passing of "file description" - a human-readable YAML document with the list of file chunk locations, hashes and necessary cryptographic keys.
+
+## XFTP Model
+
+The XFTP model has three communication participants: the recipient, the file server (XFTP server) that is chosen and, possibly, controlled by the sender, and the sender.
+
+XFTP server allows uploading fixed size file chunks, with or without basic authentication. The same party that can be the sender of one file chunk can be the recipient of another, without exposing it to the server.
+
+Each file chunk allows multiple recipients, each recipient can download the same chunk multiple times. It allows depending on the threat model use the same recipient credentials for multiple parties, thus reducing server ability to understand the number of intended recipients (but server can still track IP addresses to determine it), or use one unique set of credentials for each recipient, frustrating traffic correlation on the assumption of compromised TLS. In the latter case, senders can create a larger number of recipient credentials to hide the actual number of intended recipients from the servers (which is what SimpleX clients do).
+
+```
+           Sender                      Internet                XFTP relays             Internet         Recipient
+----------------------------   |   -----------------   |   -------------------   |   ------------   |   ---------- 
+                               |                       |                         |                  |
+                               |                       |   (can be self-hosted)  |                  |
+                               |                       |        +---------+      |                  |
+                  chunk 1     ----- HTTP2 over TLS ------       |  XFTP   |     ---- HTTP2 / TLS -----   chunk 1
+                |---> SimpleX File Transfer Protocol (XFTP) --> |  Relay  | --->        XFTP         ------------->|
+                |             ---------------------------       +---------+     ----------------------             |
+                |              |                       |                         |                  |              | 
+                |              |                       |                         |                  |              v
+          +----------+         |                       |        +---------+      |                  |        +-------------+
+          | Sending  | ch. 2  ------- HTTP2 / TLS -------       |  XFTP   |     ---- HTTP2 / TLS ----  ch. 2 |  Receiving  |
+file ---> |   XFTP   | ------>           XFTP            ---->  |  Relay  | --->        XFTP         ------> |     XFTP    | ---> file
+          |  Client  |        ---------------------------       +---------+     ----------------------       |    Client   |
+          +----------+         |                       |                         |                  |        +-------------+
+                |              |                       |                         |                  |              ^
+                |              |                       |        +---------+      |                  |              |
+                |             ------- HTTP2 / TLS -------       |  XFTP   |     ---- HTTP2 / TLS ----              |
+                |------------->           XFTP           ---->  |  Relay  | --->        XFTP         ------------->|
+                   chunk N    ---------------------------       +---------+     ---------------------    chunk N
+                               |                       |   (store file chunks)   |                  |
+                               |                       |                         |                  |
+                               |                       |                         |                  |
+```
+
+When sender client uploads a file chunk, it has to register it first with one sender ID and multiple recipient IDs, and one random unique key per ID to authenticate sender and recipients, and also provide its size and hash that will be validated when chunk is uploaded.
+
+To send the actual file, the sender client MUST pad it and encrypt it with a random symmetric key and distribute chunks of fixed sized across multiple XFTP servers. Information about chunk locations, keys, hashes and required keys is passed to the recipients as "[file description](#file-description)" out-of-band.
+
+Creating, uploading, downloading and deleting file chunks requires sending commands to the XFTP server - they are described in detail in [XFTP commands](#xftp-commands) section.
+
+## Persistence model
+
+Server stores file chunk records in memory, with optional adding to append-only log, to allow restoring them on server restart. File chunk bodies can be stored as files or as objects in any object store (e.g. S3).
+
+## XFTP procedure
+
+1. Sending the file.
+
+To send the file, the sender will:
+
+1) Prepare file
+  - compute its SHA512 digest.
+  - prepend header with the name and pad the file to match the whole number of chunks in size. It is RECOMMENDED to use 2 of 4 allowed chunk sizes, to balance upload size and metadata privacy.
+  - encrypt it with a randomly chosen symmetric key and IV (e.g., using NaCL secret_box).
+  - split into allowed size chunks.
+  - generate per-recipient keys. It is recommended that the sending client generates more per-recipient keys than the actual number of recipients, rounding up to a power of 2, to conceal the actual number of intended recipients.
+
+2) Upload file chunks
+  - register each chunk record with randomly chosen one or more (for redundancy) XFTP server(s).
+  - optionally request additional recipient IDs, if required number of recipient keys didn't fit into register request.
+  - upload each chunk to chosen server(s).
+
+3) Prepare file descriptions, one per recipient.
+
+The sending client combines addresses of all chunks and other information into "file description", different for each file recipient, that will include:
+
+- an encryption key used to encrypt/decrypt the full file (the same for all recipients).
+- file SHA512 digest to validate download.
+- list of chunk descriptions; information for each chunk:
+  - private Ed25519 key to sign commands for file transfer server.
+  - chunk address (server host and chunk ID).
+  - chunk sha512 digest.
+
+To reduce the size of file description, chunks are grouped by the server host.
+
+4) Send file description(s) to the recipient(s) out-of-band, via pre-existing secure and authenticated channel. E.g., SimpleX clients send it as messages via SMP protocol, but it can be done via any other channel.
+
+![Sending file](./diagrams/xftp/xftp-sending-file.svg)
+
+2. Receiving the file.
+
+Having received the description, the recipient will:
+
+1) Download all chunks.
+
+The receiving client can fall back to secondary servers, if necessary:
+- if the server is not available.
+- if the chunk is not present on the server (ERR AUTH response).
+- if the hash of the downloaded file chunk does not match the description.
+
+Optionally recipient can acknowledge file chunk reception to delete file ID from server for this recipient.
+
+2) Combine the chunks into a file.
+
+3) Decrypt the file using the key in file description.
+
+4) Extract file name and unpad the file.
+
+5) Validate file digest with the file description.
+
+![Receiving file](./diagrams/xftp/xftp-receiving-file.svg)
+
+## File description
+
+"File description" is a human-readable YAML document that is sent via secure and authenticated channel.
+
+It includes these fields:
+- `party` - "sender" or "recipient". Sender's file description is required to delete the file.
+- `size` - padded file size equal to total size of all chunks, see `fileSize` syntax below.
+- `digest` - SHA512 hash of encrypted file, base64url encoded string.
+- `key` - symmetric encryption key to decrypt the file, base64url encoded string.
+- `nonce` - nonce to decrypt the file, base64url encoded string.
+- `chunkSize` - default chunk size, see `fileSize` syntax below.
+- `replicas` - the array of file chunk replicas descriptions.
+- `redirect` - optional property for redirect information indicating that the file is itself a description to another file, allowing to use file description as a short URI.
+
+Each replica description is an object with 2 fields:
+
+- `chunks` - and array of chunk replica descriptions stored on one server.
+- `server` - [server address](#xftp-server-uri) where the chunks can be downloaded from.
+
+Each server replica description is a string with this syntax:
+
+```abnf
+chunkReplica = chunkNo ":" replicaId ":" replicaKey [":" chunkDigest [":" chunkSize]]
+chunkNo = 1*DIGIT
+  ; a sequential 1-based chunk number in the original file.
+replicaId = base64url
+  ; server-assigned random chunk replica ID.
+replicaKey = base64url
+  ; sender-generated random key to receive (or to delete, in case of sender's file description) the chunk replica.
+chunkDigest = base64url
+  ; chunk digest that MUST be specified for the first replica of each chunk,
+  ; and SHOULD be omitted (or be the same) on the subsequent replicas
+chunkSize = fileSize
+fileSize = sizeInBytes / sizeInUnits
+  ; chunk size SHOULD only be specified on the first replica and only if it is different from default chunk size
+sizeInBytes = 1*DIGIT
+sizeInUnits = 1*DIGIT sizeUnit
+sizeUnit = %s"kb" / %s"mb" / %s"gb"
+base64url = <base64url encoded binary> ; RFC4648, section 5
+```
+
+Optional redirect information has two fields:
+- `size` - the size of the original encrypted file to which file description downloaded via the current file description will lead to, see `fileSize` syntax below.
+- `digest` - SHA512 hash of the original file, base64url encoded string.
+
+## URIs syntax
+
+### XFTP server URI
+
+The XFTP server address is a URI with the following syntax:
+
+```abnf
+xftpServerURI = %s"xftp://" xftpServer
+xftpServer = serverIdentity [":" basicAuth] "@" srvHost [":" port]
+srvHost = <hostname> ; RFC1123, RFC5891
+port = 1*DIGIT
+serverIdentity = base64url
+basicAuth = base64url
+```
+
+### File description URI
+
+This file description URI can be generated by the client application to share a small file description as a QR code or as a link. Practically, to be able to scan a QR code it should be under 1000 characters, so only file descriptions with 1-2 chunks can be used in this case. This is supported with `redirect` property when file description leads to a file which in itself is a larger file description to another file - akin to URL shortener.
+
+File description URI syntax:
+
+```abnf
+fileDescriptionURI = serviceScheme "/file"  "#/?desc=" description [ "&data=" userData ]
+serviceScheme = (%s"https://" clientAppServer) | %s"simplex:"
+clientAppServer = hostname [ ":" port ]
+; client app server, e.g. simplex.chat
+description = <URI-escaped YAML file description>
+userData = <any URI-compatible string>
+```
+
+clientAppServer is not a server the client connects to - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device.
+
+"simplex" URI scheme in serviceScheme can be used instead of client app server. Client apps MUST support this URI scheme.
+
+## XFTP qualities and features
+
+XFTP stands for SimpleX File Transfer Protocol. Its design is based on the same ideas and has some of the qualities of SimpleX Messaging Protocol:
+
+- recipient cannot see sender's IP address, as the file fragments (chunks) are temporarily stored on multiple XFTP relays.
+- file can be sent asynchronously, without requiring the sender to be online for file to be received.
+- there is no network of peers that can observe this transfer - sender chooses which XFTP relays to use, and can self-host their own.
+- XFTP relays do not have any file metadata - they only see individual chunks, with access to each chunk authorized with anonymous credentials (using Edwards curve cryptographic signature) that are random per chunk.
+- chunks have one of the sizes allowed by the servers - 64KB, 256KB, 1MB and 4MB chunks, so sending a large file looks indistinguishable from sending many small files to XFTP server. If the same transport connection is reused, server would only know that chunks are sent by the same user.
+- each chunk can be downloaded by multiple recipients, but each recipient uses their own key and chunk ID to authorize access, and the chunk is encrypted by a different key agreed via ephemeral DH keys (NaCl crypto_box (SalsaX20Poly1305 authenticated encryption scheme ) with shared secret derived from Curve25519 key exchange) on the way from the server to each recipient. XFTP protocol as a result has the same quality as SMP protocol - there are no identifiers and ciphertext in common between sent and received traffic inside TLS connection, so even if TLS is compromised, it complicates traffic correlation attacks.
+- XFTP protocol supports redundancy - each file chunk can be sent via multiple relays, and the recipient can choose the one that is available. Current implementation of XFTP protocol in SimpleX Chat does not support redundancy though.
+- the file as a whole is encrypted with a random symmetric key using NaCl secret_box.
+
+## Cryptographic algorithms
+
+Clients must cryptographically authorize XFTP commands, see [Command authentication](#command-authentication).
+
+To authorize/verify transmissions clients and servers MUST use either signature algorithm Ed25519 algorithm defined in RFC8709 or using deniable authentication scheme based on NaCL crypto_box (see Simplex Messaging Protocol).
+
+To encrypt/decrypt file chunk bodies delivered to the recipients, servers/clients MUST use NaCL crypto_box.
+
+Clients MUST encrypt file chunk bodies sent via XFTP servers using use NaCL crypto_box.
+
+## File chunk IDs
+
+XFTP servers MUST generate a separate new set of IDs for each new chunk - for the sender (that uploads the chunk) and for each intended recipient. It is REQUIRED that:
+
+- These IDs are different and unique within the server.
+- Based on random bytes generated with cryptographically strong pseudo-random number generator.
+
+## Server security requirements
+
+XFTP server implementations MUST NOT create, store or send to any other servers:
+
+- Logs of the client commands and transport connections in the production environment.
+
+- History of retrieved files.
+
+- Snapshots of the database they use to store file chunks (instead clients can manage redundancy by creating chunk replicas using more than one XFTP server). In-memory persistence is recommended for file chunks records.
+
+- Any other information that may compromise privacy or [forward secrecy][4] of communication between clients using XFTP servers.
+
+## Transport protocol
+
+- binary-encoded commands sent as fixed-size padded block in the body of HTTP2 POST request, similar to SMP and notifications server protocol transmission encodings.
+- HTTP2 POST with a fixed size padded block body for file upload and download.
+
+Block size - 4096 bytes (it would fit ~120 Ed25519 recipient keys).
+
+The reasons to use HTTP2:
+
+- avoid the need to have two hostnames (or two different ports) for commands and file uploads.
+- compatibility with the existing HTTP2 client libraries.
+
+The reason not to use JSON bodies:
+
+- bigger request size, so fewer recipient keys would fit in a single request
+- signature over command has to be outside of JSON anyway.
+
+The reason not to use URI segments / HTTP verbs / REST semantics is to have consistent request size.
+
+### ALPN to agree handshake version
+
+Client and server use [ALPN extension][18] of TLS to agree handshake version.
+
+Server SHOULD send `xftp/1` protocol name and the client should confirm this name in order to use the current protocol version. This is added to allow support of older clients without breaking backward compatibility and to extend or modify handshake syntax.
+
+If the client does not confirm this protocol name, the server would fall back to v1 of XFTP protocol.
+
+### Transport handshake
+
+When a client and a server agree on handshake version using ALPN extension, they should proceed with XFTP handshake.
+
+As with SMP, a client doesn't reveal its version range to avoid version fingerprinting. Unlike SMP, XFTP runs a HTTP2 protocol over TLS and the server can't just send its handshake right away. So a session handshake is driven by client-sent requests:
+
+1. To pass initiative to the server, the client sends a request with empty body.
+2. Server responds with its `paddedServerHello` block.
+3. Clients sends a request containing `paddedClientHello` block,
+4. Server sends an empty response, finalizing the handshake.
+
+Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes).
+
+```abnf
+paddedServerHello = <padded(serverHello, 16384)>
+serverHello = xftpVersionRange sessionIdentifier serverCert signedServerKey ignoredPart
+xftpVersionRange = minXftpVersion maxXftpVersion
+minXftpVersion = xftpVersion
+maxXftpVersion = xftpVersion
+sessionIdentifier = shortString
+; unique session identifier derived from transport connection handshake
+serverCert = originalLength <x509encoded>
+signedServerKey = originalLength <x509encoded> ; signed by server certificate
+
+paddedClientHello = <padded(clientHello, 16384)>
+clientHello = xftpVersion keyHash ignoredPart
+; chosen XFTP protocol version - must be the maximum supported version
+; within the range offered by the server
+
+xftpVersion = 2*2OCTET ; Word16 version number
+keyHash = shortString
+shortString = length length*OCTET
+length = 1*1OCTET
+originalLength = 2*2OCTET
+ignoredPart = *OCTET
+```
+
+In XFTP v2 the handshake is only used for version negotiation, but `serverCert` and `signedServerKey` must be validated by the client.
+
+`keyHash` is the CA fingerprint used by client to validate TLS certificate chain and is checked by a server against its own key.
+
+`ignoredPart` in handshake allows to add additional parameters in handshake without changing protocol version - the client and servers must ignore any extra bytes within the original block length.
+
+For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
+
+### Requests and responses
+
+- File sender:
+  - create file chunk record.
+    - Parameters:
+      - Ed25519 key for subsequent sender commands and Ed25519 keys for commands of each recipient.
+      - chunk size.
+    - Response:
+      - chunk ID for the sender and different IDs for all recipients.
+  - add recipients to file chunk
+    - Parameters:
+      - sender's chunk ID
+      - Ed25519 keys for commands of each recipient.
+    - Response:
+      - chunk IDs for new recipients.
+  - upload file chunk.
+  - delete file chunk (invalidates all recipient IDs).
+- File recipient:
+  - download file chunk:
+    - chunk ID
+    - DH key for additional encryption of the chunk.
+    - command should be signed with the key passed by the sender when creating chunk record.
+  - delete file chunk ID (only for one recipient): signed with the same key.
+
+## XFTP commands
+
+Commands syntax below is provided using ABNF with case-sensitive strings extension.
+
+```abnf
+xftpCommand = ping / senderCommand / recipientCmd / serverMsg
+senderCommand = register / add / put / delete
+recipientCmd = get / ack
+serverMsg = pong / sndIds / rcvIds / ok / file
+```
+
+The syntax of specific commands and responses is defined below.
+
+### Correlating responses with commands
+
+Commands are made via HTTP2 requests, responses to commands are correlated as HTTP2 responses.
+
+### Command authentication
+
+XFTP servers must authenticate all transmissions (excluding `ping`) by verifying the client signatures. Command signature should be generated by applying the algorithm specified for the file to the `signed` block of the transmission, using the key associated with the file chunk ID (recipient's or sender's depending on which file chunk ID is used).
+
+### Keep-alive command
+
+To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `pong` response. This command should be sent unsigned and without file chunk ID.
+
+```abnf
+ping = %s"PING"
+```
+
+This command is always sent unsigned.
+
+  data FileResponse = ... | FRPong | ...
+
+```abnf
+pong = %s"PONG"
+```
+
+### File sender commands
+
+Sending any of the commands in this section (other than `register`, that is sent without file chunk ID) is only allowed with sender's ID.
+
+#### Register new file chunk
+
+This command is sent by the sender to the XFTP server to register a new file chunk.
+
+Servers SHOULD support basic auth with this command, to allow only server owners and trusted users to create file chunks on the servers.
+
+The syntax is:
+
+```abnf
+register = %s"FNEW " fileInfo rcvPublicAuthKeys basicAuth
+fileInfo = sndKey size digest
+sndKey = length x509encoded
+size = 1*DIGIT
+digest = length *OCTET
+rcvPublicAuthKeys = length 1*rcvPublicAuthKey
+rcvPublicAuthKey = length x509encoded
+basicAuth = "0" / "1" length *OCTET
+
+x509encoded = <binary X509 key encoding>
+
+length = 1*1 OCTET
+```
+
+If the file chunk is registered successfully, the server must send `sndIds` response with the sender's and recipients' file chunk IDs:
+
+```abnf
+sndIds = %s"SIDS " senderId recipientIds
+senderId = length *OCTET
+recipientIds = length 1*recipientId
+recipientId = length *OCTET
+```
+
+#### Add file chunk recipients
+
+This command is sent by the sender to the XFTP server to add additional recipient keys to the file chunk record, in case number of keys requested by client didn't fit into `register` command. The syntax is:
+
+```abnf
+add = %s"FADD " rcvPublicAuthKeys
+rcvPublicAuthKeys = length 1*rcvPublicAuthKey
+rcvPublicAuthKey = length x509encoded
+```
+
+If additional keys were added successfully, the server must send `rcvIds` response with the added recipients' file chunk IDs:
+
+```abnf
+rcvIds = %s"RIDS " recipientIds
+recipientIds = length 1*recipientId
+recipientId = length *OCTET
+```
+
+#### Upload file chunk
+
+This command is sent by the sender to the XFTP server to upload file chunk body to server. The syntax is:
+
+```abnf
+put = %s"FPUT"
+```
+
+Chunk body is streamed via HTTP2 request.
+
+If file chunk body was successfully received, the server must send `ok` response.
+
+```abnf
+ok = %s"OK"
+```
+
+#### Delete file chunk
+
+This command is sent by the sender to the XFTP server to delete file chunk from the server. The syntax is:
+
+```abnf
+delete = %s"FDEL"
+```
+
+Server should delete file chunk record, invalidating all recipient IDs, and delete file body from file storage. If file chunk was successfully deleted, the server must send `ok` response.
+
+### File recipient commands
+
+Sending any of the commands in this section is only allowed with recipient's ID.
+
+#### Download file chunk
+
+This command is sent by the recipient to the XFTP server to download file chunk body from the server. The syntax is:
+
+```abnf
+get = %s"FGET " rDhKey
+rDhKey = length x509encoded
+```
+
+If requested file is successfully located, the server must send `file` response. File chunk body is sent as HTTP2 response body.
+
+```abnf
+file = %s"FILE " sDhKey cbNonce
+sDhKey = length x509encoded
+cbNonce = <nonce used in NaCl crypto_box encryption scheme>
+```
+
+Chunk is additionally encrypted on the way from the server to the recipient using a key agreed via ephemeral DH keys `rDhKey` and `sDhKey`, so there is no ciphertext in common between sent and received traffic inside TLS connection, in order to complicate traffic correlation attacks, if TLS is compromised.
+
+#### Acknowledge file chunk download
+
+This command is sent by the recipient to the XFTP server to acknowledge file reception, deleting file ID from server for this recipient. The syntax is:
+
+```abnf
+ack = %s"FACK"
+```
+
+If file recipient ID is successfully deleted, the server must send `ok` response.
+
+In current implementation of XFTP protocol in SimpleX Chat clients don't use FACK command. Files are automatically expired on servers after configured time interval.
+
+## Threat model
+
+#### Global Assumptions
+
+ - A user protects their local database and key material.
+ - The user's application is authentic, and no local malware is running.
+ - The cryptographic primitives in use are not broken.
+ - A user's choice of servers is not directly tied to their identity or otherwise represents distinguishing information about the user.
+
+#### A passive adversary able to monitor the traffic of one user
+
+*can:*
+
+ - identify that and when a user is sending files over XFTP protocol.
+
+ - determine which servers the user sends/receives files to/from.
+
+ - observe how much traffic is being sent, and make guesses as to its purpose.
+
+*cannot:*
+
+ - see who sends files to the user and who the user sends the files to.
+
+#### A passive adversary able to monitor a set of file senders and recipients
+
+ *can:*
+
+ - learn which XFTP servers are used to send and receive files for which users.
+
+ - learn when files are sent and received.
+
+ - perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
+
+ - observe how much traffic is being sent, and make guesses as to its purpose
+
+*cannot, even in case of a compromised transport protocol:*
+
+ - perform traffic correlation attacks with any increase in efficiency over a non-compromised transport protocol
+
+#### XFTP server
+
+*can:*
+
+- learn when file senders and recipients are online.
+
+- know how many file chunks and chunk sizes are sent via the server.
+
+- perform the correlation of the file chunks as belonging to one file via either a re-used transport connection, user's IP address, or connection timing regularities.
+
+- learn file senders' and recipients' IP addresses, and infer information (e.g. employer) based on the IP addresses, as long as Tor is not used.
+
+- delete file chunks, preventing file delivery, as long as redundant delivery is not used.
+
+- lie about the state of a file chunk to the recipient and/or to the sender  (e.g. deleted when it is not).
+
+- refuse deleting the file when instructed by the sender.
+
+*cannot:*
+
+- undetectably corrupt file chunks.
+
+- learn the contents, name or the exact size of sent files.
+
+- learn approximate size of sent files, as long as more than one server is used to send file chunks.
+
+- compromise the users' end-to-end encryption of files with an active attack.
+
+#### An attacker who obtained Alice's (decrypted) chat database
+
+*can:*
+
+- see the history of all files exchanged by Alice with her communication partners, as long as files were not deleted from the database.
+
+- receive all files sent and received by Alice that did not expire yet, as long as information about these files was not removed from the database.
+
+- prevent Alice's contacts from receiving the files she sent by deleting all or some of the file chunks from XFTP servers.
+
+#### A user's contact
+
+*can:*
+
+- spam the user with files.
+
+- forever retain files from the user.
+
+*cannot:*
+
+- cryptographically prove to a third-party that a file came from a user (assuming the user's device is not seized).
+
+- prove that two contacts they have is the same user.
+
+- cannot collaborate with another of the user's contacts to confirm they are communicating with the same user, even if they receive the same file.
+
+#### An attacker with Internet access
+
+*can:*
+
+- Denial of Service XFTP servers.
+
+*cannot:*
+
+- send files to a user who they are not connected with.
+
+- enumerate file chunks on an XFTP server.

protocol/xrcp.md

@@ -0,0 +1,330 @@
+Version 1, 2024-06-22
+
+# SimpleX Remote Control Protocol
+
+## Table of contents
+
+- [Abstract](#abstract)
+- [XRCP model](#xrcp-model)
+- [Transport protocol](#transport-protocol)
+  - [Session invitation](#session-invitation)
+  - [Establishing TLS connection](#establishing-tls-connection)
+  - [Session verification and protocol negotiation](#session-verification-and-protocol-negotiation)
+  - [Controller/host session operation](#сontrollerhost-session-operation)
+- [Key agreement for announcement packet and for session](#key-agreement-for-announcement-packet-and-for-session)
+- [Threat model](#threat-model)
+
+## Abstract
+
+The SimpleX Remote Control Protocol is a client-server protocol designed to transform application UIs into thin clients, enabling remote control from another device. This approach allows users to remotely access and utilize chat profiles without the complexities of master-master replication for end-to-end encryption states.
+
+Like SMP and XFTP, XRCP leverages out-of-band invitations to mitigate MITM attacks and employs multiple cryptographic layers to safeguard application data.
+
+## XRCP model
+
+XRCP assumes two application roles: host (that contain the application data) and controller that gains limited access to host data.
+Applications are also split into two components: UI and core.
+
+When an XRCP session is established a host UI is locked out and a controller UI uses its core to proxy commands to the host core, getting back responses and events.
+
+```
+
+          +------+              +------+     xrcp     +------+     +------+
+          | Ctrl |   commands   | Ctrl |   commands   | Host |     | Host |
+user ---> |  UI  | -----------> | Core | -----------> | Core |     |  UI  |
+          +------+              +------+              +------+     +------+
+              ^     responses     |  ^  xrcp responses  |  ^
+              |<------------------|  |<-----------------|  |      +-------------+
+              |      events       |                        |      | Application |-+
+              |<------------------|                        |----> |   protocol  | |
+                                                                  |   servers   | |
+                                                                  +-------------+ |
+                                                                   +--------------+
+```
+
+## Transport protocol
+
+Protocol consists of four phases:
+- controller session invitation
+- establishing session TLS connection
+- session verification and protocol negotiation
+- session operation
+
+![Session sequence](./diagrams/xrcp/session.svg)
+
+### 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. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption.
+
+Host application decrypts (except the first session) and validates the invitation:
+- Session signature is valid.
+- 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
+host = <ipv4 or ipv6 address> ; in textual form, RFC4001
+port = 1*DIGIT ; uint16
+qsParams = param *("&" param)
+param = versionRangeParam / appInfoParam / sessionTsParam /
+        sessPubKeyParam / idPubKeyParam / dhPubKeyParam /
+        sessSignatureParam / idSignatureParam
+versionRangeParam = "v=" (versionParam / (versionParam "-" versionParam))
+versionParam = 1*DIGIT
+appInfoParam = "app=" escapedJSON
+sessionTsParam = "ts=" 1*DIGIT
+sessPubKeyParam = "skey=" base64url
+idPubKeyParam = "idkey=" base64url
+dhPubKeyParam = "dh=" base64url
+sessSignatureParam = "ssig=" base64url ; signs the URI with this and idSignatureParam param removed
+idSignatureParam = "idsig=" base64url ; 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 TLS connection
+
+Both controller and host use 2-element certificate chains with unique self-signed CA root representing long-term identities. Leaf certificates aren't stored and instead generated on each session start.
+
+A controller runs a TCP server to avoid opening listening socket on a host, which might create an attack vector. A controller keeps no sensitive data to be exposed this way.
+
+During TLS handshake, parties validate certificate chains against previously known (from invitation or storage) CA fingerprints. The fingerprints MUST be the same as in the invitation and in the subsequent connections.
+
+### Session verification and protocol negotiation
+
+Once TLS session is established, both the host and controller devices 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 sends HELLO block to the controller.
+
+XRCP blocks inside TLS are padded to 16384 bytes.
+
+Host HELLO block 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.
+
+Host HELLO block syntax:
+
+```abnf
+hostHello = %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
+```
+
+The 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](https://www.rfc-editor.org/rfc/rfc8927) 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
+}
+```
+
+The controller should reply with with `ctrlHello` or `ctrlError` response:
+
+```abnf
+ctrlHello = %s"HELLO " kemCiphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad
+; ctrlHelloJSON is encrypted with the hybrid secret,
+; including both previously agreed DH secret and KEM secret from kemCiphertext
+unpaddedSize = largeLength
+kemCiphertext = largeLength *OCTET
+pad = <pad block size to 16384 bytes>
+helloPad = <pad hello size to 12888 bytes>
+largeLength = 2*2 OCTET
+
+ctrlError = %s"ERROR " nonce encrypted(unpaddedSize ctrlErrorMessage helloPad) pad
+ctrlErrorMessage = <utf-8 encoded text>; encrypted using previously agreed DH secret.
+```
+
+JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`:
+
+```json
+{
+  "properties": {},
+  "additionalProperties": true
+}
+```
+
+Once the controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections.
+
+### Controller/host session operation
+
+The protocol for communication during the session is out of scope of this protocol.
+
+SimpleX Chat uses HTTP2 encoding, where host device acts as a server and controller acts as a client (these roles are reversed compared with TLS connection, restoring client-server semantics in HTTP).
+
+Payloads in the protocol must be encrypted using NaCL secret_box 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:
+
+```abnf
+commandBody = encBody sessSignature idSignature [attachment]
+responseBody = encBody [attachment] ; counter must match command
+encBody = nonce encLength32 encrypted(tlsunique counter body)
+attachment = %x01 nonce encLength32 encrypted(attachment)
+noAttachment = %x00
+tlsunique = length 1*OCTET
+counter = 8*8 OCTET ; int64
+encLength32 = 4*4 OCTET ; uint32, includes authTag
+```
+
+If the command or response includes attachment, its 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 contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA256 over concatenated DH shared secret and KEM encapsulated secret) both for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses.
+
+During the next session the announcement is sent via encrypted multicast block. The shared key for this announcement and for host HELLO block is determined using the KEM shared secret from the previous session and DH shared secret computed using the host DH key from the previous session and the new controller DH key from the announcement.
+
+For the session, the shared secret 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.
+
+In pseudo-code:
+
+```
+// session 1
+hostHelloSecret(1) = dhSecret(1)
+sessionSecret(1) = sha3-256(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) = sha3-256(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 a multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
+
+## 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.

rfcs/2024-06-01-agent-protocol.md

@@ -0,0 +1,19 @@
+# Evolving agent API
+
+## Problem
+
+Historically, agent API started as a TCP protocol with encoding. We do not use the actual protocol and maintaining the encoding complicates the evolution of the API.
+
+Currently, I was trying to add ERRS event to combine multiple subscription errors into one to prevent overloading the UI with processing multiple subscription errors (e.g.):
+
+```haskell
+ERRS :: (ConnId, AgentErrorType) -> ACommand Agent AEConn
+```
+
+This constructor is not possible to encode/parse in a sensible way other than including lengths of errors.
+
+## Proposal
+
+Remove commands type and encodings for commands and events.
+
+Only keep encodings for the commands that are saved to the database: NEW, JOIN, LET, ACK, SWCH, DEL (this one is no longer used but needs to be supported for backwards compatibility).

rfcs/2024-06-21-short-links.md

@@ -0,0 +1,124 @@
+# Short invitation links
+
+## Problem
+
+Long links look scary and unsafe for many users. While this is a perceived problem, rather than a real one, it hurts adoption.
+
+What is worse, long links do not fit in profile descriptions of other social networks where people might want to advertize their contact addresses.
+
+The current link size limitation is also the reason for not including PQ KEM keys into invitation links and addresses, postponing the moment when PQ-resistant encryption kicks in - if we include PQ KEM key into the link, the QR code will not be scannable.
+
+Additionally, if we store short links, they can also include chat preferences and public profile data.
+
+## Solution
+
+MITM-resistant link shortening.
+
+Instead of generating the random address that would resolve into the link - doing so would create the possibility of MITM by the server hosting this link - we can use private key as the link ID that will be passed to the accepting party, and the hash of the public key as ID for the server - the accepting party would present this key itself as ID and it will also be used for server to client encryption (see Protocol below). HKDF will be used to derive symmetric key from private key and used in secret_box together with random nonce (to allow replacing data with the same key but with a different nonce - nonce will be sent to the server too). secret_box construction is authenticated encryption, so it would protect from MITM.
+
+The proposed syntax:
+
+```abnf
+shortConnectionRequest = connectionScheme "/" connReqType "#/" smpServer "/" linkHash
+connReqType = %s"invitation" / %s"contact"
+connectionScheme = (%s"https://" clientAppServer) / %s"simplex:"
+clientAppServer = hostname [ ":" port ]
+  ; client app server, e.g. simplex.chat
+smpServer = serverIdentity "@" srvHosts [":" port] ; no smp:// prefix, no escaping
+srvHosts = <hostname> ["," srvHosts] ; RFC1123, RFC5891
+linkHash = <base64url encoded SHA256 or SHA512 hash of the original link>
+```
+
+If SMP server supports pages, its name can be used as clientAppServer, without repeating it after #, for a shorter link.
+
+Example link:
+
+```
+https://simplex.chat/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im/abcdefghij0123456789abcdefghij0123456789abc=
+```
+
+This link has the length of ~136 characters (256 bits), which is shorter than the full contact address (~310 characters) and much shorter than invitation links (~528 characters) even without post-quantum keys added to them.
+
+This size can be further reduced by
+- use server domain in the link.
+- do not include onion address, as the connection happens via proxy anyway, if it's untrusted server.
+- not pinning server TLS certificate - the downside here is that while the attack that compromises TLS will not be able to substitute the link (because it's hash will not match), it will be able to intercept and to block it.
+- using shorter hash, e.g. SHA128 - reducing the collision resistance.
+
+If the server is known, the client could use it's hash and onion address, otherwise it could trust the proxy to use any existing session with the same hostname or to accept the risk of interception - given that there is no risk of substitution.
+
+With the first two of these "improvements" the link could be ~122 characters:
+
+```
+https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@/abcdefghij0123456789abcdefghij0123456789abc
+```
+
+If onion address is preserved the link will be ~184 characters (won't fit in Twitter 160 characters bio):
+
+```
+https://smp8.simplex.im/contact/#0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU@beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion/abcdefghij0123456789abcdefghij0123456789abc
+```
+
+If we implement it, the request to resolve the link would be made via proxied SMP command (to avoid the direct connection between the client and the recipient's server).
+
+Pros:
+- a bit shorter link.
+- possibility to include post-quantum keys into the full link keeping the same shortened link size.
+- possibility to include chat profile of contact or group, and preferences, for a much better connection experience, and to show this information when the link sent in the conversation (clients can resolve them automatically, without connecting - it can be resolved by the sending clients).
+- server will not have access to the link.
+
+Cons:
+- protocol complexity.
+- observers can access the link content, so for 1-time invitation we should only include permissions and not profile.
+
+Pros are a huge improvement of UX of connecting both within and from outside of the app (e.g., link can be resolved even before creating chat profile, as part of the onboarding).
+
+## Protocol
+
+To support short links, the SMP servers would provide a simple key-value store enabled by three additional commands: `WRT`, `CLR` and `READ`
+
+`WRT` command is used to store and to update values in the store. The size of the value is limited by the same size as sent messages (or, possibly, smaller - as connection information size used in confirmation messages) - the clients would use this fixed size irrespective of the content. `WRT` command will be sent with the data blob ID in the transaction entityId field, public authorization key used to authorize `WRT` and `CLR` commands (subsequent WRT commands to the existing key must use the same key), and the data blob.
+
+`CLR` command must use with the same entity ID and must be authorized by the same key.
+
+`READ` command must use the ID which hash would be equal of the ID used to create the data blob, and this ID would also be used as public authorization
+
+## Algorithm to store and to retrieve data blob.
+
+**Store data blob**
+
+- the data blob owner generates X25519 key pair: `(k, pk)`.
+- private key `pk` will be included in the short link shared with the other party (only base64url encoded key bytes, not X509 encoding).
+- `HKDF(pk)` will be used to encrypt the link data with secret_box before storing it on the server.
+- the hash of public key `sha256(k)` will be used as ID by the owner to store and to remove the data blob (`WRT` and `CLR` commands).
+
+**Retrieve data blob**
+
+- the sender uses the public key `k` derived from the private key `pk` included in the link as entity ID to retrieve data blob (the server will compute the ID used by the owner as `sha256(k)` and will be able to look it up). This provides the quality that the traffic of the parties has no shared IDs inside TLS. It also means that unlike message queue creation, the ID to retrieve the blob was never sent to the blob creator, and also is not known to the server in advance (the second part is only an observation, in itself it does not increase security, as server has access to an encrypted blob anyway).
+- note that the sender does not authorize the request to retrieve the blob, as it would not increase security unless a different key is used to authorize, and adding a key would increase link size.
+- server session keys with the sender will be `(sk, spk)`, where `sk` is public key shared with the sender during session handshake, and `spk` is the private key known only to the server.
+- this public key `k` will also be combined with server session key `spk` using `dh(k, spk)` to encrypt the response, so that there is no ciphertext in common in sent and received traffic for these blobs. Correlation ID will be used as a nonce for this encryption.
+- having received the blob, the client can now decrypt it using secret_box with `HKDF(pk)`.
+
+Using the same key as ID for the request, and also to additionally encrypt the response allows to use a single key in the link, without increasing the link size.
+
+## Threat model
+
+**Compromised SMP server**
+
+can:
+- delete link data.
+- hide link selectively from some requests.
+
+cannot:
+- undetectably replace link data.
+- access unencrypted link data, whether it was or was not accessed by the accepting party.
+- observe IP addresses of the users accessing link data.
+
+**Passive observer who observed short link**:
+
+can:
+- access original unencrypted link data
+
+cannot:
+- replace or delete the link data

rfcs/2024-07-06-ios-notifications.md

@@ -0,0 +1,18 @@
+# iOS notifications stability
+
+## Problem
+
+iOS notifications may fail to deliver for several reasons, but there are two important reasons that we could address:
+- when notification server is not subscribed to SMP server(s), the notifications can be dropped - it can happen because either notification server restarts or becuase SMP server restarted and some messages are received before notification server resubscribed. We lose approximately 3% of notifications because of this reason.
+- when user device is offline or has low power condition, Apple does not deliver notification, but puts them to storage. If while the notification is in storage a new one arrives it would overwrite the previous notification. If it was the message to the same message queue, the client will download messages anyway, up to a limit, but if the message was to another queue, it will not be delivered until the app is opened. Apple delivers about 88% of notifications that should be delivered (not accounting for uninstalled apps), the rest is replaced with the newer notifications.
+
+## Solution
+
+The first problem can be solved by preserving notifications for a limited time (say 1 hour) in case there is no subscription to notification from notification server. At the very least, they can be preserved in SMP server memory but can also be stored to a file on restart, similar to messages, and be delivered when notification server resubscribes. It is sufficient to store one notification per messaging queue.
+
+The second problem is both more damaging and more complex to solve. The solution could be to always deliver several last notifications to different queues in one packet (Apple allows up to ~4-5kb notification size, and we are sending packets of fixed size 512 bytes, so we could fit up to 8-10 of them in each notification).
+
+Every time a client receives such batch of notifications if can:
+- check if that notification was already received in the previous batch.
+- if it was received, it would be ignored, otherwise it would be processed.
+- process them one by one, started from the most recent one while the time allows.

rfcs/2024-09-05-queue-storage.md

@@ -0,0 +1,81 @@
+# Storage considerations for SMP queues
+
+See [Short invitation links](./2024-06-21-short-links.md).
+
+## Problem
+
+1) queue records are created permanently, until the clients delete them.
+
+2) clients only delete queue records based on some user action, pending connections do not expire.
+
+While part 2 should be improved in the client, indefinite storage of queue records becomes a much bigger issue if each of them would result in a permanent storage of 4-16kb blob in server memory, without server-side expiration for short invitation links.
+
+## Possible solutions
+
+1) Add some queue timestamp, e.g. queue creation date, to expire unsecured queues after say 3 weeks.
+
+The problem with this approach is that contact addresses are also unsecured queues, and they should not be expired.
+
+We could set really large expiration time, and require that clients "update" the unsecured queues they need at least every 1-2 years, but it would not solve the problem of storing a large number of blobs in the server memory for unused/abandoned 1-time invitations.
+
+2) Do not store blobs in memory / append-only log, and instead use something like RocksDB. While it may be a correct long term solution, it may be not expedient enough at the current POC stage for this feature. Also, the lack of expiration is wrong in any case and would indefinitely grow server storage.
+
+3) Add flag allowing the server to differentiate permanent queues used as contact addresses, also using different blob sizes for them. In this case, messaging queues will be expired if not secured after 3 weeks, and contact address queues would be expired if not "updated" by the owner within 2 years.
+
+Probably all three solutions need to be used, to avoid creating a non-expiring blob storage in memory, as in case too many of such blobs are created it would not be possible to differentiate between real users and resource exhaustion attacks, and unlike with messages, they won't be expiring too.
+
+Servers already can differentiate messaging queues and contact address queues, if they want to:
+- with the old 4-message handshake, the confirmation message on a normal queue was different, and also KEY command was eventually used.
+- with the fast 2-message handshake, while the confirmation message has the same syntax, and the differences are inside encrypted envelope, the client still uses SKEY command.
+- in both cases, the usual messaging queues are secured, and contact addresses are not, so this difference is visible in the storage as well (although it is not easy to differentiate between abandoned 1-time invitations and contact addresses).
+
+Differentiating these queues can also allow different message retention times - e.g., the queues for contact addresses could have bigger size, but have lower message retention time.
+
+## Proposed solution
+
+1. Add queue updated_at date into queue records. While it adds some metadata, it seems necessary to manage retention and quality of service. It will not include exact time, only date, and the time of creation will be replaced by the time of any update - queue secured, a message is sent, or queue owner subscribes to the queue. To avoid the need to update store log on every message this information can be appended to store log on server termination. Or given that only one update per day is needed it may be ok to make these updates as they happen (temporarily making the sequence and time of these events available in storage).
+
+2. Add flag to indicate the queue usage - messaging queue or queue for contact address connection requests. This would result in different queue size and different retention policy for queue and its messages. We already have "sender can secure flag" which is, effectively, this flag - contact address queues are never secured. So this does not increase stored metadata in any way.
+
+## Possible changes to short links
+
+This is a design considerations and a concept, not a design yet.
+
+Instead of implementing a generic blob storage that can be used as an attack vector, and adds additional failure point (another server storing blob that is necessary to connect to the queue on the current server), but instead adds an extended queue information blobs, most of which could be dropped without the loss of connectivity, so that the attack can be mitigated by deleting these blobs without users losing the ability to connect, as long as the queue and minimal extended information is retained.
+
+So, to make the connection there need to be these elements:
+
+- queue server and queue ID - mandatory part, that can be included in short link
+- SMP key - mandatory part for all queues. We are considering initializing ratchets earlier for contact addresses, and include ratchet keys and pre-keys into queue data as well, but it is out of scope here.
+- Ratchet keys - mandatory part for 1-time invitation that won't fit in short link.
+- PQ key - optional part that can be stored with addresses if ratchet keys are added and with 1-time invitations.
+- App blobs - chat preferences for 1-time invitation links and profile information for contact addresses.
+
+So rather that storing one blob with a large address inside it, not associated with the queue, increasing probability of failure and reducing our ability to mitigate resource exhaustion, we could store extended blobs associated with the queues.
+
+Also, we need the address shared with the sender (party accepting the connection) to be short. We could use a similar approach that was proposed for data blobs, using a single random seed per queues to derive multiple keys and IDs from it. For example:
+
+1. The queue owner:
+  - generates Ed25529 key pair `(sk, spk)` and X25519 key pair `(dhk, dhpk)` to use with the server, same as now sent in NEW command.
+  - generates queue recipient ID (this ID can still be server-generated).
+  - generates X25519 key pair `(k, pk)` to use with the accepting party.
+  - derives from `k`:
+    - sender ID.
+    - symmetric key for authenticated encryption of blobs.
+  - `k` will be used as short link.
+2. All other data from the invitation can be included in queue creation request and be associated with the queue as 1-3 blobs with different priority:
+  - ratchet keys - it will have a small size, so only this blob cannot be removed, while other blobs can be removed in case of resource exhaustion.
+  - PQ keys - optional blob.
+  - conversation preferences and profile - can be removed depending on creation time, e.g. all new blobs can be removed.
+
+The algorithm used to derive key and ID from `k` needs to be cryptographically secure, e.g. it could be some KDF or ChaCha DRG initialized with `k` as seed, TBC.
+
+So, coupling blob storage with messaging queues has these pros/cons:
+
+Cons:
+- no additional layer of privacy - the server used for connection is visible in the link, even after the blobs are removed from the server.
+
+Pros:
+- no additional point of failure in the connection process - the same server will be used to retrieve necessary blobs as for connection.
+- queue blobs of messaging blobs will be automatically removed once the queue is secured or expired, without additional request from the recipient - reducing the storage and the time these blobs are available.
+- queue blobs for contact addresses will be structured and some of the large blobs can be removed in case of resource exhaustion attack (and recreated by the client if needed), with the only downside that PQ handshake will be postponed (which is the case now) and profile will not be available at a point of connection.

rfcs/done/2024-06-14-fast-connection.md

@@ -0,0 +1,42 @@
+# Faster connection establishment
+
+## Problem
+
+SMP protocol is unidirectional, and to create a connection users have to agree two messaging queues.
+
+V1 of handshake protocol required 5 messages and multiple HELLO sent between the users, which consumed a lot of traffic.
+
+V2 of handshake protocol was optimized to remove multiple HELLO and also REPLY message, thanks to including queue address together with the key to secure this queue into the confirmation message.
+
+This eliminated unnecessary traffic from repeated HELLOs, but still requires 4 messages in total and 2 times of each client being online. It is perceived by the users as "it didn't work" (because they see "connecting" after using the link) or "we have to be online at the same time" (and even in this case it is slow on bad network). This hurts usability and creates churn of the new users, as unless people are onboarded by the friends who know how the app works, they cannot figure out how to connect.
+
+Ideally, we want to have handshake protocol design when an accepting user can send messages straight after using the link (their client says "connected") and the initiating client can send messages as soon as it received confirmation message with the profile.
+
+This RFC proposes modifications to SMP and SMP Agent protocols to reduce the number of required messages to 2 and allows accepting client to send messages straight after using the link (and sending the confirmation), before receiving the profile of the initiating client in the second message, and the initiating client can send the messages straight after processing the confirmation and sending its own confirmation.
+
+## Solution
+
+The current protocol design allows additional confirmation step where the initiating client can confirm the connection having received the profile of the sender. We don't use it in the UI - this confirmation is done automatically and unconditionally.
+
+Instead of requiring the initiating client to secure its queue with sender's key, we can allow the accepting client to secure it with the additional SKEY command. This would avoid "connecting" state but would introduce "Profile unknown" state where the accepting client does not yet have the profile of the initiating client. In this case we could also use the non-optional alias created during the connection (or have something like "Add alias to be able to send messages immediately" and show warning if the user proceeds without it).
+
+The additional advantage here is that if the queue of the initiating client was removed, the connection will not procede to create additional queue, failing faster.
+
+These are the proposed changes:
+
+1. Modify NEW command to add flag allowing sender to secure the queue (it should not be allowed if queue is created for the contact address).
+2. Include flag into the invitation link URI and in reply address encoding that queue(s) can be secured by the sender (to avoid coupling with the protocol version and preserve the possibility of the longer handshakes).
+3. Add SKEY command to SMP protocol to allow the sender securing the message queue.
+4. This command has to be supported by SMP proxy as well, so that the sender does not connect to the recipient's server directly.
+5. Accepting client will secure the messaging queue before sending the confirmation to it.
+6. Initiating client will secure the messaging queue before sending the confirmation.
+
+See [this sequence diagram](../protocol/diagrams/duplex-messaging/duplex-creating-v6.mmd) for the updated handshake protocol.
+
+Changes to threat model: the attacker who compromised TLS and knows the queue address can block the connection, as the protocol no longer requires the recipient to decrypt the confirmation to secure the queue.
+
+Possibly, "fast connection" should be an option in Privacy & security settings.
+
+## Implementation questions
+
+Currently we store received confirmations in the database, so that the client can confirm them. This becomes unnecessary.

scripts/main/simplex-servers-uninstall

@@ -13,11 +13,15 @@ fi
 printf "${RED}This action will permanently remove all configs, directories, binaries from Installation Script. Please backup any relevant configs if they are needed.${NC}\n\nPress ${GRN}ENTER${NC} to continue or ${RED}Ctrl+C${NC} to cancel installation"
 read ans
 
-systemctl stop smp-server
-systemctl stop xftp-server
+systemctl disable --now smp-server 2>/dev/null || true
+systemctl revert smp-server 2>/dev/null || true
+systemctl disable --now xftp-server 2>/dev/null || true
+systemctl revert xftp-server 2>/dev/null || true
+systemctl daemon-reload 2>/dev/null || true
 
-rm -rf /var/opt/simplex /etc/opt/simplex /var/opt/simplex-xftp /etc/opt/simplex-xftp /srv/xftp /etc/systemd/system/smp-server.service /etc/systemd/system/xftp-server.service /usr/local/bin/smp-server /usr/local/bin/xftp-server /usr/local/bin/simplex-servers-update /usr/local/bin/simplex-servers-uninstall
+rm -rf /var/opt/simplex /etc/opt/simplex /etc/opt/simplex-info /var/opt/simplex-xftp /etc/opt/simplex-xftp /srv/xftp /etc/systemd/system/smp-server.service /etc/systemd/system/xftp-server.service /usr/local/bin/smp-server /usr/local/bin/xftp-server /usr/local/bin/simplex-servers-update /usr/local/bin/simplex-servers-uninstall /usr/local/bin/simplex-servers-stopscript
 
-userdel smp && userdel xftp
+userdel smp 2>/dev/null || true
+userdel xftp 2>/dev/null || true
 
 printf "Uninstallation is complete! Thanks for trying out SimpleX!\n"

scripts/main/simplex-servers-update

@@ -3,8 +3,6 @@ set -eu
 
 # Links to scripts/configs
 bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
-bin_smp="$bin/smp-server-ubuntu-20_04-x86-64"
-bin_xftp="$bin/xftp-server-ubuntu-20_04-x86-64"
 
 scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
 scripts_systemd_smp="$scripts/smp-server.service"
@@ -33,6 +31,9 @@ path_tmp_bin_stopscript="$path_tmp_bin/simplex-servers-stopscript"
 path_tmp_systemd_smp="$path_tmp_bin/smp-server.service"
 path_tmp_systemd_xftp="$path_tmp_bin/xftp-server.service"
 
+path_conf_etc='/etc/opt'
+path_conf_info='/etc/opt/simplex-info'
+
 GRN='\033[0;32m'
 BLU='\033[1;36m'
 YLW='\033[1;33m'
@@ -40,8 +41,40 @@ RED='\033[0;31m'
 NC='\033[0m'
 
 # Currently, XFTP default to v0.1.0, so it doesn't make sense to check its version
-local_version="$($path_bin_smp -v | awk '{print $3}')"
-remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+
+os_test() {
+ . /etc/os-release
+
+ case "$VERSION_ID" in
+  20.04|22.04) : ;;
+  24.04) VERSION_ID='22.04' ;;
+  *) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
+ esac
+
+ version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
+ arch="$(uname -p)"
+
+ case "$arch" in
+  x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
+  *)  printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
+ esac
+
+ bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
+ bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
+}
+
+installed_test() {
+  set +u
+  for i in $path_conf_etc/*; do
+    if [ -d "$i" ]; then
+      case "$i" in
+        *simplex) apps="smp $apps" ;;
+        *simplex-xftp) apps="xftp $apps" ;;
+      esac
+    fi
+  done
+  set -u
+}
 
 update_scripts() {
   curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_tmp_bin_update" && chmod +x "$path_tmp_bin_update"
@@ -56,6 +89,7 @@ update_scripts() {
     mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
     printf "${GRN}Done!${NC}\n"
   fi
+
   if diff -q "$path_bin_stopscript" "$path_tmp_bin_stopscript" > /dev/null 2>&1; then
     printf -- "- ${YLW}Stopscript script is up-to-date${NC}.\n"
     rm "$path_tmp_bin_stopscript"
@@ -64,6 +98,7 @@ update_scripts() {
     mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
     printf "${GRN}Done!${NC}\n"
   fi
+
   if diff -q "$path_bin_update" "$path_tmp_bin_update" > /dev/null 2>&1; then
     printf -- "- ${YLW}Update script is up-to-date${NC}.\n"
     rm "$path_tmp_bin_update"
@@ -71,75 +106,84 @@ update_scripts() {
     printf -- "- Updating update script..."
     mv "$path_tmp_bin_update" "$path_bin_update"
     printf "${GRN}Done!${NC}\n"
-    printf "Re-executing Update script with latest updates..."
+    printf -- "- Re-executing Update script with latest updates..."
     exec sh "$path_bin_update" "continue"
   fi
 }
 
 update_systemd() {
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_smp" -o "$path_tmp_systemd_smp"
-  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd_xftp" -o "$path_tmp_systemd_xftp"
+  service="${1}-server"
+  eval "scripts_systemd=\$scripts_systemd_${1}"
+  eval "path_systemd=\$path_systemd_${1}"
+  eval "path_tmp_systemd=\$path_tmp_systemd_${1}"
+   
+  curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_tmp_systemd"
 
-  if diff -q "$path_systemd_smp" "$path_tmp_systemd_smp" > /dev/null 2>&1; then
-    printf -- "- ${YLW}smp-server service is up-to-date${NC}.\n"
-    rm "$path_tmp_systemd_smp"
+  if diff -q "$path_systemd" "$path_tmp_systemd" > /dev/null 2>&1; then
+    printf -- "- ${YLW}%s service is up-to-date${NC}.\n" "$service"
+    rm "$path_tmp_systemd"
   else
-    printf -- "- Updating smp-server service..."
-    mv "$path_tmp_systemd_smp" "$path_systemd_smp"
-    systemctl daemon-reload
-    printf "${GRN}Done!${NC}\n"
-  fi
-  if diff -q "$path_systemd_xftp" "$path_tmp_systemd_xftp" > /dev/null 2>&1; then
-    printf -- "- ${YLW}xftp-server service is up-to-date${NC}.\n"
-    rm "$path_tmp_systemd_xftp"
-  else
-    printf -- "- Updating xftp-server service..."
-    mv "$path_tmp_systemd_xftp" "$path_systemd_xftp"
+    printf -- "- Updating %s service..." "$service"
+    mv "$path_tmp_systemd" "$path_systemd"
     systemctl daemon-reload
     printf "${GRN}Done!${NC}\n"
   fi
+
+  unset service scripts_systemd path_systemd path_tmp_systemd
 }
 
 update_bins() {
-  if [ "$local_version" != "$remote_version" ]; then
-    if systemctl is-active --quiet smp-server; then
-      printf -- "- Stopping smp-server service..."
-      systemctl stop smp-server
-      printf "${GRN}Done!${NC}\n"
+  service="${1}-server"
+  eval "bin=\$bin_${1}"
+  eval "path_bin=\$path_bin_${1}"
 
-      printf -- "- Updating smp-server bin to %s..." "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
-      printf "${GRN}Done!${NC}\n"
-      
-      printf -- "- Starting smp-server service..."
-      systemctl start smp-server
-      printf "${GRN}Done!${NC}\n"
-    else
-      printf -- "- Updating smp-server bin..."
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_smp" && chmod +x "$path_bin_smp"
-      printf "${GRN}Done!${NC}\n"
+  remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
+
+  set_ver() {
+    local_version='unset'
+    sed -i -- "s/local_version_${1}=.*/local_version_${1}='${remote_version}'/" "$path_conf_info/release"
+  }
+
+  if [ -f "$path_conf_info/release" ]; then
+    . "$path_conf_info/release" 2>/dev/null
+
+    set +u
+    eval "local_version=\$local_version_${1}"
+    set -u
+
+    if [ -z "${local_version}" ]; then
+            set_ver "$1"
     fi
+  else
+    printf 'local_version_xftp=\nlocal_version_smp=\n' > "$path_conf_info/release"
+    set_ver "$1"
+  fi
 
-    if systemctl is-active --quiet xftp-server; then
-      printf -- "- Stopping xftp-server service..."
-      systemctl stop xftp-server
+  if [ "$local_version" != "$remote_version" ]; then
+    if systemctl is-active --quiet "$service"; then
+      printf -- "- Stopping %s service..." "$service"
+      systemctl stop "$service"
       printf "${GRN}Done!${NC}\n"
 
-      printf -- "- Updating xftp-server bin to %s..." "$remote_version"
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_xftp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+      printf -- "- Updating %s to %s..." "$service" "$remote_version"
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
       printf "${GRN}Done!${NC}\n"
       
-      printf -- "- Starting xftp-server service..."
-      systemctl start xftp-server
+      printf -- "- Starting %s service..." "$service"
+      systemctl start "$service"
       printf "${GRN}Done!${NC}\n"
     else
-      printf -- "- Updating xftp-server bin..."
-      curl --proto '=https' --tlsv1.2 -sSf -L "$bin_smp" -o "$path_bin_xftp" && chmod +x "$path_bin_xftp"
+      printf -- "- Updating %s to %s..." "$service" "$remote_version"
+      curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
       printf "${GRN}Done!${NC}\n"
     fi
   else
-    printf -- "- ${YLW}smp-server and xftp-server binaries is up-to-date${NC}.\n"
+    printf -- "- ${YLW}%s is up-to-date${NC}.\n" "$service"
   fi
+
+  set_ver "$1"
+
+  unset service bin path_bin local_version
 }
 
 checks() {
@@ -147,6 +191,11 @@ checks() {
     printf "This script is intended to be run with root privileges. Please re-run script using sudo.\n"
     exit 1
   fi
+
+  os_test
+  installed_test
+
+  mkdir -p $path_conf_info
 }
 
 main() {
@@ -163,10 +212,14 @@ main() {
   fi
 
   printf "Updating systemd services...\n"
-  update_systemd
+  for i in $apps; do
+    update_systemd "$i"
+  done
   
-  printf "Updating simplex server binaries...\n"
-  update_bins
+  printf "Updating simplex servers...\n"
+  for i in $apps; do
+    update_bins "$i"
+  done
 
   rm -rf "$path_tmp_bin"
 }

simplexmq.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplexmq
-version:        5.8.0.10
+version:        6.0.3.0
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and
@@ -28,7 +28,6 @@ extra-source-files:
     CHANGELOG.md
     cbits/sha512.h
     cbits/sntrup761.h
-    cbits/tweetnacl.h
     apps/smp-server/static/index.html
     apps/smp-server/static/link.html
     apps/smp-server/static/media/apk_icon.png
@@ -96,7 +95,7 @@ library
       Simplex.Messaging.Agent.Protocol
       Simplex.Messaging.Agent.QueryString
       Simplex.Messaging.Agent.RetryInterval
-      Simplex.Messaging.Agent.Server
+      Simplex.Messaging.Agent.Stats
       Simplex.Messaging.Agent.Store
       Simplex.Messaging.Agent.Store.SQLite
       Simplex.Messaging.Agent.Store.SQLite.Common
@@ -134,6 +133,8 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
@@ -141,7 +142,6 @@ library
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.File
       Simplex.Messaging.Crypto.Lazy
-      Simplex.Messaging.Crypto.NaCl.Bindings
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Crypto.SNTRUP761
       Simplex.Messaging.Crypto.SNTRUP761.Bindings
@@ -167,6 +167,8 @@ library
       Simplex.Messaging.Server
       Simplex.Messaging.Server.CLI
       Simplex.Messaging.Server.Control
+      Simplex.Messaging.Server.DataLog
+      Simplex.Messaging.Server.DataStore
       Simplex.Messaging.Server.Env.STM
       Simplex.Messaging.Server.Expiration
       Simplex.Messaging.Server.Information
@@ -212,7 +214,6 @@ library
   c-sources:
       cbits/sha512.c
       cbits/sntrup761.c
-      cbits/tweetnacl.c
   extra-libraries:
       crypto
   build-depends:
@@ -237,6 +238,7 @@ library
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -259,7 +261,7 @@ library
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -311,6 +313,7 @@ executable ntf-server
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -334,82 +337,7 @@ executable ntf-server
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
-    , transformers ==0.6.*
-    , unliftio ==0.2.*
-    , unliftio-core ==0.2.*
-    , websockets ==0.12.*
-    , yaml ==0.11.*
-    , zstd ==0.1.3.*
-  default-language: Haskell2010
-  if flag(swift)
-    cpp-options: -DswiftJSON
-  if impl(ghc >= 9.6.2)
-    build-depends:
-        bytestring ==0.11.*
-      , template-haskell ==2.20.*
-      , text >=2.0.1 && <2.2
-  if impl(ghc < 9.6.2)
-    build-depends:
-        bytestring ==0.10.*
-      , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
-
-executable smp-agent
-  main-is: Main.hs
-  other-modules:
-      Paths_simplexmq
-  hs-source-dirs:
-      apps/smp-agent
-  default-extensions:
-      StrictData
-  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
-  build-depends:
-      aeson ==2.2.*
-    , ansi-terminal >=0.10 && <0.12
-    , asn1-encoding ==0.9.*
-    , asn1-types ==0.3.*
-    , async ==2.2.*
-    , attoparsec ==0.14.*
-    , base >=4.14 && <5
-    , base64-bytestring >=1.0 && <1.3
-    , case-insensitive ==1.2.*
-    , composition ==1.0.*
-    , constraints >=0.12 && <0.14
-    , containers ==0.6.*
-    , crypton ==0.34.*
-    , crypton-x509 ==1.7.*
-    , crypton-x509-store ==1.6.*
-    , crypton-x509-validation ==1.6.*
-    , cryptostore ==0.3.*
-    , data-default ==0.7.*
-    , direct-sqlcipher ==2.3.*
-    , directory ==1.3.*
-    , filepath ==1.4.*
-    , hourglass ==0.2.*
-    , http-types ==0.12.*
-    , http2 >=4.2.2 && <4.3
-    , ini ==0.4.1
-    , iproute ==1.7.*
-    , iso8601-time ==0.1.*
-    , memory ==0.18.*
-    , mtl >=2.3.1 && <3.0
-    , network >=3.1.2.7 && <3.2
-    , network-info ==0.2.*
-    , network-transport ==0.5.6
-    , network-udp ==0.0.*
-    , optparse-applicative >=0.15 && <0.17
-    , process ==1.6.*
-    , random >=1.1 && <1.3
-    , simple-logger ==0.1.*
-    , simplexmq
-    , socks ==0.6.*
-    , sqlcipher-simple ==0.4.*
-    , stm ==2.5.*
-    , temporary ==1.3.*
-    , time ==1.12.*
-    , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -465,6 +393,7 @@ executable smp-server
     , directory ==1.3.*
     , file-embed
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -488,7 +417,7 @@ executable smp-server
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -543,6 +472,7 @@ executable xftp
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -566,7 +496,7 @@ executable xftp
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -618,6 +548,7 @@ executable xftp-server
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
@@ -641,7 +572,7 @@ executable xftp-server
     , temporary ==1.3.*
     , time ==1.12.*
     , time-manager ==0.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
@@ -680,7 +611,6 @@ test-suite simplexmq-test
       CoreTests.CryptoFileTests
       CoreTests.CryptoTests
       CoreTests.EncodingTests
-      CoreTests.ProtocolErrorTests
       CoreTests.RetryIntervalTests
       CoreTests.TRcvQueuesTests
       CoreTests.UtilTests
@@ -730,6 +660,7 @@ test-suite simplexmq-test
     , directory ==1.3.*
     , filepath ==1.4.*
     , generic-random ==1.5.*
+    , hashable ==1.4.*
     , hourglass ==0.2.*
     , hspec ==2.11.*
     , hspec-core ==2.11.*
@@ -758,7 +689,7 @@ test-suite simplexmq-test
     , time ==1.12.*
     , time-manager ==0.0.*
     , timeit ==2.0.*
-    , tls >=1.7.0 && <1.8
+    , tls >=1.9.0 && <1.10
     , transformers ==0.6.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*

src/Simplex/FileTransfer/Agent.hs

@@ -12,6 +12,7 @@
 
 module Simplex.FileTransfer.Agent
   ( startXFTPWorkers,
+    startXFTPSndWorkers,
     closeXFTPAgent,
     toFSFilePath,
     -- Receiving files
@@ -32,22 +33,24 @@ import Control.Logger.Simple (logError)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Coerce (coerce)
 import Data.Composition ((.:))
-import Data.Either (rights)
+import Data.Either (partitionEithers, rights)
 import Data.Int (Int64)
 import Data.List (foldl', partition, sortOn)
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
+import Simplex.FileTransfer.Chunks (toKB)
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Client.Main
 import Simplex.FileTransfer.Crypto
@@ -56,11 +59,13 @@ import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
 import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
 import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types
+import qualified Simplex.FileTransfer.Types as FT
 import Simplex.FileTransfer.Util (removePath, uniqueCombine)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
@@ -69,7 +74,8 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
-import Simplex.Messaging.Protocol (EntityId, XFTPServer)
+import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType (..), XFTPServer)
+import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
 import System.FilePath (takeFileName, (</>))
 import UnliftIO
@@ -77,13 +83,21 @@ import UnliftIO.Directory
 import qualified UnliftIO.Exception as E
 
 startXFTPWorkers :: AgentClient -> Maybe FilePath -> AM ()
-startXFTPWorkers c workDir = do
+startXFTPWorkers = startXFTPWorkers_ True
+{-# INLINE startXFTPWorkers #-}
+
+startXFTPSndWorkers :: AgentClient -> Maybe FilePath -> AM ()
+startXFTPSndWorkers = startXFTPWorkers_ False
+{-# INLINE startXFTPSndWorkers #-}
+
+startXFTPWorkers_ :: Bool -> AgentClient -> Maybe FilePath -> AM ()
+startXFTPWorkers_ allWorkers c workDir = do
   wd <- asks $ xftpWorkDir . xftpAgent
   atomically $ writeTVar wd workDir
   cfg <- asks config
-  startRcvFiles cfg
+  when allWorkers $ startRcvFiles cfg
   startSndFiles cfg
-  startDelFiles cfg
+  when allWorkers $ startDelFiles cfg
   where
     startRcvFiles :: AgentConfig -> AM ()
     startRcvFiles AgentConfig {rcvFilesTTL} = do
@@ -141,7 +155,7 @@ xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks, redi
 downloadChunk :: AgentClient -> FileChunk -> AM ()
 downloadChunk c FileChunk {replicas = (FileChunkReplica {server} : _)} = do
   lift . void $ getXFTPRcvWorker True c (Just server)
-downloadChunk _ _ = throwError $ INTERNAL "no replicas"
+downloadChunk _ _ = throwE $ INTERNAL "no replicas"
 
 getPrefixPath :: String -> AM' FilePath
 getPrefixPath suffix = do
@@ -170,37 +184,45 @@ runXFTPRcvWorker c srv Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
-    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} =
+    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} =
       withWork c doWork (\db -> getNextRcvChunkToDownload db srv rcvFilesTTL) $ \case
-        (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _) -> rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) (INTERNAL "chunk has no replicas")
-        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays) -> do
+        (RcvFileChunk {rcvFileId, rcvFileEntityId, fileTmpPath, replicas = []}, _, redirectEntityId_) ->
+          rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (Just fileTmpPath) (INTERNAL "chunk has no replicas")
+        (fc@RcvFileChunk {userId, rcvFileId, rcvFileEntityId, digest, fileTmpPath, replicas = replica@RcvFileChunkReplica {rcvChunkReplicaId, server, delay} : _}, approvedRelays, redirectEntityId_) -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
+            atomically $ incXFTPServerStat c userId srv downloadAttempts
             downloadFileChunk fc replica approvedRelays
               `catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when notifyOnRetry $ notify c rcvFileEntityId $ RFERR e
+                when (serverHostError e) $ notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFWARN e)
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
-              atomically $ assertAgentForeground c
+              liftIO $ assertAgentForeground c
               loop
-            retryDone = rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath)
+            retryDone e = do
+              atomically . incXFTPServerStat c userId srv $ case e of
+                XFTP _ XFTP.AUTH -> downloadAuthErrs
+                _ -> downloadErrs
+              rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ (Just fileTmpPath) e
     downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
     downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
-      unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwError $ XFTP "" XFTP.NOT_APPROVED
+      unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
       fsFileTmpPath <- lift $ toFSFilePath fileTmpPath
       chunkPath <- uniqueCombine fsFileTmpPath $ show chunkNo
-      let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
+      let chSize = unFileSize chunkSize
+          chunkSpec = XFTPRcvChunkSpec chunkPath chSize (unFileDigest digest)
           relChunkPath = fileTmpPath </> takeFileName chunkPath
       agentXFTPDownloadChunk c userId digest replica chunkSpec
-      atomically $ waitUntilForeground c
+      liftIO $ waitUntilForeground c
       (entityId, complete, progress) <- withStore c $ \db -> runExceptT $ do
         liftIO $ updateRcvFileChunkReceived db (rcvChunkReplicaId replica) rcvChunkId relChunkPath
         RcvFile {size = FileSize currentSize, chunks, redirect} <- ExceptT $ getRcvFile db rcvFileId
@@ -211,13 +233,15 @@ runXFTPRcvWorker c srv Worker {doWork} = do
               Just RcvFileRedirect {redirectFileInfo = RedirectFileInfo {size = FileSize finalSize}, redirectEntityId} -> (redirectEntityId, finalSize)
         liftIO . when complete $ updateRcvFileStatus db rcvFileId RFSReceived
         pure (entityId, complete, RFPROG rcvd total)
+      atomically $ incXFTPServerStat c userId srv downloads
+      atomically $ incXFTPServerSizeStat c userId srv downloadsSize (fromIntegral $ toKB chSize)
       notify c entityId progress
       when complete . lift . void $
         getXFTPRcvWorker True c Nothing
       where
         ipAddressProtected' :: AM Bool
         ipAddressProtected' = do
-          cfg <- liftIO $ getNetworkConfig' c
+          cfg <- liftIO $ getFastNetworkConfig c
           pure $ ipAddressProtected cfg srv
         receivedSize :: [RcvFileChunk] -> Int64
         receivedSize = foldl' (\sz ch -> sz + receivedChunkSize ch) 0
@@ -235,29 +259,29 @@ withRetryIntervalLimit maxN ri action =
 retryOnError :: Text -> AM a -> AM a -> AgentErrorType -> AM a
 retryOnError name loop done e = do
   logError $ name <> " error: " <> tshow e
-  if temporaryAgentError e
+  if temporaryOrHostError e
     then loop
     else done
 
-rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
-rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath err = do
+rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
+rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ tmpPath err = do
   lift $ forM_ tmpPath (removePath <=< toFSFilePath)
   withStore' c $ \db -> updateRcvFileError db rcvFileId (show err)
-  notify c rcvFileEntityId $ RFERR err
+  notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFERR err)
 
 runXFTPRcvLocalWorker :: AgentClient -> Worker -> AM ()
 runXFTPRcvLocalWorker c Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
     runXFTPOperation AgentConfig {rcvFilesTTL} =
       withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
-        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath} ->
-          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath
+        \f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath, redirect} ->
+          decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
     decryptFile :: RcvFile -> AM ()
     decryptFile RcvFile {rcvFileId, rcvFileEntityId, size, digest, key, nonce, tmpPath, saveFile, status, chunks, redirect} = do
       let CryptoFile savePath cfArgs = saveFile
@@ -267,30 +291,30 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
       withStore' c $ \db -> updateRcvFileStatus db rcvFileId RFSDecrypting
       chunkPaths <- getChunkPaths chunks
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
-      when (FileSize encSize /= size) $ throwError $ XFTP "" XFTP.SIZE
+      when (FileSize encSize /= size) $ throwE $ XFTP "" XFTP.SIZE
       encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
-      when (FileDigest encDigest /= digest) $ throwError $ XFTP "" XFTP.DIGEST
+      when (FileDigest encDigest /= digest) $ throwE $ XFTP "" XFTP.DIGEST
       let destFile = CryptoFile fsSavePath cfArgs
-      void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure destFile
+      void $ liftError (FILE . FILE_IO . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure destFile
       case redirect of
         Nothing -> do
           notify c rcvFileEntityId $ RFDONE fsSavePath
           lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          atomically $ waitUntilForeground c
+          liftIO $ waitUntilForeground c
           withStore' c (`updateRcvFileComplete` rcvFileId)
         Just RcvFileRedirect {redirectFileInfo, redirectDbId} -> do
           let RedirectFileInfo {size = redirectSize, digest = redirectDigest} = redirectFileInfo
           lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          atomically $ waitUntilForeground c
+          liftIO $ waitUntilForeground c
           withStore' c (`updateRcvFileComplete` rcvFileId)
           -- proceed with redirect
-          yaml <- liftError (INTERNAL . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
+          yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
           next@FileDescription {chunks = nextChunks} <- case strDecode (LB.toStrict yaml) of
             -- TODO switch to another error constructor
-            Left _ -> throwError . XFTP "" $ XFTP.REDIRECT "decode error"
+            Left _ -> throwE . FILE $ REDIRECT "decode error"
             Right (ValidFileDescription fd@FileDescription {size = dstSize, digest = dstDigest})
-              | dstSize /= redirectSize -> throwError . XFTP "" $ XFTP.REDIRECT "size mismatch"
-              | dstDigest /= redirectDigest -> throwError . XFTP "" $ XFTP.REDIRECT "digest mismatch"
+              | dstSize /= redirectSize -> throwE . FILE $ REDIRECT "size mismatch"
+              | dstDigest /= redirectDigest -> throwE . FILE $ REDIRECT "digest mismatch"
               | otherwise -> pure fd
           -- register and download chunks from the actual file
           withStore c $ \db -> updateRcvFileRedirect db redirectDbId next
@@ -303,7 +327,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
           fsPath <- lift $ toFSFilePath path
           pure $ fsPath : ps
         getChunkPaths (RcvFileChunk {chunkTmpPath = Nothing} : _cs) =
-          throwError $ INTERNAL "no chunk path"
+          throwE $ INTERNAL "no chunk path"
 
 xftpDeleteRcvFile' :: AgentClient -> RcvFileId -> AM' ()
 xftpDeleteRcvFile' c rcvFileEntityId = xftpDeleteRcvFiles' c [rcvFileEntityId]
@@ -323,8 +347,8 @@ xftpDeleteRcvFiles' c rcvFileEntityIds = do
     batchFiles :: (DB.Connection -> DBRcvFileId -> IO a) -> [RcvFile] -> AM' [Either AgentErrorType a]
     batchFiles f rcvFiles = withStoreBatch' c $ \db -> map (\RcvFile {rcvFileId} -> f db rcvFileId) rcvFiles
 
-notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> EntityId -> ACommand 'Agent e -> m ()
-notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, APC (sAEntity @e) cmd)
+notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> AEntityId -> AEvent e -> m ()
+notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, AEvt (sAEntity @e) cmd)
 
 xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> AM SndFileId
 xftpSendFile' c userId file numRecipients = do
@@ -348,7 +372,7 @@ xftpSendDescription' c userId (ValidFileDescription fdDirect@FileDescription {si
   let directYaml = prefixPath </> "direct.yaml"
   cfArgs <- atomically $ CF.randomArgs g
   let file = CryptoFile directYaml (Just cfArgs)
-  liftError (INTERNAL . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
+  liftError (FILE . FILE_IO . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
   key <- atomically $ C.randomSbKey g
   nonce <- atomically $ C.randomCbNonce g
   fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce $ Just RedirectFileInfo {size, digest}
@@ -369,18 +393,18 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
     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 cfg f `catchAgentError` sndWorkerInternalError c sndFileId sndFileEntityId prefixPath
     prepareFile :: AgentConfig -> SndFile -> AM ()
     prepareFile _ SndFile {prefixPath = Nothing} =
-      throwError $ INTERNAL "no prefix path"
-    prepareFile cfg sndFile@SndFile {sndFileId, userId, prefixPath = Just ppath, status} = do
+      throwE $ INTERNAL "no prefix path"
+    prepareFile cfg sndFile@SndFile {sndFileId, sndFileEntityId, userId, prefixPath = Just ppath, status} = do
       SndFile {numRecipients, chunks} <-
         if status /= SFSEncrypted -- status is SFSNew or SFSEncrypting
           then do
@@ -394,9 +418,14 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
               getSndFile db sndFileId
           else pure sndFile
       let numRecipients' = min numRecipients maxRecipients
+      -- in case chunk preparation previously failed mid-way, some chunks may already be created -
+      -- here we split previously prepared chunks from the pending ones to then build full list of servers
+      let (pendingChunks, preparedSrvs) = partitionEithers $ map srvOrPendingChunk chunks
       -- concurrently?
       -- separate worker to create chunks? record retries and delay on snd_file_chunks?
-      forM_ (filter (\SndFileChunk {replicas} -> null replicas) chunks) $ createChunk numRecipients'
+      srvs <- forM pendingChunks $ createChunk numRecipients'
+      let allSrvs = S.fromList $ preparedSrvs <> srvs
+      lift $ forM_ allSrvs $ \srv -> getXFTPSndWorker True c (Just srv)
       withStore' c $ \db -> updateSndFileStatus db sndFileId SFSUploading
       where
         AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients, messageRetryInterval = ri} = cfg
@@ -405,91 +434,110 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
           let CryptoFile {filePath} = srcFile
               fileName = takeFileName filePath
           fileSize <- liftIO $ fromInteger <$> CF.getFileContentsSize srcFile
-          when (fileSize > maxFileSizeHard) $ throwError $ INTERNAL "max file size exceeded"
+          when (fileSize > maxFileSizeHard) $ throwE $ FILE FT.SIZE
           let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
               fileSize' = fromIntegral (B.length fileHdr) + fileSize
               payloadSize = fileSize' + fileSizeLen + authTagSize
           chunkSizes <- case redirect of
             Nothing -> pure $ prepareChunkSizes payloadSize
             Just _ -> case singleChunkSize payloadSize of
-              Nothing -> throwError $ INTERNAL "max file size exceeded for redirect"
+              Nothing -> throwE $ FILE FT.SIZE
               Just chunkSize -> pure [chunkSize]
           let encSize = sum $ map fromIntegral chunkSizes
-          void $ liftError (INTERNAL . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
+          void $ liftError (FILE . FILE_IO . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
           digest <- liftIO $ LC.sha512Hash <$> LB.readFile fsEncPath
           let chunkSpecs = prepareChunkSpecs fsEncPath chunkSizes
           chunkDigests <- liftIO $ mapM getChunkDigest chunkSpecs
           pure (FileDigest digest, zip chunkSpecs $ coerce chunkDigests)
-        createChunk :: Int -> SndFileChunk -> AM ()
+        srvOrPendingChunk :: SndFileChunk -> Either SndFileChunk (ProtocolServer 'PXFTP)
+        srvOrPendingChunk ch@SndFileChunk {replicas} = case replicas of
+          [] -> Left ch
+          SndFileChunkReplica {server} : _ -> Right server
+        createChunk :: Int -> SndFileChunk -> AM (ProtocolServer 'PXFTP)
         createChunk numRecipients' ch = do
-          atomically $ assertAgentForeground c
+          liftIO $ assertAgentForeground c
           (replica, ProtoServerWithAuth srv _) <- tryCreate
           withStore' c $ \db -> createSndFileReplica db ch replica
-          lift . void $ getXFTPSndWorker True c (Just srv)
+          pure srv
           where
             tryCreate = do
               usedSrvs <- newTVarIO ([] :: [XFTPServer])
-              withRetryInterval (riFast ri) $ \_ loop -> do
+              let AgentClient {xftpServers} = c
+              userSrvCount <- liftIO $ length <$> TM.lookupIO userId xftpServers
+              withRetryIntervalCount (riFast ri) $ \n _ loop -> do
+                liftIO $ waitWhileSuspended c
                 liftIO $ waitForUserNetwork c
+                let triedAllSrvs = n > userSrvCount
                 createWithNextSrv usedSrvs
-                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop) (throwError e) e
+                  `catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
               where
-                retryLoop loop = atomically (assertAgentForeground c) >> loop
+                -- we don't do closeXFTPServerClient here to not risk closing connection for concurrent chunk upload
+                retryLoop loop triedAllSrvs e = do
+                  flip catchAgentError (\_ -> pure ()) $ do
+                    when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
+                  liftIO $ assertAgentForeground c
+                  loop
             createWithNextSrv usedSrvs = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
-              when deleted $ throwError $ INTERNAL "file deleted, aborting chunk creation"
+              when deleted $ throwE $ FILE NO_FILE
               withNextSrv c userId usedSrvs [] $ \srvAuth -> do
                 replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
                 pure (replica, srvAuth)
 
-sndWorkerInternalError :: AgentClient -> DBSndFileId -> SndFileId -> Maybe FilePath -> String -> AM ()
-sndWorkerInternalError c sndFileId sndFileEntityId prefixPath internalErrStr = do
+sndWorkerInternalError :: AgentClient -> DBSndFileId -> SndFileId -> Maybe FilePath -> AgentErrorType -> AM ()
+sndWorkerInternalError c sndFileId sndFileEntityId prefixPath err = do
   lift . forM_ prefixPath $ removePath <=< toFSFilePath
-  withStore' c $ \db -> updateSndFileError db sndFileId internalErrStr
-  notify c sndFileEntityId $ SFERR $ INTERNAL internalErrStr
+  withStore' c $ \db -> updateSndFileError db sndFileId (show err)
+  notify c sndFileEntityId $ SFERR err
 
 runXFTPSndWorker :: AgentClient -> XFTPServer -> Worker -> AM ()
 runXFTPSndWorker c srv Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
-    runXFTPOperation cfg@AgentConfig {sndFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} = do
+    runXFTPOperation cfg@AgentConfig {sndFilesTTL, reconnectInterval = ri, 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"
+        SndFileChunk {sndFileId, sndFileEntityId, filePrefixPath, replicas = []} -> sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) (INTERNAL "chunk has no replicas")
         fc@SndFileChunk {userId, sndFileId, sndFileEntityId, filePrefixPath, digest, replicas = replica@SndFileChunkReplica {sndChunkReplicaId, server, delay} : _} -> do
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
+            atomically $ incXFTPServerStat c userId srv uploadAttempts
             uploadFileChunk cfg fc replica
               `catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when notifyOnRetry $ notify c sndFileEntityId $ SFERR e
+                when (serverHostError e) $ notify c sndFileEntityId $ SFWARN e
                 liftIO $ closeXFTPServerClient c userId server digest
                 withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
-              atomically $ assertAgentForeground c
+              liftIO $ assertAgentForeground c
               loop
-            retryDone e = sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) (show e)
+            retryDone e = do
+              atomically $ incXFTPServerStat c userId srv uploadErrs
+              sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) e
     uploadFileChunk :: AgentConfig -> SndFileChunk -> SndFileChunkReplica -> AM ()
-    uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
+    uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath, chunkSize = chSize}, digest = chunkDigest} replica = do
       replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
       fsFilePath <- lift $ toFSFilePath filePath
-      unlessM (doesFileExist fsFilePath) $ throwError $ INTERNAL "encrypted file doesn't exist on upload"
+      unlessM (doesFileExist fsFilePath) $ throwE $ FILE NO_FILE
       let chunkSpec' = chunkSpec {filePath = fsFilePath} :: XFTPChunkSpec
-      atomically $ assertAgentForeground c
+      liftIO $ assertAgentForeground c
       agentXFTPUploadChunk c userId chunkDigest replica' chunkSpec'
-      atomically $ waitUntilForeground c
+      liftIO $ waitUntilForeground c
       sf@SndFile {sndFileEntityId, prefixPath, chunks} <- withStore c $ \db -> do
         updateSndChunkReplicaStatus db sndChunkReplicaId SFRSUploaded
         getSndFile db sndFileId
       let uploaded = uploadedSize chunks
           total = totalSize chunks
           complete = all chunkUploaded chunks
+      atomically $ incXFTPServerStat c userId srv uploads
+      atomically $ incXFTPServerSizeStat c userId srv uploadsSize (fromIntegral $ toKB chSize)
       notify c sndFileEntityId $ SFPROG uploaded total
       when complete $ do
         (sndDescr, rcvDescrs) <- sndFileToDescrs sf
@@ -499,7 +547,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
       where
         addRecipients :: SndFileChunk -> SndFileChunkReplica -> AM SndFileChunkReplica
         addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {rcvIdsKeys}
-          | length rcvIdsKeys > numRecipients = throwError $ INTERNAL "too many recipients"
+          | length rcvIdsKeys > numRecipients = throwE $ INTERNAL "too many recipients"
           | length rcvIdsKeys == numRecipients = pure cr
           | otherwise = do
               let numRecipients' = min (numRecipients - length rcvIdsKeys) maxRecipients
@@ -507,22 +555,22 @@ runXFTPSndWorker c srv Worker {doWork} = do
               cr' <- withStore' c $ \db -> addSndChunkReplicaRecipients db cr $ L.toList rcvIdsKeys'
               addRecipients ch cr'
         sndFileToDescrs :: SndFile -> AM (ValidFileDescription 'FSender, [ValidFileDescription 'FRecipient])
-        sndFileToDescrs SndFile {digest = Nothing} = throwError $ INTERNAL "snd file has no digest"
-        sndFileToDescrs SndFile {chunks = []} = throwError $ INTERNAL "snd file has no chunks"
+        sndFileToDescrs SndFile {digest = Nothing} = throwE $ INTERNAL "snd file has no digest"
+        sndFileToDescrs SndFile {chunks = []} = throwE $ INTERNAL "snd file has no chunks"
         sndFileToDescrs SndFile {digest = Just digest, key, nonce, chunks = chunks@(fstChunk : _), redirect} = do
           let chunkSize = FileSize $ sndChunkSize fstChunk
               size = FileSize $ sum $ map (fromIntegral . sndChunkSize) chunks
           -- snd description
           sndDescrChunks <- mapM toSndDescrChunk chunks
           let fdSnd = FileDescription {party = SFSender, size, digest, key, nonce, chunkSize, chunks = sndDescrChunks, redirect = Nothing}
-          validFdSnd <- either (throwError . INTERNAL) pure $ validateFileDescription fdSnd
+          validFdSnd <- either (throwE . INTERNAL) pure $ validateFileDescription fdSnd
           -- rcv descriptions
           let fdRcv = FileDescription {party = SFRecipient, size, digest, key, nonce, chunkSize, chunks = [], redirect}
               fdRcvs = createRcvFileDescriptions fdRcv chunks
-          validFdRcvs <- either (throwError . INTERNAL) pure $ mapM validateFileDescription fdRcvs
+          validFdRcvs <- either (throwE . INTERNAL) pure $ mapM validateFileDescription fdRcvs
           pure (validFdSnd, validFdRcvs)
         toSndDescrChunk :: SndFileChunk -> AM FileChunk
-        toSndDescrChunk SndFileChunk {replicas = []} = throwError $ INTERNAL "snd file chunk has no replicas"
+        toSndDescrChunk SndFileChunk {replicas = []} = throwE $ INTERNAL "snd file chunk has no replicas"
         toSndDescrChunk ch@SndFileChunk {chunkNo, digest = chDigest, replicas = (SndFileChunkReplica {server, replicaId, replicaKey} : _)} = do
           let chunkSize = FileSize $ sndChunkSize ch
               replicas = [FileChunkReplica {server, replicaId, replicaKey}]
@@ -619,39 +667,44 @@ runXFTPDelWorker c srv Worker {doWork} = do
   cfg <- asks config
   forever $ do
     lift $ waitForWork doWork
-    atomically $ assertAgentForeground c
+    liftIO $ assertAgentForeground c
     runXFTPOperation cfg
   where
     runXFTPOperation :: AgentConfig -> AM ()
-    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpNotifyErrsOnRetry = notifyOnRetry, xftpConsecutiveRetries} = do
+    runXFTPOperation AgentConfig {rcvFilesTTL, reconnectInterval = ri, xftpConsecutiveRetries} = 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
           let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
           withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
+            atomically $ incXFTPServerStat c userId srv deleteAttempts
             deleteChunkReplica
               `catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
           where
             retryLoop loop e replicaDelay = do
               flip catchAgentError (\_ -> pure ()) $ do
-                when notifyOnRetry $ notify c "" $ SFERR e
+                when (serverHostError e) $ notify c "" $ SFWARN e
                 liftIO $ closeXFTPServerClient c userId server chunkDigest
                 withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
-              atomically $ assertAgentForeground c
+              liftIO $ assertAgentForeground c
               loop
-            retryDone = delWorkerInternalError c deletedSndChunkReplicaId
+            retryDone e = do
+              atomically $ incXFTPServerStat c userId srv deleteErrs
+              delWorkerInternalError c deletedSndChunkReplicaId e
             deleteChunkReplica = do
               agentXFTPDeleteChunk c userId replica
               withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
+              atomically $ incXFTPServerStat c userId srv deletions
 
 delWorkerInternalError :: AgentClient -> Int64 -> AgentErrorType -> AM ()
 delWorkerInternalError c deletedSndChunkReplicaId e = do
   withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
   notify c "" $ SFERR e
 
-assertAgentForeground :: AgentClient -> STM ()
+assertAgentForeground :: AgentClient -> IO ()
 assertAgentForeground c = do
   throwWhenInactive c
   waitUntilForeground c

src/Simplex/FileTransfer/Chunks.hs

@@ -26,6 +26,10 @@ kb :: Integral a => a -> a
 kb n = 1024 * n
 {-# INLINE kb #-}
 
+toKB :: Integral a => a -> a
+toKB n = n `div` 1024
+{-# INLINE toKB #-}
+
 mb :: Integral a => a -> a
 mb n = 1024 * kb n
 {-# INLINE mb #-}

src/Simplex/FileTransfer/Client.hs

@@ -22,7 +22,6 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
-import Data.Time (UTCTime)
 import Data.Word (Word32)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
@@ -51,6 +50,7 @@ import Simplex.Messaging.Protocol
     ProtocolServer (..),
     RecipientId,
     SenderId,
+    pattern NoEntity,
   )
 import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters)
 import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
@@ -138,9 +138,9 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
       liftTransportErr (TEHandshake PARSE) . smpDecode =<< liftTransportErr TEBadBlock (C.unPad shsBody)
     processServerHandshake :: XFTPServerHandshake -> ExceptT XFTPClientError IO (VersionRangeXFTP, C.PublicKeyX25519)
     processServerHandshake XFTPServerHandshake {xftpVersionRange, sessionId = serverSessId, authPubKey = serverAuth} = do
-      unless (sessionId == serverSessId) $ throwError $ PCETransportError TEBadSession
+      unless (sessionId == serverSessId) $ throwE $ PCETransportError TEBadSession
       case xftpVersionRange `compatibleVRange` serverVRange of
-        Nothing -> throwError $ PCETransportError TEVersion
+        Nothing -> throwE $ PCETransportError TEVersion
         Just (Compatible vr) ->
           fmap (vr,) . liftTransportErr (TEHandshake BAD_AUTH) $ do
             let (X.CertificateChain cert, exact) = serverAuth
@@ -154,7 +154,7 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
       chs' <- liftTransportErr TELargeMsg $ C.pad (smpEncode chs) xftpBlockSize
       let chsReq = H.requestBuilder "POST" "/" [] $ byteString chs'
       HTTP2Response {respBody = HTTP2Body {bodyHead}} <- liftError' xftpClientError $ sendRequest c chsReq Nothing
-      unless (B.null bodyHead) $ throwError $ PCETransportError TEBadBlock
+      unless (B.null bodyHead) $ throwE $ PCETransportError TEBadBlock
     liftTransportErr e = liftEitherWith (const $ PCETransportError e)
 
 closeXFTPClient :: XFTPClient -> IO ()
@@ -168,9 +168,6 @@ xftpClientServer = B.unpack . strEncode . snd3 . transportSession
 xftpTransportHost :: XFTPClient -> TransportHost
 xftpTransportHost XFTPClient {http2Client = HTTP2Client {client_ = HClient {host}}} = host
 
-xftpSessionTs :: XFTPClient -> UTCTime
-xftpSessionTs = sessionTs . http2Client
-
 xftpHTTP2Config :: TransportClientConfig -> XFTPClientConfig -> HTTP2ClientConfig
 xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} =
   defaultHTTP2ClientConfig
@@ -200,14 +197,14 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
   let req = H.requestStreaming N.methodPost "/" [] streamBody
       reqTimeout = xftpReqTimeout config $ (\XFTPChunkSpec {chunkSize} -> chunkSize) <$> chunkSpec_
   HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- withExceptT xftpClientError . ExceptT $ sendRequest http2Client req (Just reqTimeout)
-  when (B.length bodyHead /= xftpBlockSize) $ throwError $ PCEResponseError BLOCK
+  when (B.length bodyHead /= xftpBlockSize) $ throwE $ PCEResponseError BLOCK
   -- TODO validate that the file ID is the same as in the request?
   (_, _, (_, _fId, respOrErr)) <- liftEither . first PCEResponseError $ xftpDecodeTransmission thParams bodyHead
   case respOrErr of
     Right r -> case protocolError r of
-      Just e -> throwError $ PCEProtocolError e
+      Just e -> throwE $ PCEProtocolError e
       _ -> pure (r, body)
-    Left e -> throwError $ PCEResponseError e
+    Left e -> throwE $ PCEResponseError e
   where
     streamBody :: (Builder -> IO ()) -> IO () -> IO ()
     streamBody send done = do
@@ -226,7 +223,7 @@ createXFTPChunk ::
   Maybe BasicAuth ->
   ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
 createXFTPChunk c spKey file rcps auth_ =
-  sendXFTPCommand c spKey "" (FNEW file rcps auth_) Nothing >>= \case
+  sendXFTPCommand c spKey NoEntity (FNEW file rcps auth_) Nothing >>= \case
     (FRSndIds sId rIds, body) -> noFile body (sId, rIds)
     (r, _) -> throwE $ unexpectedResponse r
 
@@ -250,7 +247,7 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
         let dhSecret = C.dh' sDhKey rpDhKey
         cbState <- liftEither . first PCECryptoError $ LC.cbInit dhSecret cbNonce
         let t = chunkTimeout config chunkSize
-        ExceptT (sequence <$> (t `timeout` (download cbState `catches` errors))) >>= maybe (throwError PCEResponseTimeout) pure
+        ExceptT (sequence <$> (t `timeout` (download cbState `catches` errors))) >>= maybe (throwE PCEResponseTimeout) pure
         where
           errors =
             [ Handler $ \(_e :: H.HTTP2Error) -> pure $ Left PCENetworkError,
@@ -260,8 +257,8 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
           download cbState =
             runExceptT . withExceptT PCEResponseError $
               receiveEncFile chunkPart cbState chunkSpec `catchError` \e ->
-                whenM (doesFileExist filePath) (removeFile filePath) >> throwError e
-      _ -> throwError $ PCEResponseError NO_FILE
+                whenM (doesFileExist filePath) (removeFile filePath) >> throwE e
+      _ -> throwE $ PCEResponseError NO_FILE
     (r, _) -> throwE $ unexpectedResponse r
 
 xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
@@ -282,7 +279,7 @@ pingXFTP :: XFTPClient -> ExceptT XFTPClientError IO ()
 pingXFTP c@XFTPClient {thParams} = do
   t <-
     liftEither . first PCETransportError $
-      xftpEncodeTransmission thParams ("", "", FileCmd SFRecipient PING)
+      xftpEncodeTransmission thParams ("", NoEntity, FileCmd SFRecipient PING)
   (r, _) <- sendXFTPTransmission c t Nothing
   case r of
     FRPong -> pure ()
@@ -296,7 +293,7 @@ okResponse = \case
 -- TODO this currently does not check anything because response size is not set and bodyPart is always Just
 noFile :: HTTP2Body -> a -> ExceptT XFTPClientError IO a
 noFile HTTP2Body {bodyPart} a = case bodyPart of
-  Just _ -> pure a -- throwError $ PCEResponseError HAS_FILE
+  Just _ -> pure a -- throwE $ PCEResponseError HAS_FILE
   _ -> pure a
 
 -- FACK :: FileCommand Recipient

src/Simplex/FileTransfer/Client/Agent.hs

@@ -11,6 +11,7 @@ import Control.Logger.Simple (logInfo)
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
 import Data.Text (Text)
@@ -52,9 +53,9 @@ defaultXFTPClientAgentConfig =
 data XFTPClientAgentError = XFTPClientAgentError XFTPServer XFTPClientError
   deriving (Show, Exception)
 
-newXFTPAgent :: XFTPClientAgentConfig -> STM XFTPClientAgent
+newXFTPAgent :: XFTPClientAgentConfig -> IO XFTPClientAgent
 newXFTPAgent config = do
-  xftpClients <- TM.empty
+  xftpClients <- TM.emptyIO
   pure XFTPClientAgent {xftpClients, config}
 
 type ME a = ExceptT XFTPClientAgentError IO a
@@ -108,7 +109,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
                 else atomically $ do
                   putTMVar clientVar r
                   TM.delete srv xftpClients
-              throwError e
+              throwE e
         tryConnectAsync :: ME ()
         tryConnectAsync = void . lift . async . runExceptT $ do
           withRetryInterval (reconnectInterval config) $ \_ loop -> void $ tryConnectClient loop

src/Simplex/FileTransfer/Client/Main.hs

@@ -30,6 +30,7 @@ where
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
@@ -42,8 +43,8 @@ import Data.Int (Int64)
 import Data.List (foldl', sortOn)
 import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
 import qualified Data.List.NonEmpty as L
-import Data.Map (Map)
-import qualified Data.Map as M
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, listToMaybe)
 import qualified Data.Text as T
 import Data.Word (Word32)
@@ -292,7 +293,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
     encryptFileForUpload :: TVar ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
     encryptFileForUpload g fileName = do
       fileSize <- fromInteger <$> getFileSize filePath
-      when (fileSize > maxFileSize) $ throwError $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
+      when (fileSize > maxFileSize) $ throwE $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
       encPath <- getEncPath tempPath "xftp"
       key <- atomically $ C.randomSbKey g
       nonce <- atomically $ C.randomCbNonce g
@@ -312,7 +313,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
     uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
     uploadFile g chunks uploadedChunks encSize = do
-      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       gen <- newTVarIO =<< liftIO newStdGen
       let xftpSrvs = fromMaybe defaultXFTPServers (nonEmpty xftpServers)
       srvs <- liftIO $ replicateM (length chunks) $ getXFTPServer gen xftpSrvs
@@ -323,7 +324,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       -- upload doesn't allow other requests within the same client until complete (but download does allow).
       logInfo $ "uploading " <> tshow (length chunks) <> " chunks..."
       (errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 chunks' . mapM $ runExceptT . uploadFileChunk a)
-      mapM_ throwError errs
+      mapM_ throwE errs
       pure $ map snd (sortOn fst rs)
       where
         uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec, XFTPServerWithAuth) -> ExceptT CLIError IO (Int, SentFileChunk)
@@ -428,7 +429,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
     receive (ValidFileDescription FileDescription {size, digest, key, nonce, chunks}) = do
       encPath <- getEncPath tempPath "xftp"
       createDirectory encPath
-      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       liftIO $ printNoNewLine "Downloading file..."
       downloadedChunks <- newTVarIO []
       let srv FileChunk {replicas} = case replicas of
@@ -437,12 +438,12 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
           srvChunks = groupAllOn srv chunks
       g <- liftIO C.newRandom
       (errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 srvChunks $ mapM $ runExceptT . downloadFileChunk g a encPath size downloadedChunks)
-      mapM_ throwError errs
+      mapM_ throwE errs
       let chunkPaths = map snd $ sortOn fst rs
       encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
-      when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch"
+      when (encDigest /= unFileDigest digest) $ throwE $ CLIError "File digest mismatch"
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
-      when (FileSize encSize /= size) $ throwError $ CLIError "File size mismatch"
+      when (FileSize encSize /= size) $ throwE $ CLIError "File size mismatch"
       liftIO $ printNoNewLine "Decrypting file..."
       CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap CF.plain . getFilePath
       forM_ chunks $ acknowledgeFileChunk a
@@ -464,20 +465,20 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
         printProgress "Downloaded" downloaded encSize
         when verbose $ putStrLn ""
       pure (chunkNo, chunkPath)
-    downloadFileChunk _ _ _ _ _ _ = throwError $ CLIError "chunk has no replicas"
+    downloadFileChunk _ _ _ _ _ _ = throwE $ CLIError "chunk has no replicas"
     getFilePath :: String -> ExceptT String IO FilePath
     getFilePath name =
       case filePath of
         Just path ->
           ifM (doesDirectoryExist path) (uniqueCombine path name) $
-            ifM (doesFileExist path) (throwError "File already exists") (pure path)
+            ifM (doesFileExist path) (throwE "File already exists") (pure path)
         _ -> (`uniqueCombine` name) . (</> "Downloads") =<< getHomeDirectory
     acknowledgeFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO ()
     acknowledgeFileChunk a FileChunk {replicas = replica : _} = do
       let FileChunkReplica {server, replicaId, replicaKey} = replica
       c <- withRetry retryCount $ getXFTPServerClient a server
       withRetry retryCount $ ackXFTPChunk c replicaKey (unChunkReplicaId replicaId)
-    acknowledgeFileChunk _ _ = throwError $ CLIError "chunk has no replicas"
+    acknowledgeFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
 
 printProgress :: String -> Int64 -> Int64 -> IO ()
 printProgress s part total = printNoNewLine $ s <> " " <> show ((part * 100) `div` total) <> "%"
@@ -493,7 +494,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
   where
     deleteFile :: ValidFileDescription 'FSender -> ExceptT CLIError IO ()
     deleteFile (ValidFileDescription FileDescription {chunks}) = do
-      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
+      a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       forM_ chunks $ deleteFileChunk a
       liftIO $ do
         printNoNewLine "File deleted!"
@@ -503,7 +504,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
       let FileChunkReplica {server, replicaId, replicaKey} = replica
       withReconnect a server retryCount $ \c -> deleteXFTPChunk c replicaKey (unChunkReplicaId replicaId)
       logInfo $ "deleted chunk " <> tshow chunkNo <> " from " <> showServer server
-    deleteFileChunk _ _ = throwError $ CLIError "chunk has no replicas"
+    deleteFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
 
 cliFileDescrInfo :: InfoOptions -> ExceptT CLIError IO ()
 cliFileDescrInfo InfoOptions {fileDescription} = do
@@ -533,7 +534,7 @@ getFileDescription path =
 getFileDescription' :: FilePartyI p => FilePath -> ExceptT CLIError IO (ValidFileDescription p)
 getFileDescription' path =
   getFileDescription path >>= \case
-    AVFD fd -> either (throwError . CLIError) pure $ checkParty fd
+    AVFD fd -> either (throwE . CLIError) pure $ checkParty fd
 
 singleChunkSize :: Int64 -> Maybe Word32
 singleChunkSize size' =
@@ -574,13 +575,13 @@ withReconnect a srv n run = withRetry n $ do
   c <- withRetry n $ getXFTPServerClient a srv
   withExceptT (CLIError . show) (run c) `catchError` \e -> do
     liftIO $ closeXFTPServerClient a srv
-    throwError e
+    throwE e
 
 withRetry :: Show e => Int -> ExceptT e IO a -> ExceptT CLIError IO a
 withRetry retryCount = withRetry' retryCount . withExceptT (CLIError . show)
   where
     withRetry' :: Int -> ExceptT CLIError IO a -> ExceptT CLIError IO a
-    withRetry' 0 _ = throwError $ CLIError "internal: no retry attempts"
+    withRetry' 0 _ = throwE $ CLIError "internal: no retry attempts"
     withRetry' 1 a = a
     withRetry' n a =
       a `catchError` \e -> do

src/Simplex/FileTransfer/Crypto.hs

@@ -8,6 +8,7 @@ module Simplex.FileTransfer.Crypto where
 
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import qualified Data.ByteArray as BA
@@ -48,17 +49,17 @@ encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
       | otherwise = do
           let chSize = min len 65536
           ch <- liftIO $ get chSize
-          when (B.length ch /= fromIntegral chSize) $ throwError $ FTCEFileIOError "encrypting file: unexpected EOF"
+          when (B.length ch /= fromIntegral chSize) $ throwE $ FTCEFileIOError "encrypting file: unexpected EOF"
           let (ch', sb') = LC.sbEncryptChunk sb ch
           liftIO $ B.hPut w ch'
           encryptChunks_ get w (sb', len - chSize)
 
 decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile
-decryptChunks _ [] _ _ _ = throwError $ FTCEInvalidHeader "empty"
+decryptChunks _ [] _ _ _ = throwE $ FTCEInvalidHeader "empty"
 decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse chPaths of
   [] -> do
     (!authOk, !f) <- liftEither . first FTCECryptoError . LC.sbDecryptTailTag key nonce (encSize - authTagSize) =<< liftIO (LB.readFile chPath)
-    unless authOk $ throwError FTCEInvalidAuthTag
+    unless authOk $ throwE FTCEInvalidAuthTag
     (FileHeader {fileName}, !f') <- parseFileHeader f
     destFile <- withExceptT FTCEFileIOError $ getDestFile fileName
     CF.writeFile destFile f'
@@ -73,7 +74,7 @@ decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse ch
       decryptLastChunk h state' expectedLen
     unless authOk $ do
       removeFile path
-      throwError FTCEInvalidAuthTag
+      throwE FTCEInvalidAuthTag
     pure destFile
     where
       decryptFirstChunk = do
@@ -105,8 +106,8 @@ decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse ch
     parseFileHeader s = do
       let (hdrStr, s') = LB.splitAt 1024 s
       case A.parse smpP $ LB.toStrict hdrStr of
-        A.Fail _ _ e -> throwError $ FTCEInvalidHeader e
-        A.Partial _ -> throwError $ FTCEInvalidHeader "incomplete"
+        A.Fail _ _ e -> throwE $ FTCEInvalidHeader e
+        A.Partial _ -> throwE $ FTCEInvalidHeader "incomplete"
         A.Done rest hdr -> pure (hdr, LB.fromStrict rest <> s')
 
 readChunks :: [FilePath] -> IO LB.ByteString

src/Simplex/FileTransfer/Description.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -52,8 +54,8 @@ 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.Map.Strict (Map)
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 import Data.String
 import Data.Text (Text)
@@ -139,12 +141,9 @@ data FileChunkReplica = FileChunkReplica
   }
   deriving (Eq, Show)
 
-newtype ChunkReplicaId = ChunkReplicaId {unChunkReplicaId :: ByteString}
+newtype ChunkReplicaId = ChunkReplicaId {unChunkReplicaId :: XFTPFileId}
   deriving (Eq, Show)
-
-instance StrEncoding ChunkReplicaId where
-  strEncode (ChunkReplicaId fid) = strEncode fid
-  strP = ChunkReplicaId <$> strP
+  deriving newtype (StrEncoding)
 
 instance FromJSON ChunkReplicaId where
   parseJSON = strParseJSON "ChunkReplicaId"
@@ -153,10 +152,6 @@ instance ToJSON ChunkReplicaId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
-instance FromField ChunkReplicaId where fromField f = ChunkReplicaId <$> fromField f
-
-instance ToField ChunkReplicaId where toField (ChunkReplicaId s) = toField s
-
 data YAMLFileDescription = YAMLFileDescription
   { party :: FileParty,
     size :: String,

src/Simplex/FileTransfer/Protocol.hs

@@ -41,6 +41,7 @@ import Simplex.Messaging.Protocol
     ProtocolType (..),
     RcvPublicAuthKey,
     RcvPublicDhKey,
+    EntityId (..),
     RecipientId,
     SenderId,
     SentRawTransmission,
@@ -170,7 +171,7 @@ data FileInfo = FileInfo
   }
   deriving (Show)
 
-type XFTPFileId = ByteString
+type XFTPFileId = EntityId
 
 instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand p) where
   type Tag (FileCommand p) = FileCommandTag p
@@ -191,7 +192,7 @@ instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand
   fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (auth, _, fileId, _) cmd = case cmd of
+  checkCredentials (auth, _, EntityId fileId, _) cmd = case cmd of
     -- FNEW must not have signature and chunk ID
     FNEW {}
       | isNothing auth -> Left $ CMD NO_AUTH
@@ -301,7 +302,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
     PEBlock -> BLOCK
   {-# INLINE fromProtocolError #-}
 
-  checkCredentials (_, _, entId, _) cmd = case cmd of
+  checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
     FRSndIds {} -> noEntity
     -- ERR response does not always have entity ID
     FRErr _ -> Right cmd

src/Simplex/FileTransfer/Server.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
@@ -18,6 +19,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Builder (Builder, byteString)
@@ -36,6 +38,7 @@ import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Word (Word32)
 import qualified Data.X509 as X
 import GHC.IO.Handle (hSetNewlineMode)
+import GHC.IORef (atomicSwapIORef)
 import GHC.Stats (getRTSStats)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Server as H
@@ -51,7 +54,7 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (CorrId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth)
+import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Stats
@@ -62,7 +65,7 @@ import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.HTTP2
 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
 import Simplex.Messaging.Transport.HTTP2.Server
-import Simplex.Messaging.Transport.Server (runTCPServer, tlsServerCredentials)
+import Simplex.Messaging.Transport.Server (runLocalTCPServer, tlsServerCredentials)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure)
@@ -111,7 +114,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         Right pk' -> pure pk'
         Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
       env <- ask
-      sessions <- atomically TM.empty
+      sessions <- liftIO TM.emptyIO
       let cleanup sessionId = atomically $ TM.delete sessionId sessions
       liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize serverParams transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
         reqBody <- getHTTP2Body r xftpBlockSize
@@ -136,7 +139,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       either sendError pure r
       where
         processHello = do
-          unless (B.null bodyHead) $ throwError HANDSHAKE
+          unless (B.null bodyHead) $ throwE HANDSHAKE
           (k, pk) <- atomically . C.generateKeyPair =<< asks random
           atomically $ TM.insert sessionId (HandshakeSent pk) sessions
           let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
@@ -148,11 +151,11 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
           liftIO . sendResponse $ H.responseBuilder N.ok200 [] shs
           pure Nothing
         processClientHandshake pk = do
-          unless (B.length bodyHead == xftpBlockSize) $ throwError HANDSHAKE
+          unless (B.length bodyHead == xftpBlockSize) $ throwE HANDSHAKE
           body <- liftHS $ C.unPad bodyHead
           XFTPClientHandshake {xftpVersion = v, keyHash} <- liftHS $ smpDecode body
           kh <- asks serverIdentity
-          unless (keyHash == kh) $ throwError HANDSHAKE
+          unless (keyHash == kh) $ throwE HANDSHAKE
           case compatibleVRange' xftpServerVRange v of
             Just (Compatible vr) -> do
               let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
@@ -163,7 +166,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
 #endif
               liftIO . sendResponse $ H.responseNoBody N.ok200 []
               pure Nothing
-            Nothing -> throwError HANDSHAKE
+            Nothing -> throwE HANDSHAKE
         sendError :: XFTPErrorType -> M (Maybe (THandleParams XFTPVersion 'TServer))
         sendError err = do
           runExceptT (encodeXftp err) >>= \case
@@ -206,17 +209,17 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
         withFile statsFilePath AppendMode $ \h -> liftIO $ do
           hSetBuffering h LineBuffering
           ts <- getCurrentTime
-          fromTime' <- atomically $ swapTVar fromTime ts
-          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
+          fromTime' <- atomicSwapIORef fromTime ts
+          filesCreated' <- atomicSwapIORef filesCreated 0
+          fileRecipients' <- atomicSwapIORef fileRecipients 0
+          filesUploaded' <- atomicSwapIORef filesUploaded 0
+          filesExpired' <- atomicSwapIORef filesExpired 0
+          filesDeleted' <- atomicSwapIORef filesDeleted 0
+          files <- liftIO $ periodStatCounts filesDownloaded ts
+          fileDownloads' <- atomicSwapIORef fileDownloads 0
+          fileDownloadAcks' <- atomicSwapIORef fileDownloadAcks 0
+          filesCount' <- readIORef filesCount
+          filesSize' <- readIORef filesSize
           hPutStrLn h $
             intercalate
               ","
@@ -246,7 +249,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       u <- askUnliftIO
       liftIO $ do
         labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u
+        runLocalTCPServer cpStarted port $ runCPClient u
       where
         runCPClient :: UnliftIO (ReaderT XFTPEnv IO) -> Socket -> IO ()
         runCPClient u sock = do
@@ -308,7 +311,7 @@ data ServerFile = ServerFile
 
 processRequest :: XFTPTransportRequest -> M ()
 processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
-  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", "", FRErr BLOCK) Nothing
+  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
   | otherwise = do
       case xftpDecodeTransmission thParams bodyHead of
         Right (sig_, signed, (corrId, fId, cmdOrErr)) ->
@@ -321,7 +324,7 @@ processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHea
             Left e -> send (FRErr e) Nothing
           where
             send resp = sendXFTPResponse (corrId, fId, resp)
-        Left e -> sendXFTPResponse ("", "", FRErr e) Nothing
+        Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
   where
     sendXFTPResponse (corrId, fId, resp) serverFile_ = do
       let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
@@ -395,7 +398,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       st <- asks store
       r <- runExceptT $ do
         sizes <- asks $ allowedChunkSizes . config
-        unless (size file `elem` sizes) $ throwError SIZE
+        unless (size file `elem` sizes) $ throwE SIZE
         ts <- liftIO getSystemTime
         -- TODO validate body empty
         sId <- ExceptT $ addFileRetry st file 3 ts
@@ -404,8 +407,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
           logAddFile sl sId file ts
           logAddRecipients sl sId rcps
         stats <- asks serverStats
-        atomically $ modifyTVar' (filesCreated stats) (+ 1)
-        atomically $ modifyTVar' (fileRecipients stats) (+ length rks)
+        lift $ incFileStat filesCreated
+        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRSndIds sId rIds
       pure $ either FRErr id r
@@ -434,7 +437,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
         rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
         lift $ withFileLog $ \sl -> logAddRecipients sl sId rcps
         stats <- asks serverStats
-        atomically $ modifyTVar' (fileRecipients stats) (+ length rks)
+        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
         let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
         pure $ FRRcvIds rIds
       pure $ either FRErr id r
@@ -462,19 +465,19 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
               \used -> let used' = used + fromIntegral size in if used' <= quota then (True, used') else (False, used)
           receive = do
             path <- asks $ filesPath . config
-            let fPath = path </> B.unpack (B64.encode senderId)
+            let fPath = path </> B.unpack (B64.encode $ unEntityId senderId)
             receiveChunk (XFTPRcvChunkSpec fPath size digest) >>= \case
               Right () -> do
                 stats <- asks serverStats
                 withFileLog $ \sl -> logPutFile sl senderId fPath
                 atomically $ writeTVar filePath (Just fPath)
-                atomically $ modifyTVar' (filesUploaded stats) (+ 1)
-                atomically $ modifyTVar' (filesCount stats) (+ 1)
-                atomically $ modifyTVar' (filesSize stats) (+ fromIntegral size)
+                incFileStat filesUploaded
+                incFileStat filesCount
+                liftIO $ atomicModifyIORef'_ (filesSize stats) (+ fromIntegral size)
                 pure FROk
               Left e -> do
                 us <- asks $ usedStorage . store
-                atomically . modifyTVar' us $ subtract (fromIntegral size)
+                atomically $ modifyTVar' us $ subtract (fromIntegral size)
                 liftIO $ whenM (doesFileExist fPath) (removeFile fPath) `catch` logFileError
                 pure $ FRErr e
           receiveChunk spec = do
@@ -493,8 +496,8 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
               case LC.cbInit dhSecret cbNonce of
                 Right sbState -> do
                   stats <- asks serverStats
-                  atomically $ modifyTVar' (fileDownloads stats) (+ 1)
-                  atomically $ updatePeriodStats (filesDownloaded stats) senderId
+                  incFileStat fileDownloads
+                  liftIO $ updatePeriodStats (filesDownloaded stats) senderId
                   pure (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
                 _ -> pure (FRErr INTERNAL, Nothing)
         _ -> pure (FRErr NO_FILE, Nothing)
@@ -510,8 +513,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
       withFileLog (`logAckFile` rId)
       st <- asks store
       atomically $ deleteRecipient st rId fr
-      stats <- asks serverStats
-      atomically $ modifyTVar' (fileDownloadAcks stats) (+ 1)
+      incFileStat fileDownloadAcks
       pure FROk
 
 deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
@@ -523,11 +525,11 @@ deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
     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)
+    lift $ incFileStat filesDeleted
   where
     deletedStats stats = do
-      atomically $ modifyTVar' (filesCount stats) (subtract 1)
-      atomically $ modifyTVar' (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
+      liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
+      liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
 
 expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
 expireServerFiles itemDelay expCfg = do
@@ -553,29 +555,26 @@ expireServerFiles itemDelay expCfg = do
     delete st sId = do
       withFileLog (`logDeleteFile` sId)
       void . atomically $ deleteFile st sId -- will not update usedStorage if sId isn't in store
-      FileServerStats {filesExpired} <- asks serverStats
-      atomically $ modifyTVar' filesExpired (+ 1)
+      incFileStat filesExpired
 
 randomId :: Int -> M ByteString
 randomId n = atomically . C.randomBytes n =<< asks random
 
 getFileId :: M XFTPFileId
-getFileId = do
-  size <- asks (fileIdSize . config)
-  atomically . C.randomBytes size =<< asks random
+getFileId = fmap EntityId . randomId =<< asks (fileIdSize . config)
 
 withFileLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog
 
-incFileStat :: (FileServerStats -> TVar Int) -> M ()
+incFileStat :: (FileServerStats -> IORef Int) -> M ()
 incFileStat statSel = do
   stats <- asks serverStats
-  atomically $ modifyTVar (statSel stats) (+ 1)
+  liftIO $ atomicModifyIORef'_ (statSel stats) (+ 1)
 
 saveServerStats :: M ()
 saveServerStats =
   asks (serverStatsBackupFile . config)
-    >>= mapM_ (\f -> asks serverStats >>= atomically . getFileServerStatsData >>= liftIO . saveStats f)
+    >>= mapM_ (\f -> asks serverStats >>= liftIO . getFileServerStatsData >>= liftIO . saveStats f)
   where
     saveStats f stats = do
       logInfo $ "saving server stats to file " <> T.pack f
@@ -593,7 +592,7 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
           FileStore {files, usedStorage} <- asks store
           _filesCount <- M.size <$> readTVarIO files
           _filesSize <- readTVarIO usedStorage
-          atomically $ setFileServerStats s d {_filesCount, _filesSize}
+          liftIO $ 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

src/Simplex/FileTransfer/Server/Control.hs

@@ -4,7 +4,7 @@
 module Simplex.FileTransfer.Server.Control where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.ByteString (ByteString)
+import Simplex.FileTransfer.Protocol (XFTPFileId)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
 
@@ -13,7 +13,7 @@ data CPClientRole = CPRNone | CPRUser | CPRAdmin
 data ControlProtocol
   = CPAuth BasicAuth
   | CPStatsRTS
-  | CPDelete ByteString
+  | CPDelete XFTPFileId
   | CPHelp
   | CPQuit
   | CPSkip

src/Simplex/FileTransfer/Server/Env.hs

@@ -11,7 +11,6 @@ module Simplex.FileTransfer.Server.Env where
 
 import Control.Logger.Simple
 import Control.Monad
-import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
@@ -105,17 +104,17 @@ supportedXFTPhandshakes = ["xftp/1"]
 
 newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
 newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, caCertificateFile, certificateFile, privateKeyFile, transportConfig} = do
-  random <- liftIO C.newRandom
-  store <- atomically newFileStore
-  storeLog <- liftIO $ mapM (`readWriteFileStore` store) storeLogFile
+  random <- C.newRandom
+  store <- newFileStore
+  storeLog <- mapM (`readWriteFileStore` store) storeLogFile
   used <- countUsedStorage <$> readTVarIO (files store)
   atomically $ writeTVar (usedStorage store) used
   forM_ fileSizeQuota $ \quota -> do
     logInfo $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
     when (quota < used) $ logInfo "WARNING: storage quota is less than used storage, no files can be uploaded!"
-  tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
-  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
-  serverStats <- atomically . newFileServerStats =<< liftIO getCurrentTime
+  tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile (alpn transportConfig)
+  Fingerprint fp <- loadFingerprint caCertificateFile
+  serverStats <- newFileServerStats =<< getCurrentTime
   pure XFTPEnv {config, store, storeLog, random, tlsServerParams, serverIdentity = C.KeyHash fp, serverStats}
 
 countUsedStorage :: M.Map k FileRec -> Int64

src/Simplex/FileTransfer/Server/Stats.hs

@@ -7,25 +7,24 @@ 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.IORef
 import Data.Int (Int64)
 import Data.Time.Clock (UTCTime)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (SenderId)
 import Simplex.Messaging.Server.Stats (PeriodStats, PeriodStatsData, getPeriodStatsData, newPeriodStats, setPeriodStats)
-import UnliftIO.STM
 
 data FileServerStats = FileServerStats
-  { fromTime :: TVar UTCTime,
-    filesCreated :: TVar Int,
-    fileRecipients :: TVar Int,
-    filesUploaded :: TVar Int,
-    filesExpired :: TVar Int,
-    filesDeleted :: TVar Int,
-    filesDownloaded :: PeriodStats SenderId,
-    fileDownloads :: TVar Int,
-    fileDownloadAcks :: TVar Int,
-    filesCount :: TVar Int,
-    filesSize :: TVar Int64
+  { fromTime :: IORef UTCTime,
+    filesCreated :: IORef Int,
+    fileRecipients :: IORef Int,
+    filesUploaded :: IORef Int,
+    filesExpired :: IORef Int,
+    filesDeleted :: IORef Int,
+    filesDownloaded :: PeriodStats,
+    fileDownloads :: IORef Int,
+    fileDownloadAcks :: IORef Int,
+    filesCount :: IORef Int,
+    filesSize :: IORef Int64
   }
 
 data FileServerStatsData = FileServerStatsData
@@ -35,7 +34,7 @@ data FileServerStatsData = FileServerStatsData
     _filesUploaded :: Int,
     _filesExpired :: Int,
     _filesDeleted :: Int,
-    _filesDownloaded :: PeriodStatsData SenderId,
+    _filesDownloaded :: PeriodStatsData,
     _fileDownloads :: Int,
     _fileDownloadAcks :: Int,
     _filesCount :: Int,
@@ -43,49 +42,50 @@ data FileServerStatsData = FileServerStatsData
   }
   deriving (Show)
 
-newFileServerStats :: UTCTime -> STM FileServerStats
+newFileServerStats :: UTCTime -> IO FileServerStats
 newFileServerStats ts = do
-  fromTime <- newTVar ts
-  filesCreated <- newTVar 0
-  fileRecipients <- newTVar 0
-  filesUploaded <- newTVar 0
-  filesExpired <- newTVar 0
-  filesDeleted <- newTVar 0
+  fromTime <- newIORef ts
+  filesCreated <- newIORef 0
+  fileRecipients <- newIORef 0
+  filesUploaded <- newIORef 0
+  filesExpired <- newIORef 0
+  filesDeleted <- newIORef 0
   filesDownloaded <- newPeriodStats
-  fileDownloads <- newTVar 0
-  fileDownloadAcks <- newTVar 0
-  filesCount <- newTVar 0
-  filesSize <- newTVar 0
+  fileDownloads <- newIORef 0
+  fileDownloadAcks <- newIORef 0
+  filesCount <- newIORef 0
+  filesSize <- newIORef 0
   pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
 
-getFileServerStatsData :: FileServerStats -> STM FileServerStatsData
+getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
 getFileServerStatsData s = do
-  _fromTime <- readTVar $ fromTime (s :: FileServerStats)
-  _filesCreated <- readTVar $ filesCreated s
-  _fileRecipients <- readTVar $ fileRecipients s
-  _filesUploaded <- readTVar $ filesUploaded s
-  _filesExpired <- readTVar $ filesExpired s
-  _filesDeleted <- readTVar $ filesDeleted s
+  _fromTime <- readIORef $ fromTime (s :: FileServerStats)
+  _filesCreated <- readIORef $ filesCreated s
+  _fileRecipients <- readIORef $ fileRecipients s
+  _filesUploaded <- readIORef $ filesUploaded s
+  _filesExpired <- readIORef $ filesExpired s
+  _filesDeleted <- readIORef $ filesDeleted s
   _filesDownloaded <- getPeriodStatsData $ filesDownloaded s
-  _fileDownloads <- readTVar $ fileDownloads s
-  _fileDownloadAcks <- readTVar $ fileDownloadAcks s
-  _filesCount <- readTVar $ filesCount s
-  _filesSize <- readTVar $ filesSize s
+  _fileDownloads <- readIORef $ fileDownloads s
+  _fileDownloadAcks <- readIORef $ fileDownloadAcks s
+  _filesCount <- readIORef $ filesCount s
+  _filesSize <- readIORef $ filesSize s
   pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
 
-setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
+-- this function is not thread safe, it is used on server start only
+setFileServerStats :: FileServerStats -> FileServerStatsData -> IO ()
 setFileServerStats s d = do
-  writeTVar (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
-  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
+  writeIORef (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
+  writeIORef (filesCreated s) $! _filesCreated d
+  writeIORef (fileRecipients s) $! _fileRecipients d
+  writeIORef (filesUploaded s) $! _filesUploaded d
+  writeIORef (filesExpired s) $! _filesExpired d
+  writeIORef (filesDeleted s) $! _filesDeleted d
   setPeriodStats (filesDownloaded s) $! _filesDownloaded d
-  writeTVar (fileDownloads s) $! _fileDownloads d
-  writeTVar (fileDownloadAcks s) $! _fileDownloadAcks d
-  writeTVar (filesCount s) $! _filesCount d
-  writeTVar (filesSize s) $! _filesSize d
+  writeIORef (fileDownloads s) $! _fileDownloads d
+  writeIORef (fileDownloadAcks s) $! _fileDownloadAcks d
+  writeIORef (filesCount s) $! _filesCount d
+  writeIORef (filesSize s) $! _filesSize d
 
 instance StrEncoding FileServerStatsData where
   strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =

src/Simplex/FileTransfer/Server/Store.hs

@@ -55,11 +55,11 @@ instance StrEncoding FileRecipient where
   strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
   strP = FileRecipient <$> strP <* A.char ':' <*> strP
 
-newFileStore :: STM FileStore
+newFileStore :: IO FileStore
 newFileStore = do
-  files <- TM.empty
-  recipients <- TM.empty
-  usedStorage <- newTVar 0
+  files <- TM.emptyIO
+  recipients <- TM.emptyIO
+  usedStorage <- newTVarIO 0
   pure FileStore {files, recipients, usedStorage}
 
 addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ())

src/Simplex/FileTransfer/Transport.hs

@@ -194,7 +194,7 @@ receiveFile_ :: (Handle -> Word32 -> IO (Either XFTPErrorType ())) -> XFTPRcvChu
 receiveFile_ receive XFTPRcvChunkSpec {filePath, chunkSize, chunkDigest} = do
   ExceptT $ withFile filePath WriteMode (`receive` chunkSize)
   digest' <- liftIO $ LC.sha256Hash <$> LB.readFile filePath
-  when (digest' /= chunkDigest) $ throwError DIGEST
+  when (digest' /= chunkDigest) $ throwE DIGEST
 
 data XFTPErrorType
   = -- | incorrect block format, encoding or signature size
@@ -223,10 +223,6 @@ data XFTPErrorType
     FILE_IO
   | -- | file sending or receiving timeout
     TIMEOUT
-  | -- | bad redirect data
-    REDIRECT {redirectError :: String}
-  | -- | cannot proceed with download from not approved relays without proxy
-    NOT_APPROVED
   | -- | internal server error
     INTERNAL
   | -- | used internally, never returned by the server (to be removed)
@@ -236,11 +232,9 @@ data XFTPErrorType
 instance StrEncoding XFTPErrorType where
   strEncode = \case
     CMD e -> "CMD " <> bshow e
-    REDIRECT e -> "REDIRECT " <> bshow e
     e -> bshow e
   strP =
     "CMD " *> (CMD <$> parseRead1)
-      <|> "REDIRECT " *> (REDIRECT <$> parseRead A.takeByteString)
       <|> parseRead1
 
 instance Encoding XFTPErrorType where
@@ -258,8 +252,6 @@ instance Encoding XFTPErrorType where
     HAS_FILE -> "HAS_FILE"
     FILE_IO -> "FILE_IO"
     TIMEOUT -> "TIMEOUT"
-    REDIRECT err -> "REDIRECT " <> smpEncode err
-    NOT_APPROVED -> "NOT_APPROVED"
     INTERNAL -> "INTERNAL"
     DUPLICATE_ -> "DUPLICATE_"
 
@@ -278,8 +270,6 @@ instance Encoding XFTPErrorType where
       "HAS_FILE" -> pure HAS_FILE
       "FILE_IO" -> pure FILE_IO
       "TIMEOUT" -> pure TIMEOUT
-      "REDIRECT" -> REDIRECT <$> _smpP
-      "NOT_APPROVED" -> pure NOT_APPROVED
       "INTERNAL" -> pure INTERNAL
       "DUPLICATE_" -> pure DUPLICATE_
       _ -> fail "bad error type"

src/Simplex/FileTransfer/Types.hs

@@ -2,24 +2,33 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Simplex.FileTransfer.Types where
 
+import qualified Data.Aeson.TH as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
 import Data.Word (Word32)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Description
-import Simplex.Messaging.Agent.Protocol (RcvFileId, SndFileId)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (fromTextField_)
-import Simplex.Messaging.Protocol
+import Simplex.Messaging.Parsers
+import Simplex.Messaging.Protocol (XFTPServer)
 import System.FilePath ((</>))
 
+type RcvFileId = ByteString -- Agent entity ID
+
+type SndFileId = ByteString -- Agent entity ID
+
 authTagSize :: Int64
 authTagSize = fromIntegral C.authTagSize
 
@@ -236,3 +245,35 @@ data DeletedSndChunkReplica = DeletedSndChunkReplica
     retries :: Int
   }
   deriving (Show)
+
+data FileErrorType
+  = -- | cannot proceed with download from not approved relays without proxy
+    NOT_APPROVED
+  | -- | max file size exceeded
+    SIZE
+  | -- | bad redirect data
+    REDIRECT {redirectError :: String}
+  | -- | file crypto error
+    FILE_IO {fileIOError :: String}
+  | -- | file not found or was deleted
+    NO_FILE
+  deriving (Eq, Show)
+
+instance StrEncoding FileErrorType where
+  strP =
+    A.takeTill (== ' ')
+      >>= \case
+        "NOT_APPROVED" -> pure NOT_APPROVED
+        "SIZE" -> pure SIZE
+        "REDIRECT" -> REDIRECT <$> (A.space *> textP)
+        "FILE_IO" -> FILE_IO <$> (A.space *> textP)
+        "NO_FILE" -> pure NO_FILE
+        _ -> fail "bad FileErrorType"
+  strEncode = \case
+    NOT_APPROVED -> "NOT_APPROVED"
+    SIZE -> "SIZE"
+    REDIRECT e -> "REDIRECT " <> encodeUtf8 (T.pack e)
+    FILE_IO e -> "FILE_IO " <> encodeUtf8 (T.pack e)
+    NO_FILE -> "NO_FILE"
+
+$(J.deriveJSON (sumTypeJSON id) ''FileErrorType)

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

@@ -7,6 +7,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
@@ -15,7 +16,12 @@ module Simplex.Messaging.Agent.Env.SQLite
     AM,
     AgentConfig (..),
     InitialAgentServers (..),
+    ServerCfg (..),
+    UserServers (..),
     NetworkConfig (..),
+    presetServerCfg,
+    enabledServerCfg,
+    mkUserServers,
     defaultAgentConfig,
     defaultReconnectInterval,
     tryAgentError,
@@ -35,14 +41,19 @@ module Simplex.Messaging.Agent.Env.SQLite
   )
 where
 
+import Control.Concurrent (ThreadId)
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson.TH as JQ
 import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
-import Data.Map (Map)
+import qualified Data.List.NonEmpty as L
+import Data.Map.Strict (Map)
+import Data.Maybe (fromMaybe)
 import Data.Time.Clock (NominalDiffTime, nominalDay)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16)
@@ -59,14 +70,16 @@ import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRa
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
 import Simplex.Messaging.Notifications.Transport (NTFVersion)
 import Simplex.Messaging.Notifications.Types
-import Simplex.Messaging.Protocol (NtfServer, VersionRangeSMPC, XFTPServer, XFTPServerWithAuth, supportedSMPClientVRange)
+import Simplex.Messaging.Parsers (defaultJSON)
+import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth, ProtocolServer, ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPVersion, TLS, Transport (..))
 import Simplex.Messaging.Transport.Client (defaultSMPPort)
 import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
+import System.Mem.Weak (Weak)
 import System.Random (StdGen, newStdGen)
-import UnliftIO (Async, SomeException)
+import UnliftIO (SomeException)
 import UnliftIO.STM
 
 type AM' a = ReaderT Env IO a
@@ -74,12 +87,38 @@ type AM' a = ReaderT Env IO a
 type AM a = ExceptT AgentErrorType (ReaderT Env IO) a
 
 data InitialAgentServers = InitialAgentServers
-  { smp :: Map UserId (NonEmpty SMPServerWithAuth),
+  { smp :: Map UserId (NonEmpty (ServerCfg 'PSMP)),
     ntf :: [NtfServer],
-    xftp :: Map UserId (NonEmpty XFTPServerWithAuth),
+    xftp :: Map UserId (NonEmpty (ServerCfg 'PXFTP)),
     netCfg :: NetworkConfig
   }
 
+data ServerCfg p = ServerCfg
+  { server :: ProtoServerWithAuth p,
+    preset :: Bool,
+    tested :: Maybe Bool,
+    enabled :: Bool
+  }
+  deriving (Show)
+
+enabledServerCfg :: ProtoServerWithAuth p -> ServerCfg p
+enabledServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
+
+presetServerCfg :: Bool -> ProtoServerWithAuth p -> ServerCfg p
+presetServerCfg enabled server = ServerCfg {server, preset = True, tested = Nothing, enabled}
+
+data UserServers p = UserServers
+  { enabledSrvs :: NonEmpty (ProtoServerWithAuth p),
+    knownSrvs :: NonEmpty (ProtocolServer p)
+  }
+
+-- This function sets all servers as enabled in case all passed servers are disabled.
+mkUserServers :: NonEmpty (ServerCfg p) -> UserServers p
+mkUserServers srvs = UserServers {enabledSrvs, knownSrvs}
+  where
+    enabledSrvs = L.map (\ServerCfg {server} -> server) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled} -> enabled) srvs
+    knownSrvs = L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> srv) srvs
+
 data AgentConfig = AgentConfig
   { tcpPort :: Maybe ServiceName,
     rcvAuthAlg :: C.AuthAlg,
@@ -100,20 +139,18 @@ data AgentConfig = AgentConfig
     persistErrorInterval :: NominalDiffTime,
     initialCleanupDelay :: Int64,
     cleanupInterval :: Int64,
+    initialLogStatsDelay :: Int64,
+    logStatsInterval :: Int64,
     cleanupStepInterval :: Int,
     maxWorkerRestartsPerMin :: Int,
     storedMsgDataTTL :: NominalDiffTime,
     rcvFilesTTL :: NominalDiffTime,
     sndFilesTTL :: NominalDiffTime,
-    xftpNotifyErrsOnRetry :: Bool,
     xftpConsecutiveRetries :: Int,
     xftpMaxRecipientsPerRequest :: Int,
     deleteErrorCount :: Int,
     ntfCron :: Word16,
-    ntfWorkerDelay :: Int,
-    ntfSMPWorkerDelay :: Int,
     ntfSubCheckInterval :: NominalDiffTime,
-    ntfMaxMessages :: Int,
     caCertificateFile :: FilePath,
     privateKeyFile :: FilePath,
     certificateFile :: FilePath,
@@ -127,7 +164,7 @@ defaultReconnectInterval =
   RetryInterval
     { initialInterval = 2_000000,
       increaseAfter = 10_000000,
-      maxInterval = 60_000000
+      maxInterval = 180_000000
     }
 
 defaultMessageRetryInterval :: RetryInterval2
@@ -137,7 +174,7 @@ defaultMessageRetryInterval =
         RetryInterval
           { initialInterval = 2_000000,
             increaseAfter = 10_000000,
-            maxInterval = 60_000000
+            maxInterval = 120_000000
           },
       riSlow =
         RetryInterval
@@ -171,20 +208,18 @@ defaultAgentConfig =
       persistErrorInterval = 3, -- seconds
       initialCleanupDelay = 30 * 1000000, -- 30 seconds
       cleanupInterval = 30 * 60 * 1000000, -- 30 minutes
+      initialLogStatsDelay = 10 * 1000000, -- 10 seconds
+      logStatsInterval = 10 * 1000000, -- 10 seconds
       cleanupStepInterval = 200000, -- 200ms
       maxWorkerRestartsPerMin = 5,
       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,
       -- CA certificate private key is not needed for initialization
       -- ! we do not generate these
       caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
@@ -209,8 +244,8 @@ newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
 newSMPAgentEnv config store = do
   random <- C.newRandom
   randomServer <- newTVarIO =<< liftIO newStdGen
-  ntfSupervisor <- atomically . newNtfSubSupervisor $ tbqSize config
-  xftpAgent <- atomically newXFTPAgent
+  ntfSupervisor <- newNtfSubSupervisor $ tbqSize config
+  xftpAgent <- newXFTPAgent
   multicastSubscribers <- newTMVarIO 0
   pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}
 
@@ -227,12 +262,12 @@ data NtfSupervisor = NtfSupervisor
 data NtfSupervisorCommand = NSCCreate | NSCDelete | NSCSmpDelete | NSCNtfWorker NtfServer | NSCNtfSMPWorker SMPServer
   deriving (Show)
 
-newNtfSubSupervisor :: Natural -> STM NtfSupervisor
+newNtfSubSupervisor :: Natural -> IO NtfSupervisor
 newNtfSubSupervisor qSize = do
-  ntfTkn <- newTVar Nothing
-  ntfSubQ <- newTBQueue qSize
-  ntfWorkers <- TM.empty
-  ntfSMPWorkers <- TM.empty
+  ntfTkn <- newTVarIO Nothing
+  ntfSubQ <- newTBQueueIO qSize
+  ntfWorkers <- TM.emptyIO
+  ntfSMPWorkers <- TM.emptyIO
   pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers}
 
 data XFTPAgent = XFTPAgent
@@ -243,12 +278,12 @@ data XFTPAgent = XFTPAgent
     xftpDelWorkers :: TMap XFTPServer Worker
   }
 
-newXFTPAgent :: STM XFTPAgent
+newXFTPAgent :: IO XFTPAgent
 newXFTPAgent = do
-  xftpWorkDir <- newTVar Nothing
-  xftpRcvWorkers <- TM.empty
-  xftpSndWorkers <- TM.empty
-  xftpDelWorkers <- TM.empty
+  xftpWorkDir <- newTVarIO Nothing
+  xftpRcvWorkers <- TM.emptyIO
+  xftpSndWorkers <- TM.emptyIO
+  xftpDelWorkers <- TM.emptyIO
   pure XFTPAgent {xftpWorkDir, xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}
 
 tryAgentError :: AM a -> AM (Either AgentErrorType a)
@@ -279,7 +314,7 @@ mkInternal = INTERNAL . show
 data Worker = Worker
   { workerId :: Int,
     doWork :: TMVar (),
-    action :: TMVar (Maybe (Async ())),
+    action :: TMVar (Maybe (Weak ThreadId)),
     restarts :: TVar RestartCount
   }
 
@@ -292,3 +327,12 @@ 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
+
+$(pure [])
+
+instance ProtocolTypeI p => ToJSON (ServerCfg p) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
+  toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
+
+instance ProtocolTypeI p => FromJSON (ServerCfg p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ServerCfg)

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -20,8 +20,8 @@ where
 
 import Control.Logger.Simple (logError, logInfo)
 import Control.Monad
-import Control.Monad.Except
 import Control.Monad.Reader
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
@@ -29,8 +29,9 @@ import Data.Time (UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Clock (diffUTCTime)
 import Simplex.Messaging.Agent.Client
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Protocol (ACommand (..), APartyCmd (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
+import Simplex.Messaging.Agent.Protocol (AEvent (..), AEvt (..), AgentErrorType (..), BrokerErrorType (..), ConnId, NotificationsMode (..), SAEntity (..))
 import Simplex.Messaging.Agent.RetryInterval
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
@@ -40,7 +41,7 @@ import Simplex.Messaging.Protocol (NtfServer, SMPServer, sameSrvAddr)
 import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow, unlessM)
 import System.Random (randomR)
 import UnliftIO
-import UnliftIO.Concurrent (forkIO, threadDelay)
+import UnliftIO.Concurrent (forkIO)
 import qualified UnliftIO.Exception as E
 
 runNtfSupervisor :: AgentClient -> AM' ()
@@ -64,7 +65,7 @@ processNtfSub c (connId, cmd) = do
   logInfo $ "processNtfSub - connId = " <> tshow connId <> " - cmd = " <> tshow cmd
   case cmd of
     NSCCreate -> do
-      (a, RcvQueue {server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
+      (a, RcvQueue {userId, server = smpServer, clientNtfCreds}) <- withStore c $ \db -> runExceptT $ do
         a <- liftIO $ getNtfSubscription db connId
         q <- ExceptT $ getPrimaryRcvQueue db connId
         pure (a, q)
@@ -74,12 +75,12 @@ processNtfSub c (connId, cmd) = do
           withTokenServer $ \ntfServer -> do
             case clientNtfCreds of
               Just ClientNtfCreds {notifierId} -> do
-                let newSub = newNtfSubscription connId smpServer (Just notifierId) ntfServer NASKey
-                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubNTFAction NSACreate
+                let newSub = newNtfSubscription userId connId smpServer (Just notifierId) ntfServer NASKey
+                withStore c $ \db -> createNtfSubscription db newSub $ NSANtf NSACreate
                 lift . void $ getNtfNTFWorker True c ntfServer
               Nothing -> do
-                let newSub = newNtfSubscription connId smpServer Nothing ntfServer NASNew
-                withStore c $ \db -> createNtfSubscription db newSub $ NtfSubSMPAction NSASmpKey
+                let newSub = newNtfSubscription userId connId smpServer Nothing ntfServer NASNew
+                withStore c $ \db -> createNtfSubscription db newSub $ NSASMP NSASmpKey
                 lift . void $ getNtfSMPWorker True c smpServer
         (Just (sub@NtfSubscription {ntfSubStatus, ntfServer = subNtfServer, smpServer = smpServer', ntfQueueId}, action_)) -> do
           case (clientNtfCreds, ntfQueueId) of
@@ -99,24 +100,24 @@ processNtfSub c (connId, cmd) = do
                     if ntfSubStatus == NASNew || ntfSubStatus == NASOff || ntfSubStatus == NASDeleted
                       then resetSubscription
                       else withTokenServer $ \ntfServer -> do
-                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NtfSubNTFAction NSACreate)
+                        withStore' c $ \db -> supervisorUpdateNtfSub db sub {ntfServer} (NSANtf NSACreate)
                         lift . void $ getNtfNTFWorker True c ntfServer
                 | otherwise -> case action of
-                    NtfSubNTFAction _ -> lift . void $ getNtfNTFWorker True c subNtfServer
-                    NtfSubSMPAction _ -> lift . void $ getNtfSMPWorker True c smpServer
+                    NSANtf _ -> lift . void $ getNtfNTFWorker True c subNtfServer
+                    NSASMP _ -> lift . void $ getNtfSMPWorker True c smpServer
             rotate :: AM ()
             rotate = do
-              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NtfSubNTFAction NSARotate)
+              withStore' c $ \db -> supervisorUpdateNtfSub db sub (NSANtf NSARotate)
               lift . void $ getNtfNTFWorker True c subNtfServer
             resetSubscription :: AM ()
             resetSubscription =
               withTokenServer $ \ntfServer -> do
                 let sub' = sub {ntfQueueId = Nothing, ntfServer, ntfSubId = Nothing, ntfSubStatus = NASNew}
-                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NtfSubSMPAction NSASmpKey)
+                withStore' c $ \db -> supervisorUpdateNtfSub db sub' (NSASMP NSASmpKey)
                 lift . void $ getNtfSMPWorker True c smpServer
     NSCDelete -> do
       sub_ <- withStore' c $ \db -> do
-        supervisorUpdateNtfAction db connId (NtfSubNTFAction NSADelete)
+        supervisorUpdateNtfAction db connId (NSANtf NSADelete)
         getNtfSubscription db connId
       logInfo $ "processNtfSub, NSCDelete - sub_ = " <> tshow sub_
       case sub_ of
@@ -126,7 +127,7 @@ processNtfSub c (connId, cmd) = 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)
+          withStore' c $ \db -> supervisorUpdateNtfAction db connId (NSASMP NSASmpDelete)
           lift . void $ getNtfSMPWorker True c smpServer
         _ -> notifyInternalError c connId "NSCSmpDelete - no rcv queue"
     NSCNtfWorker ntfServer -> lift . void $ getNtfNTFWorker True c ntfServer
@@ -146,12 +147,10 @@ withTokenServer :: (NtfServer -> AM ()) -> AM ()
 withTokenServer action = lift getNtfToken >>= mapM_ (\NtfToken {ntfServer} -> action ntfServer)
 
 runNtfWorker :: AgentClient -> NtfServer -> Worker -> AM ()
-runNtfWorker c srv Worker {doWork} = do
-  delay <- asks $ ntfWorkerDelay . config
+runNtfWorker c srv Worker {doWork} =
   forever $ do
     waitForWork doWork
     ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
-    threadDelay delay
   where
     runNtfOperation :: AM ()
     runNtfOperation =
@@ -160,70 +159,73 @@ runNtfWorker c srv Worker {doWork} = do
           logInfo $ "runNtfWorker, nextSub " <> tshow nextSub
           ri <- asks $ reconnectInterval . config
           withRetryInterval ri $ \_ loop -> do
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             processSub nextSub
               `catchAgentError` retryOnError c "NtfWorker" loop (workerInternalError c connId . show)
     processSub :: (NtfSubscription, NtfSubNTFAction, NtfActionTs) -> AM ()
-    processSub (sub@NtfSubscription {connId, smpServer, ntfSubId}, action, actionTs) = do
+    processSub (sub@NtfSubscription {userId, connId, smpServer, ntfSubId}, action, actionTs) = do
       ts <- liftIO getCurrentTime
       unlessM (lift $ rescheduleAction doWork ts actionTs) $
         case action of
           NSACreate ->
             lift getNtfToken >>= \case
-              Just tkn@NtfToken {ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
+              Just tkn@NtfToken {ntfServer, ntfTokenId = Just tknId, ntfTknStatus = NTActive, ntfMode = NMInstant} -> do
                 RcvQueue {clientNtfCreds} <- withStore c (`getPrimaryRcvQueue` connId)
                 case clientNtfCreds of
                   Just ClientNtfCreds {ntfPrivateKey, notifierId} -> do
+                    atomically $ incNtfServerStat c userId ntfServer ntfCreateAttempts
                     nSubId <- agentNtfCreateSubscription c tknId tkn (SMPQueueNtf smpServer notifierId) ntfPrivateKey
+                    atomically $ incNtfServerStat c userId ntfServer ntfCreated
                     -- possible improvement: smaller retry until Active, less frequently (daily?) once Active
                     let actionTs' = addUTCTime 30 ts
                     withStore' c $ \db ->
-                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NtfSubNTFAction NSACheck) actionTs'
+                      updateNtfSubscription db sub {ntfSubId = Just nSubId, ntfSubStatus = NASCreated NSNew} (NSANtf NSACheck) actionTs'
                   _ -> workerInternalError c connId "NSACreate - no notifier queue credentials"
               _ -> workerInternalError c connId "NSACreate - no active token"
           NSACheck ->
             lift getNtfToken >>= \case
-              Just tkn ->
+              Just tkn@NtfToken {ntfServer} ->
                 case ntfSubId of
-                  Just nSubId ->
+                  Just nSubId -> do
+                    atomically $ incNtfServerStat c userId ntfServer ntfCheckAttempts
                     agentNtfCheckSubscription c nSubId tkn >>= \case
                       NSAuth -> do
-                        lift (getNtfServer c) >>= \case
-                          Just ntfServer -> do
-                            withStore' c $ \db ->
-                              updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NtfSubSMPAction NSASmpKey) ts
-                            ns <- asks ntfSupervisor
-                            atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
-                          _ -> workerInternalError c connId "NSACheck - failed to reset subscription, notification server not configured"
+                        withStore' c $ \db ->
+                          updateNtfSubscription db sub {ntfServer, ntfQueueId = Nothing, ntfSubId = Nothing, ntfSubStatus = NASNew} (NSASMP NSASmpKey) ts
+                        ns <- asks ntfSupervisor
+                        atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
                       status -> updateSubNextCheck ts status
+                    atomically $ incNtfServerStat c userId ntfServer ntfChecked
                   Nothing -> workerInternalError c connId "NSACheck - no subscription ID"
               _ -> workerInternalError c connId "NSACheck - no active token"
-          NSADelete -> case ntfSubId of
-            Just nSubId ->
-              (lift getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
-                `agentFinally` continueDeletion
-            _ -> continueDeletion
-            where
-              continueDeletion = do
-                let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
-                withStore' c $ \db -> updateNtfSubscription db sub' (NtfSubSMPAction NSASmpDelete) ts
-                ns <- asks ntfSupervisor
-                atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
-          NSARotate -> case ntfSubId of
-            Just nSubId ->
-              (lift getNtfToken >>= mapM_ (agentNtfDeleteSubscription c nSubId))
-                `agentFinally` deleteCreate
-            _ -> deleteCreate
-            where
-              deleteCreate = do
-                withStore' c $ \db -> deleteNtfSubscription db connId
-                ns <- asks ntfSupervisor
-                atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
+          NSADelete ->
+            deleteNtfSub $ do
+              let sub' = sub {ntfSubId = Nothing, ntfSubStatus = NASOff}
+              withStore' c $ \db -> updateNtfSubscription db sub' (NSASMP NSASmpDelete) ts
+              ns <- asks ntfSupervisor
+              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCNtfSMPWorker smpServer)
+          NSARotate ->
+            deleteNtfSub $ do
+              withStore' c $ \db -> deleteNtfSubscription db connId
+              ns <- asks ntfSupervisor
+              atomically $ writeTBQueue (ntfSubQ ns) (connId, NSCCreate)
       where
+        deleteNtfSub continue = case ntfSubId of
+          Just nSubId ->
+            lift getNtfToken >>= \case
+              Just tkn@NtfToken {ntfServer} -> do
+                atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
+                tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
+                  Left e | temporaryOrHostError e -> throwE e
+                  _ -> continue
+                atomically $ incNtfServerStat c userId ntfServer ntfDeleted
+              Nothing -> continue
+          _ -> continue
         updateSubNextCheck ts toStatus = do
           checkInterval <- asks $ ntfSubCheckInterval . config
           let nextCheckTs = addUTCTime checkInterval ts
-          updateSub (NASCreated toStatus) (NtfSubNTFAction NSACheck) nextCheckTs
+          updateSub (NASCreated toStatus) (NSANtf NSACheck) nextCheckTs
         updateSub toStatus toAction actionTs' =
           withStore' c $ \db ->
             updateNtfSubscription db sub {ntfSubStatus = toStatus} toAction actionTs'
@@ -231,12 +233,10 @@ runNtfWorker c srv Worker {doWork} = do
 runNtfSMPWorker :: AgentClient -> SMPServer -> Worker -> AM ()
 runNtfSMPWorker c srv Worker {doWork} = do
   env <- ask
-  delay <- asks $ ntfSMPWorkerDelay . config
   forever $ do
     waitForWork doWork
     ExceptT . liftIO . agentOperationBracket c AONtfNetwork throwWhenInactive $
       runReaderT (runExceptT runNtfSMPOperation) env
-    threadDelay delay
   where
     runNtfSMPOperation =
       withWork c doWork (`getNextNtfSubSMPAction` srv) $
@@ -244,6 +244,7 @@ runNtfSMPWorker c srv Worker {doWork} = do
           logInfo $ "runNtfSMPWorker, nextSub " <> tshow nextSub
           ri <- asks $ reconnectInterval . config
           withRetryInterval ri $ \_ loop -> do
+            liftIO $ waitWhileSuspended c
             liftIO $ waitForUserNetwork c
             processSub nextSub
               `catchAgentError` retryOnError c "NtfSMPWorker" loop (workerInternalError c connId . show)
@@ -264,11 +265,12 @@ runNtfSMPWorker c srv Worker {doWork} = do
                 let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
                 withStore' c $ \db -> do
                   setRcvQueueNtfCreds db connId $ Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
-                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NtfSubNTFAction NSACreate) ts
+                  updateNtfSubscription db sub {ntfQueueId = Just notifierId, ntfSubStatus = NASKey} (NSANtf NSACreate) ts
                 ns <- asks ntfSupervisor
                 atomically $ sendNtfSubCommand ns (connId, NSCNtfWorker ntfServer)
               _ -> workerInternalError c connId "NSASmpKey - no active token"
           NSASmpDelete -> do
+            -- TODO should we remove it after successful removal from the server?
             rq_ <- withStore' c $ \db -> do
               setRcvQueueNtfCreds db connId Nothing
               getPrimaryRcvQueue db connId
@@ -295,7 +297,7 @@ retryOnError c name loop done e = do
   where
     retryLoop = do
       atomically $ endAgentOperation c AONtfNetwork
-      atomically $ throwWhenInactive c
+      liftIO $ throwWhenInactive c
       atomically $ beginAgentOperation c AONtfNetwork
       loop
 
@@ -306,7 +308,7 @@ workerInternalError c connId internalErrStr = do
 
 -- TODO change error
 notifyInternalError :: MonadIO m => AgentClient -> ConnId -> String -> m ()
-notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, APC SAEConn $ ERR $ INTERNAL internalErrStr)
+notifyInternalError AgentClient {subQ} connId internalErrStr = atomically $ writeTBQueue subQ ("", connId, AEvt SAEConn $ ERR $ INTERNAL internalErrStr)
 {-# INLINE notifyInternalError #-}
 
 getNtfToken :: AM' (Maybe NtfToken)

src/Simplex/Messaging/Agent/QueryString.hs

@@ -24,9 +24,12 @@ instance StrEncoding QueryStringParams where
   strP = QSP QEscape . Q.parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
 
 queryParam :: StrEncoding a => ByteString -> QueryStringParams -> Parser a
-queryParam name q =
+queryParam = queryParamParser strP
+
+queryParamParser :: Parser a -> ByteString -> QueryStringParams -> Parser a
+queryParamParser p name q =
   case queryParamStr name q of
-    Just p -> either fail pure $ parseAll strP p
+    Just s -> either fail pure $ parseAll p s
     _ -> fail $ "no qs param " <> B.unpack name
 
 queryParam_ :: StrEncoding a => ByteString -> QueryStringParams -> Parser (Maybe a)

src/Simplex/Messaging/Agent/RetryInterval.hs

@@ -9,6 +9,7 @@ module Simplex.Messaging.Agent.RetryInterval
     RI2State (..),
     withRetryInterval,
     withRetryIntervalCount,
+    withRetryForeground,
     withRetryLock2,
     updateRetryInterval2,
     nextRetryDelay,
@@ -16,10 +17,11 @@ module Simplex.Messaging.Agent.RetryInterval
 where
 
 import Control.Concurrent (forkIO)
+import Control.Concurrent.STM (retry)
 import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Int (Int64)
-import Simplex.Messaging.Util (threadDelay', whenM)
+import Simplex.Messaging.Util (threadDelay', unlessM, whenM)
 import UnliftIO.STM
 
 data RetryInterval = RetryInterval
@@ -63,6 +65,27 @@ withRetryIntervalCount ri action = callAction 0 0 $ initialInterval ri
           let elapsed' = elapsed + delay
           callAction (n + 1) elapsed' $ nextRetryDelay elapsed' delay ri
 
+withRetryForeground :: forall m a. MonadIO m => RetryInterval -> STM Bool -> STM Bool -> (Int64 -> m a -> m a) -> m a
+withRetryForeground ri isForeground isOnline action = callAction 0 $ initialInterval ri
+  where
+    callAction :: Int64 -> Int64 -> m a
+    callAction elapsed delay = action delay loop
+      where
+        loop = do
+          -- limit delay to max Int value (~36 minutes on for 32 bit architectures)
+          d <- registerDelay $ fromIntegral $ min delay (fromIntegral (maxBound :: Int))
+          (wasForeground, wasOnline) <- atomically $ (,) <$> isForeground <*> isOnline
+          reset <- atomically $ do
+            foreground <- isForeground
+            online <- isOnline
+            let reset = (not wasForeground && foreground) || (not wasOnline && online)
+            unlessM ((reset ||) <$> readTVar d) retry
+            pure reset
+          let (elapsed', delay')
+                | reset = (0, initialInterval ri)
+                | otherwise = (elapsed + delay, nextRetryDelay elapsed' delay ri)
+          callAction elapsed' delay'
+
 -- This function allows action to toggle between slow and fast retry intervals.
 withRetryLock2 :: forall m. MonadIO m => RetryInterval2 -> TMVar () -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
 withRetryLock2 RetryInterval2 {riSlow, riFast} lock action =

src/Simplex/Messaging/Agent/Server.hs

@@ -1,85 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Simplex.Messaging.Agent.Server
-  ( -- * SMP agent over TCP
-    runSMPAgent,
-    runSMPAgentBlocking,
-  )
-where
-
-import Control.Logger.Simple (logInfo)
-import Control.Monad
-import Control.Monad.Reader
-import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
-import Data.Text.Encoding (decodeUtf8)
-import Network.Socket (ServiceName)
-import Simplex.Messaging.Agent
-import Simplex.Messaging.Agent.Client (newAgentClient)
-import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Agent.Protocol
-import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
-import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), simplexMQVersion)
-import Simplex.Messaging.Transport.Server (defaultTransportServerConfig, loadTLSServerParams, runTransportServer)
-import Simplex.Messaging.Util (bshow)
-import UnliftIO.Async (race_)
-import qualified UnliftIO.Exception as E
-import UnliftIO.STM
-
--- | Runs an SMP agent as a TCP service using passed configuration.
---
--- See a full agent executable here: https://github.com/simplex-chat/simplexmq/blob/master/apps/smp-agent/Main.hs
-runSMPAgent :: ATransport -> AgentConfig -> InitialAgentServers -> SQLiteStore -> IO ()
-runSMPAgent t cfg initServers store =
-  runSMPAgentBlocking t cfg initServers store 0 =<< newEmptyTMVarIO
-
--- | Runs an SMP agent as a TCP service using passed configuration with signalling.
---
--- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
--- and when it is disconnected from the TCP socket once the server thread is killed (False).
-runSMPAgentBlocking :: ATransport -> AgentConfig -> InitialAgentServers -> SQLiteStore -> Int -> TMVar Bool -> IO ()
-runSMPAgentBlocking (ATransport t) cfg@AgentConfig {tcpPort, caCertificateFile, certificateFile, privateKeyFile} initServers store initClientId started =
-  case tcpPort of
-    Just port -> newSMPAgentEnv cfg store >>= smpAgent t port
-    Nothing -> E.throwIO $ userError "no agent port"
-  where
-    smpAgent :: forall c. Transport c => TProxy c -> ServiceName -> Env -> IO ()
-    smpAgent _ port env = do
-      -- tlsServerParams is not in Env to avoid breaking functional API w/t key and certificate generation
-      tlsServerParams <- loadTLSServerParams caCertificateFile certificateFile privateKeyFile Nothing
-      clientId <- newTVarIO initClientId
-      runTransportServer started port tlsServerParams defaultTransportServerConfig $ \(h :: c) -> do
-        putLn h $ "Welcome to SMP agent v" <> B.pack simplexMQVersion
-        cId <- atomically $ stateTVar clientId $ \i -> (i + 1, i + 1)
-        c <- atomically $ newAgentClient cId initServers env
-        logConnection c True
-        race_ (connectClient h c) (runAgentClient c `runReaderT` env)
-          `E.finally` (disconnectAgentClient c)
-
-connectClient :: Transport c => c -> AgentClient -> IO ()
-connectClient h c = race_ (send h c) (receive h c)
-
-receive :: forall c. Transport c => c -> AgentClient -> IO ()
-receive h c@AgentClient {rcvQ, subQ} = forever $ do
-  (corrId, entId, cmdOrErr) <- tGet SClient h
-  case cmdOrErr of
-    Right cmd -> write rcvQ (corrId, entId, cmd)
-    Left e -> write subQ (corrId, entId, APC SAEConn $ ERR e)
-  where
-    write :: TBQueue (ATransmission p) -> ATransmission p -> IO ()
-    write q t = do
-      logClient c "-->" t
-      atomically $ writeTBQueue q t
-
-send :: Transport c => c -> AgentClient -> IO ()
-send h c@AgentClient {subQ} = forever $ do
-  t <- atomically $ readTBQueue subQ
-  tPut h t
-  logClient c "<--" t
-
-logClient :: AgentClient -> ByteString -> ATransmission a -> IO ()
-logClient AgentClient {clientId} dir (corrId, connId, APC _ cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, connId, B.takeWhile (/= ' ') $ serializeCommand cmd]

src/Simplex/Messaging/Agent/Stats.hs

@@ -0,0 +1,667 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Agent.Stats where
+
+import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..))
+import qualified Data.Aeson.TH as J
+import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
+import Simplex.Messaging.Agent.Protocol (UserId)
+import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
+import Simplex.Messaging.Protocol (SMPServer, XFTPServer, NtfServer)
+import Simplex.Messaging.Util (decodeJSON, encodeJSON)
+import UnliftIO.STM
+
+data AgentSMPServerStats = AgentSMPServerStats
+  { sentDirect :: TVar Int, -- successfully sent messages
+    sentViaProxy :: TVar Int, -- successfully sent messages via proxy
+    sentProxied :: TVar Int, -- successfully sent messages to other destination server via this as proxy
+    sentDirectAttempts :: TVar Int, -- direct sending attempts (min 1 for each sent message)
+    sentViaProxyAttempts :: TVar Int, -- proxy sending attempts
+    sentProxiedAttempts :: TVar Int, -- attempts sending to other destination server via this as proxy
+    sentAuthErrs :: TVar Int, -- send AUTH errors
+    sentQuotaErrs :: TVar Int, -- send QUOTA permanent errors (message expired)
+    sentExpiredErrs :: TVar Int, -- send expired errors
+    sentOtherErrs :: TVar Int, -- other send permanent errors (excluding above)
+    recvMsgs :: TVar Int, -- total messages received
+    recvDuplicates :: TVar Int, -- duplicate messages received
+    recvCryptoErrs :: TVar Int, -- message decryption errors
+    recvErrs :: TVar Int, -- receive errors
+    ackMsgs :: TVar Int, -- total messages acknowledged
+    ackAttempts :: TVar Int, -- acknowledgement attempts
+    ackNoMsgErrs :: TVar Int, -- NO_MSG ack errors
+    ackOtherErrs :: TVar Int, -- other permanent ack errors (temporary accounted for in attempts)
+    -- conn stats are accounted for rcv queue server
+    connCreated :: TVar Int, -- total connections created
+    connSecured :: TVar Int, -- connections secured
+    connCompleted :: TVar Int, -- connections completed
+    connDeleted :: TVar Int, -- total connections deleted
+    connDelAttempts :: TVar Int, -- total connection deletion attempts
+    connDelErrs :: TVar Int, -- permanent connection deletion errors (temporary accounted for in attempts)
+    connSubscribed :: TVar Int, -- total successful subscription
+    connSubAttempts :: TVar Int, -- subscription attempts
+    connSubIgnored :: TVar Int, -- subscription results ignored (client switched to different session or it was not pending)
+    connSubErrs :: TVar Int, -- permanent subscription errors (temporary accounted for in attempts)
+    -- notifications stats
+    ntfKey :: TVar Int,
+    ntfKeyAttempts :: TVar Int,
+    ntfKeyDeleted :: TVar Int,
+    ntfKeyDeleteAttempts :: TVar Int
+  }
+
+data AgentSMPServerStatsData = AgentSMPServerStatsData
+  { _sentDirect :: Int,
+    _sentViaProxy :: Int,
+    _sentProxied :: Int,
+    _sentDirectAttempts :: Int,
+    _sentViaProxyAttempts :: Int,
+    _sentProxiedAttempts :: Int,
+    _sentAuthErrs :: Int,
+    _sentQuotaErrs :: Int,
+    _sentExpiredErrs :: Int,
+    _sentOtherErrs :: Int,
+    _recvMsgs :: Int,
+    _recvDuplicates :: Int,
+    _recvCryptoErrs :: Int,
+    _recvErrs :: Int,
+    _ackMsgs :: Int,
+    _ackAttempts :: Int,
+    _ackNoMsgErrs :: Int,
+    _ackOtherErrs :: Int,
+    _connCreated :: Int,
+    _connSecured :: Int,
+    _connCompleted :: Int,
+    _connDeleted :: Int,
+    _connDelAttempts :: Int,
+    _connDelErrs :: Int,
+    _connSubscribed :: Int,
+    _connSubAttempts :: Int,
+    _connSubIgnored :: Int,
+    _connSubErrs :: Int,
+    _ntfKey :: OptionalInt,
+    _ntfKeyAttempts :: OptionalInt,
+    _ntfKeyDeleted :: OptionalInt,
+    _ntfKeyDeleteAttempts :: OptionalInt
+  }
+  deriving (Show)
+
+newtype OptionalInt = OInt {toInt :: Int}
+  deriving (Num, Show, ToJSON)
+
+newAgentSMPServerStats :: STM AgentSMPServerStats
+newAgentSMPServerStats = do
+  sentDirect <- newTVar 0
+  sentViaProxy <- newTVar 0
+  sentProxied <- newTVar 0
+  sentDirectAttempts <- newTVar 0
+  sentViaProxyAttempts <- newTVar 0
+  sentProxiedAttempts <- newTVar 0
+  sentAuthErrs <- newTVar 0
+  sentQuotaErrs <- newTVar 0
+  sentExpiredErrs <- newTVar 0
+  sentOtherErrs <- newTVar 0
+  recvMsgs <- newTVar 0
+  recvDuplicates <- newTVar 0
+  recvCryptoErrs <- newTVar 0
+  recvErrs <- newTVar 0
+  ackMsgs <- newTVar 0
+  ackAttempts <- newTVar 0
+  ackNoMsgErrs <- newTVar 0
+  ackOtherErrs <- newTVar 0
+  connCreated <- newTVar 0
+  connSecured <- newTVar 0
+  connCompleted <- newTVar 0
+  connDeleted <- newTVar 0
+  connDelAttempts <- newTVar 0
+  connDelErrs <- newTVar 0
+  connSubscribed <- newTVar 0
+  connSubAttempts <- newTVar 0
+  connSubIgnored <- newTVar 0
+  connSubErrs <- newTVar 0
+  ntfKey <- newTVar 0
+  ntfKeyAttempts <- newTVar 0
+  ntfKeyDeleted <- newTVar 0
+  ntfKeyDeleteAttempts <- newTVar 0
+  pure
+    AgentSMPServerStats
+      { sentDirect,
+        sentViaProxy,
+        sentProxied,
+        sentDirectAttempts,
+        sentViaProxyAttempts,
+        sentProxiedAttempts,
+        sentAuthErrs,
+        sentQuotaErrs,
+        sentExpiredErrs,
+        sentOtherErrs,
+        recvMsgs,
+        recvDuplicates,
+        recvCryptoErrs,
+        recvErrs,
+        ackMsgs,
+        ackAttempts,
+        ackNoMsgErrs,
+        ackOtherErrs,
+        connCreated,
+        connSecured,
+        connCompleted,
+        connDeleted,
+        connDelAttempts,
+        connDelErrs,
+        connSubscribed,
+        connSubAttempts,
+        connSubIgnored,
+        connSubErrs,
+        ntfKey,
+        ntfKeyAttempts,
+        ntfKeyDeleted,
+        ntfKeyDeleteAttempts
+      }
+
+newAgentSMPServerStatsData :: AgentSMPServerStatsData
+newAgentSMPServerStatsData =
+  AgentSMPServerStatsData
+    { _sentDirect = 0,
+      _sentViaProxy = 0,
+      _sentProxied = 0,
+      _sentDirectAttempts = 0,
+      _sentViaProxyAttempts = 0,
+      _sentProxiedAttempts = 0,
+      _sentAuthErrs = 0,
+      _sentQuotaErrs = 0,
+      _sentExpiredErrs = 0,
+      _sentOtherErrs = 0,
+      _recvMsgs = 0,
+      _recvDuplicates = 0,
+      _recvCryptoErrs = 0,
+      _recvErrs = 0,
+      _ackMsgs = 0,
+      _ackAttempts = 0,
+      _ackNoMsgErrs = 0,
+      _ackOtherErrs = 0,
+      _connCreated = 0,
+      _connSecured = 0,
+      _connCompleted = 0,
+      _connDeleted = 0,
+      _connDelAttempts = 0,
+      _connDelErrs = 0,
+      _connSubscribed = 0,
+      _connSubAttempts = 0,
+      _connSubIgnored = 0,
+      _connSubErrs = 0,
+      _ntfKey = 0,
+      _ntfKeyAttempts = 0,
+      _ntfKeyDeleted = 0,
+      _ntfKeyDeleteAttempts = 0
+    }
+
+newAgentSMPServerStats' :: AgentSMPServerStatsData -> STM AgentSMPServerStats
+newAgentSMPServerStats' s = do
+  sentDirect <- newTVar $ _sentDirect s
+  sentViaProxy <- newTVar $ _sentViaProxy s
+  sentProxied <- newTVar $ _sentProxied s
+  sentDirectAttempts <- newTVar $ _sentDirectAttempts s
+  sentViaProxyAttempts <- newTVar $ _sentViaProxyAttempts s
+  sentProxiedAttempts <- newTVar $ _sentProxiedAttempts s
+  sentAuthErrs <- newTVar $ _sentAuthErrs s
+  sentQuotaErrs <- newTVar $ _sentQuotaErrs s
+  sentExpiredErrs <- newTVar $ _sentExpiredErrs s
+  sentOtherErrs <- newTVar $ _sentOtherErrs s
+  recvMsgs <- newTVar $ _recvMsgs s
+  recvDuplicates <- newTVar $ _recvDuplicates s
+  recvCryptoErrs <- newTVar $ _recvCryptoErrs s
+  recvErrs <- newTVar $ _recvErrs s
+  ackMsgs <- newTVar $ _ackMsgs s
+  ackAttempts <- newTVar $ _ackAttempts s
+  ackNoMsgErrs <- newTVar $ _ackNoMsgErrs s
+  ackOtherErrs <- newTVar $ _ackOtherErrs s
+  connCreated <- newTVar $ _connCreated s
+  connSecured <- newTVar $ _connSecured s
+  connCompleted <- newTVar $ _connCompleted s
+  connDeleted <- newTVar $ _connDeleted s
+  connDelAttempts <- newTVar $ _connDelAttempts s
+  connDelErrs <- newTVar $ _connDelErrs s
+  connSubscribed <- newTVar $ _connSubscribed s
+  connSubAttempts <- newTVar $ _connSubAttempts s
+  connSubIgnored <- newTVar $ _connSubIgnored s
+  connSubErrs <- newTVar $ _connSubErrs s
+  ntfKey <- newTVar $ toInt $ _ntfKey s
+  ntfKeyAttempts <- newTVar $ toInt $ _ntfKeyAttempts s
+  ntfKeyDeleted <- newTVar $ toInt $ _ntfKeyDeleted s
+  ntfKeyDeleteAttempts <- newTVar $ toInt $ _ntfKeyDeleteAttempts s
+  pure
+    AgentSMPServerStats
+      { sentDirect,
+        sentViaProxy,
+        sentProxied,
+        sentDirectAttempts,
+        sentViaProxyAttempts,
+        sentProxiedAttempts,
+        sentAuthErrs,
+        sentQuotaErrs,
+        sentExpiredErrs,
+        sentOtherErrs,
+        recvMsgs,
+        recvDuplicates,
+        recvCryptoErrs,
+        recvErrs,
+        ackMsgs,
+        ackAttempts,
+        ackNoMsgErrs,
+        ackOtherErrs,
+        connCreated,
+        connSecured,
+        connCompleted,
+        connDeleted,
+        connDelAttempts,
+        connDelErrs,
+        connSubscribed,
+        connSubAttempts,
+        connSubIgnored,
+        connSubErrs,
+        ntfKey,
+        ntfKeyAttempts,
+        ntfKeyDeleted,
+        ntfKeyDeleteAttempts
+      }
+
+-- as this is used to periodically update stats in db,
+-- this is not STM to decrease contention with stats updates
+getAgentSMPServerStats :: AgentSMPServerStats -> IO AgentSMPServerStatsData
+getAgentSMPServerStats s = do
+  _sentDirect <- readTVarIO $ sentDirect s
+  _sentViaProxy <- readTVarIO $ sentViaProxy s
+  _sentProxied <- readTVarIO $ sentProxied s
+  _sentDirectAttempts <- readTVarIO $ sentDirectAttempts s
+  _sentViaProxyAttempts <- readTVarIO $ sentViaProxyAttempts s
+  _sentProxiedAttempts <- readTVarIO $ sentProxiedAttempts s
+  _sentAuthErrs <- readTVarIO $ sentAuthErrs s
+  _sentQuotaErrs <- readTVarIO $ sentQuotaErrs s
+  _sentExpiredErrs <- readTVarIO $ sentExpiredErrs s
+  _sentOtherErrs <- readTVarIO $ sentOtherErrs s
+  _recvMsgs <- readTVarIO $ recvMsgs s
+  _recvDuplicates <- readTVarIO $ recvDuplicates s
+  _recvCryptoErrs <- readTVarIO $ recvCryptoErrs s
+  _recvErrs <- readTVarIO $ recvErrs s
+  _ackMsgs <- readTVarIO $ ackMsgs s
+  _ackAttempts <- readTVarIO $ ackAttempts s
+  _ackNoMsgErrs <- readTVarIO $ ackNoMsgErrs s
+  _ackOtherErrs <- readTVarIO $ ackOtherErrs s
+  _connCreated <- readTVarIO $ connCreated s
+  _connSecured <- readTVarIO $ connSecured s
+  _connCompleted <- readTVarIO $ connCompleted s
+  _connDeleted <- readTVarIO $ connDeleted s
+  _connDelAttempts <- readTVarIO $ connDelAttempts s
+  _connDelErrs <- readTVarIO $ connDelErrs s
+  _connSubscribed <- readTVarIO $ connSubscribed s
+  _connSubAttempts <- readTVarIO $ connSubAttempts s
+  _connSubIgnored <- readTVarIO $ connSubIgnored s
+  _connSubErrs <- readTVarIO $ connSubErrs s
+  _ntfKey <- OInt <$> readTVarIO (ntfKey s)
+  _ntfKeyAttempts <- OInt <$> readTVarIO (ntfKeyAttempts s)
+  _ntfKeyDeleted <- OInt <$> readTVarIO (ntfKeyDeleted s)
+  _ntfKeyDeleteAttempts <- OInt <$> readTVarIO (ntfKeyDeleteAttempts s)
+  pure
+    AgentSMPServerStatsData
+      { _sentDirect,
+        _sentViaProxy,
+        _sentProxied,
+        _sentDirectAttempts,
+        _sentViaProxyAttempts,
+        _sentProxiedAttempts,
+        _sentAuthErrs,
+        _sentQuotaErrs,
+        _sentExpiredErrs,
+        _sentOtherErrs,
+        _recvMsgs,
+        _recvDuplicates,
+        _recvCryptoErrs,
+        _recvErrs,
+        _ackMsgs,
+        _ackAttempts,
+        _ackNoMsgErrs,
+        _ackOtherErrs,
+        _connCreated,
+        _connSecured,
+        _connCompleted,
+        _connDeleted,
+        _connDelAttempts,
+        _connDelErrs,
+        _connSubscribed,
+        _connSubAttempts,
+        _connSubIgnored,
+        _connSubErrs,
+        _ntfKey,
+        _ntfKeyAttempts,
+        _ntfKeyDeleted,
+        _ntfKeyDeleteAttempts
+      }
+
+addSMPStatsData :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
+addSMPStatsData sd1 sd2 =
+  AgentSMPServerStatsData
+    { _sentDirect = _sentDirect sd1 + _sentDirect sd2,
+      _sentViaProxy = _sentViaProxy sd1 + _sentViaProxy sd2,
+      _sentProxied = _sentProxied sd1 + _sentProxied sd2,
+      _sentDirectAttempts = _sentDirectAttempts sd1 + _sentDirectAttempts sd2,
+      _sentViaProxyAttempts = _sentViaProxyAttempts sd1 + _sentViaProxyAttempts sd2,
+      _sentProxiedAttempts = _sentProxiedAttempts sd1 + _sentProxiedAttempts sd2,
+      _sentAuthErrs = _sentAuthErrs sd1 + _sentAuthErrs sd2,
+      _sentQuotaErrs = _sentQuotaErrs sd1 + _sentQuotaErrs sd2,
+      _sentExpiredErrs = _sentExpiredErrs sd1 + _sentExpiredErrs sd2,
+      _sentOtherErrs = _sentOtherErrs sd1 + _sentOtherErrs sd2,
+      _recvMsgs = _recvMsgs sd1 + _recvMsgs sd2,
+      _recvDuplicates = _recvDuplicates sd1 + _recvDuplicates sd2,
+      _recvCryptoErrs = _recvCryptoErrs sd1 + _recvCryptoErrs sd2,
+      _recvErrs = _recvErrs sd1 + _recvErrs sd2,
+      _ackMsgs = _ackMsgs sd1 + _ackMsgs sd2,
+      _ackAttempts = _ackAttempts sd1 + _ackAttempts sd2,
+      _ackNoMsgErrs = _ackNoMsgErrs sd1 + _ackNoMsgErrs sd2,
+      _ackOtherErrs = _ackOtherErrs sd1 + _ackOtherErrs sd2,
+      _connCreated = _connCreated sd1 + _connCreated sd2,
+      _connSecured = _connSecured sd1 + _connSecured sd2,
+      _connCompleted = _connCompleted sd1 + _connCompleted sd2,
+      _connDeleted = _connDeleted sd1 + _connDeleted sd2,
+      _connDelAttempts = _connDelAttempts sd1 + _connDelAttempts sd2,
+      _connDelErrs = _connDelErrs sd1 + _connDelErrs sd2,
+      _connSubscribed = _connSubscribed sd1 + _connSubscribed sd2,
+      _connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2,
+      _connSubIgnored = _connSubIgnored sd1 + _connSubIgnored sd2,
+      _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2,
+      _ntfKey = _ntfKey sd1 + _ntfKey sd2,
+      _ntfKeyAttempts = _ntfKeyAttempts sd1 + _ntfKeyAttempts sd2,
+      _ntfKeyDeleted = _ntfKeyDeleted sd1 + _ntfKeyDeleted sd2,
+      _ntfKeyDeleteAttempts = _ntfKeyDeleteAttempts sd1 + _ntfKeyDeleteAttempts sd2
+    }
+
+data AgentXFTPServerStats = AgentXFTPServerStats
+  { uploads :: TVar Int, -- total replicas uploaded to server
+    uploadsSize :: TVar Int64, -- total size of uploaded replicas in KB
+    uploadAttempts :: TVar Int, -- upload attempts
+    uploadErrs :: TVar Int, -- upload errors
+    downloads :: TVar Int, -- total replicas downloaded from server
+    downloadsSize :: TVar Int64, -- total size of downloaded replicas in KB
+    downloadAttempts :: TVar Int, -- download attempts
+    downloadAuthErrs :: TVar Int, -- download AUTH errors
+    downloadErrs :: TVar Int, -- other download errors (excluding above)
+    deletions :: TVar Int, -- total replicas deleted from server
+    deleteAttempts :: TVar Int, -- delete attempts
+    deleteErrs :: TVar Int -- delete errors
+  }
+
+data AgentXFTPServerStatsData = AgentXFTPServerStatsData
+  { _uploads :: Int,
+    _uploadsSize :: Int64,
+    _uploadAttempts :: Int,
+    _uploadErrs :: Int,
+    _downloads :: Int,
+    _downloadsSize :: Int64,
+    _downloadAttempts :: Int,
+    _downloadAuthErrs :: Int,
+    _downloadErrs :: Int,
+    _deletions :: Int,
+    _deleteAttempts :: Int,
+    _deleteErrs :: Int
+  }
+  deriving (Show)
+
+newAgentXFTPServerStats :: STM AgentXFTPServerStats
+newAgentXFTPServerStats = do
+  uploads <- newTVar 0
+  uploadsSize <- newTVar 0
+  uploadAttempts <- newTVar 0
+  uploadErrs <- newTVar 0
+  downloads <- newTVar 0
+  downloadsSize <- newTVar 0
+  downloadAttempts <- newTVar 0
+  downloadAuthErrs <- newTVar 0
+  downloadErrs <- newTVar 0
+  deletions <- newTVar 0
+  deleteAttempts <- newTVar 0
+  deleteErrs <- newTVar 0
+  pure
+    AgentXFTPServerStats
+      { uploads,
+        uploadsSize,
+        uploadAttempts,
+        uploadErrs,
+        downloads,
+        downloadsSize,
+        downloadAttempts,
+        downloadAuthErrs,
+        downloadErrs,
+        deletions,
+        deleteAttempts,
+        deleteErrs
+      }
+
+newAgentXFTPServerStatsData :: AgentXFTPServerStatsData
+newAgentXFTPServerStatsData =
+  AgentXFTPServerStatsData
+    { _uploads = 0,
+      _uploadsSize = 0,
+      _uploadAttempts = 0,
+      _uploadErrs = 0,
+      _downloads = 0,
+      _downloadsSize = 0,
+      _downloadAttempts = 0,
+      _downloadAuthErrs = 0,
+      _downloadErrs = 0,
+      _deletions = 0,
+      _deleteAttempts = 0,
+      _deleteErrs = 0
+    }
+
+newAgentXFTPServerStats' :: AgentXFTPServerStatsData -> STM AgentXFTPServerStats
+newAgentXFTPServerStats' s = do
+  uploads <- newTVar $ _uploads s
+  uploadsSize <- newTVar $ _uploadsSize s
+  uploadAttempts <- newTVar $ _uploadAttempts s
+  uploadErrs <- newTVar $ _uploadErrs s
+  downloads <- newTVar $ _downloads s
+  downloadsSize <- newTVar $ _downloadsSize s
+  downloadAttempts <- newTVar $ _downloadAttempts s
+  downloadAuthErrs <- newTVar $ _downloadAuthErrs s
+  downloadErrs <- newTVar $ _downloadErrs s
+  deletions <- newTVar $ _deletions s
+  deleteAttempts <- newTVar $ _deleteAttempts s
+  deleteErrs <- newTVar $ _deleteErrs s
+  pure
+    AgentXFTPServerStats
+      { uploads,
+        uploadsSize,
+        uploadAttempts,
+        uploadErrs,
+        downloads,
+        downloadsSize,
+        downloadAttempts,
+        downloadAuthErrs,
+        downloadErrs,
+        deletions,
+        deleteAttempts,
+        deleteErrs
+      }
+
+-- as this is used to periodically update stats in db,
+-- this is not STM to decrease contention with stats updates
+getAgentXFTPServerStats :: AgentXFTPServerStats -> IO AgentXFTPServerStatsData
+getAgentXFTPServerStats s = do
+  _uploads <- readTVarIO $ uploads s
+  _uploadsSize <- readTVarIO $ uploadsSize s
+  _uploadAttempts <- readTVarIO $ uploadAttempts s
+  _uploadErrs <- readTVarIO $ uploadErrs s
+  _downloads <- readTVarIO $ downloads s
+  _downloadsSize <- readTVarIO $ downloadsSize s
+  _downloadAttempts <- readTVarIO $ downloadAttempts s
+  _downloadAuthErrs <- readTVarIO $ downloadAuthErrs s
+  _downloadErrs <- readTVarIO $ downloadErrs s
+  _deletions <- readTVarIO $ deletions s
+  _deleteAttempts <- readTVarIO $ deleteAttempts s
+  _deleteErrs <- readTVarIO $ deleteErrs s
+  pure
+    AgentXFTPServerStatsData
+      { _uploads,
+        _uploadsSize,
+        _uploadAttempts,
+        _uploadErrs,
+        _downloads,
+        _downloadsSize,
+        _downloadAttempts,
+        _downloadAuthErrs,
+        _downloadErrs,
+        _deletions,
+        _deleteAttempts,
+        _deleteErrs
+      }
+
+addXFTPStatsData :: AgentXFTPServerStatsData -> AgentXFTPServerStatsData -> AgentXFTPServerStatsData
+addXFTPStatsData sd1 sd2 =
+  AgentXFTPServerStatsData
+    { _uploads = _uploads sd1 + _uploads sd2,
+      _uploadsSize = _uploadsSize sd1 + _uploadsSize sd2,
+      _uploadAttempts = _uploadAttempts sd1 + _uploadAttempts sd2,
+      _uploadErrs = _uploadErrs sd1 + _uploadErrs sd2,
+      _downloads = _downloads sd1 + _downloads sd2,
+      _downloadsSize = _downloadsSize sd1 + _downloadsSize sd2,
+      _downloadAttempts = _downloadAttempts sd1 + _downloadAttempts sd2,
+      _downloadAuthErrs = _downloadAuthErrs sd1 + _downloadAuthErrs sd2,
+      _downloadErrs = _downloadErrs sd1 + _downloadErrs sd2,
+      _deletions = _deletions sd1 + _deletions sd2,
+      _deleteAttempts = _deleteAttempts sd1 + _deleteAttempts sd2,
+      _deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
+    }
+
+data AgentNtfServerStats = AgentNtfServerStats
+  { ntfCreated :: TVar Int,
+    ntfCreateAttempts :: TVar Int,
+    ntfChecked :: TVar Int,
+    ntfCheckAttempts :: TVar Int,
+    ntfDeleted :: TVar Int,
+    ntfDelAttempts :: TVar Int
+  }
+
+data AgentNtfServerStatsData = AgentNtfServerStatsData
+  { _ntfCreated :: Int,
+    _ntfCreateAttempts :: Int,
+    _ntfChecked :: Int,
+    _ntfCheckAttempts :: Int,
+    _ntfDeleted :: Int,
+    _ntfDelAttempts :: Int
+  }
+  deriving (Show)
+
+newAgentNtfServerStats :: STM AgentNtfServerStats
+newAgentNtfServerStats = do
+  ntfCreated <- newTVar 0
+  ntfCreateAttempts <- newTVar 0
+  ntfChecked <- newTVar 0
+  ntfCheckAttempts <- newTVar 0
+  ntfDeleted <- newTVar 0
+  ntfDelAttempts <- newTVar 0
+  pure
+    AgentNtfServerStats
+      { ntfCreated,
+        ntfCreateAttempts,
+        ntfChecked,
+        ntfCheckAttempts,
+        ntfDeleted,
+        ntfDelAttempts
+      }
+
+newAgentNtfServerStatsData :: AgentNtfServerStatsData
+newAgentNtfServerStatsData =
+  AgentNtfServerStatsData
+    { _ntfCreated = 0,
+      _ntfCreateAttempts = 0,
+      _ntfChecked = 0,
+      _ntfCheckAttempts = 0,
+      _ntfDeleted = 0,
+      _ntfDelAttempts = 0
+    }
+
+newAgentNtfServerStats' :: AgentNtfServerStatsData -> STM AgentNtfServerStats
+newAgentNtfServerStats' s = do
+  ntfCreated <- newTVar $ _ntfCreated s
+  ntfCreateAttempts <- newTVar $ _ntfCreateAttempts s
+  ntfChecked <- newTVar $ _ntfChecked s
+  ntfCheckAttempts <- newTVar $ _ntfCheckAttempts s
+  ntfDeleted <- newTVar $ _ntfDeleted s
+  ntfDelAttempts <- newTVar $ _ntfDelAttempts s
+  pure
+    AgentNtfServerStats
+      { ntfCreated,
+        ntfCreateAttempts,
+        ntfChecked,
+        ntfCheckAttempts,
+        ntfDeleted,
+        ntfDelAttempts
+      }
+
+getAgentNtfServerStats :: AgentNtfServerStats -> IO AgentNtfServerStatsData
+getAgentNtfServerStats s = do
+  _ntfCreated <- readTVarIO $ ntfCreated s
+  _ntfCreateAttempts <- readTVarIO $ ntfCreateAttempts s
+  _ntfChecked <- readTVarIO $ ntfChecked s
+  _ntfCheckAttempts <- readTVarIO $ ntfCheckAttempts s
+  _ntfDeleted <- readTVarIO $ ntfDeleted s
+  _ntfDelAttempts <- readTVarIO $ ntfDelAttempts s
+  pure
+    AgentNtfServerStatsData
+      { _ntfCreated,
+        _ntfCreateAttempts,
+        _ntfChecked,
+        _ntfCheckAttempts,
+        _ntfDeleted,
+        _ntfDelAttempts
+      }
+
+addNtfStatsData :: AgentNtfServerStatsData -> AgentNtfServerStatsData -> AgentNtfServerStatsData
+addNtfStatsData sd1 sd2 =
+  AgentNtfServerStatsData
+    { _ntfCreated = _ntfCreated sd1 + _ntfCreated sd2,
+      _ntfCreateAttempts = _ntfCreateAttempts sd1 + _ntfCreateAttempts sd2,
+      _ntfChecked = _ntfChecked sd1 + _ntfChecked sd2,
+      _ntfCheckAttempts = _ntfCheckAttempts sd1 + _ntfCheckAttempts sd2,
+      _ntfDeleted = _ntfDeleted sd1 + _ntfDeleted sd2,
+      _ntfDelAttempts = _ntfDelAttempts sd1 + _ntfDelAttempts sd2
+    }
+
+-- Type for gathering both smp and xftp stats across all users and servers,
+-- to then be persisted to db as a single json.
+data AgentPersistedServerStats = AgentPersistedServerStats
+  { smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
+    xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
+    ntfServersStats :: OptionalMap (UserId, NtfServer) AgentNtfServerStatsData
+  }
+  deriving (Show)
+
+instance FromJSON OptionalInt where
+  parseJSON v = OInt <$> parseJSON v
+  omittedField = Just (OInt 0)
+
+newtype OptionalMap k v = OptionalMap (Map k v)
+  deriving (Show, ToJSON)
+
+instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (OptionalMap k v) where
+  parseJSON v = OptionalMap <$> parseJSON v
+  omittedField = Just (OptionalMap M.empty)
+
+$(J.deriveJSON defaultJSON ''AgentSMPServerStatsData)
+
+$(J.deriveJSON defaultJSON ''AgentXFTPServerStatsData)
+
+$(J.deriveJSON defaultJSON ''AgentNtfServerStatsData)
+
+$(J.deriveJSON defaultJSON ''AgentPersistedServerStats)
+
+instance ToField AgentPersistedServerStats where
+  toField = toField . encodeJSON
+
+instance FromField AgentPersistedServerStats where
+  fromField = fromTextField_ decodeJSON

src/Simplex/Messaging/Agent/Store.hs

@@ -44,10 +44,10 @@ import Simplex.Messaging.Protocol
     RcvPrivateAuthKey,
     SndPrivateAuthKey,
     SndPublicAuthKey,
+    SenderCanSecure,
     VersionSMPC,
   )
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Util ((<$?>))
 
 -- * Queue types
 
@@ -84,6 +84,8 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
     e2eDhSecret :: Maybe C.DhSecretX25519,
     -- | sender queue ID
     sndId :: SMP.SenderId,
+    -- | sender can secure the queue
+    sndSecure :: SenderCanSecure,
     -- | queue status
     status :: QueueStatus,
     -- | database queue ID (within connection)
@@ -139,9 +141,11 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
     server :: SMPServer,
     -- | sender queue ID
     sndId :: SMP.SenderId,
+    -- | sender can secure the queue
+    sndSecure :: SenderCanSecure,
     -- | key pair used by the sender to authorize transmissions
     -- TODO combine keys to key pair so that types match
-    sndPublicKey :: Maybe SndPublicAuthKey,
+    sndPublicKey :: SndPublicAuthKey,
     sndPrivateKey :: SndPrivateAuthKey,
     -- | DH public key used to negotiate per-queue e2e encryption
     e2ePubKey :: Maybe C.PublicKeyX25519,
@@ -171,6 +175,12 @@ instance SMPQueue RcvQueue where
   queueId RcvQueue {rcvId} = rcvId
   {-# INLINE queueId #-}
 
+instance SMPQueue NewRcvQueue where
+  qServer RcvQueue {server} = server
+  {-# INLINE qServer #-}
+  queueId RcvQueue {rcvId} = rcvId
+  {-# INLINE queueId #-}
+
 instance SMPQueue SndQueue where
   qServer SndQueue {server} = server
   {-# INLINE qServer #-}
@@ -344,20 +354,20 @@ instance StrEncoding AgentCmdType where
       _ -> fail "bad AgentCmdType"
 
 data AgentCommand
-  = AClientCommand (APartyCmd 'Client)
+  = AClientCommand ACommand
   | AInternalCommand InternalCommand
 
 instance StrEncoding AgentCommand where
   strEncode = \case
-    AClientCommand (APC _ cmd) -> strEncode (ACClient, Str $ serializeCommand cmd)
+    AClientCommand cmd -> strEncode (ACClient, Str $ serializeCommand cmd)
     AInternalCommand cmd -> strEncode (ACInternal, cmd)
   strP =
     strP_ >>= \case
-      ACClient -> AClientCommand <$> ((\(ACmd _ e cmd) -> checkParty $ APC e cmd) <$?> dbCommandP)
+      ACClient -> AClientCommand <$> dbCommandP
       ACInternal -> AInternalCommand <$> strP
 
 data AgentCommandTag
-  = AClientCommandTag (APartyCmdTag 'Client)
+  = AClientCommandTag ACommandTag
   | AInternalCommandTag InternalCommandTag
   deriving (Show)
 
@@ -373,7 +383,7 @@ instance StrEncoding AgentCommandTag where
 data InternalCommand
   = ICAck SMP.RecipientId MsgId
   | ICAckDel SMP.RecipientId MsgId InternalId
-  | ICAllowSecure SMP.RecipientId SMP.SndPublicAuthKey
+  | ICAllowSecure SMP.RecipientId (Maybe SMP.SndPublicAuthKey)
   | ICDuplexSecure SMP.RecipientId SMP.SndPublicAuthKey
   | ICDeleteConn
   | ICDeleteRcvQueue SMP.RecipientId
@@ -436,7 +446,7 @@ instance StrEncoding InternalCommandTag where
 
 agentCommandTag :: AgentCommand -> AgentCommandTag
 agentCommandTag = \case
-  AClientCommand cmd -> AClientCommandTag $ aPartyCmdTag cmd
+  AClientCommand cmd -> AClientCommandTag $ aCommandTag cmd
   AInternalCommand cmd -> AInternalCommandTag $ internalCmdTag cmd
 
 internalCmdTag :: InternalCommand -> InternalCommandTag
@@ -636,4 +646,6 @@ data StoreError
     SEDeletedSndChunkReplicaNotFound
   | -- | Error when reading work item that suspends worker - do not use!
     SEWorkItemError ByteString
+  | -- | Servers stats not found.
+    SEServersStatsNotFound
   deriving (Eq, Show, Exception)

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

@@ -1,10 +1,12 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -15,6 +17,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
@@ -57,6 +60,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     getDeletedConns,
     getConnData,
     setConnDeleted,
+    setConnUserId,
     setConnAgentVersion,
     setConnPQSupport,
     getDeletedConnIds,
@@ -102,12 +106,15 @@ module Simplex.Messaging.Agent.Store.SQLite
     -- Messages
     updateRcvIds,
     createRcvMsg,
+    updateRcvMsgHash,
     updateSndIds,
     createSndMsg,
+    updateSndMsgHash,
     createSndMsgDelivery,
     getSndMsgViaRcpt,
     updateSndMsgRcpt,
     getPendingQueueMsg,
+    getConnectionsForDelivery,
     updatePendingMsgRIState,
     deletePendingMsgs,
     getExpiredSndMessages,
@@ -133,6 +140,7 @@ module Simplex.Messaging.Agent.Store.SQLite
     createCommand,
     getPendingCommandServers,
     getPendingServerCommand,
+    updateCommandServer,
     deleteCommand,
     -- Notification device token persistence
     createNtfToken,
@@ -210,11 +218,15 @@ module Simplex.Messaging.Agent.Store.SQLite
     deleteDeletedSndChunkReplica,
     getPendingDelFilesServers,
     deleteDeletedSndChunkReplicasExpired,
+    -- Stats
+    updateServersStats,
+    getServersStats,
+    resetServersStats,
 
     -- * utilities
     withConnection,
     withTransaction,
-    withTransactionCtx,
+    withTransactionPriority,
     firstRow,
     firstRow',
     maybeFirstRow,
@@ -225,6 +237,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -262,6 +275,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
 import Simplex.FileTransfer.Types
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State (..))
+import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite.Common
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -384,10 +398,10 @@ connectSQLiteStore dbFilePath key keepKey = do
   dbNew <- not <$> doesFileExist dbFilePath
   dbConn <- dbBusyLoop (connectDB dbFilePath key)
   dbConnection <- newMVar dbConn
-  atomically $ do
-    dbKey <- newTVar $! storeKey key keepKey
-    dbClosed <- newTVar False
-    pure SQLiteStore {dbFilePath, dbKey, dbConnection, dbNew, dbClosed}
+  dbKey <- newTVarIO $! storeKey key keepKey
+  dbClosed <- newTVarIO False
+  dbSem <- newTVarIO 0
+  pure SQLiteStore {dbFilePath, dbKey, dbSem, dbConnection, dbNew, dbClosed}
 
 connectDB :: FilePath -> ScrubbedBytes -> IO DB.Connection
 connectDB path key = do
@@ -805,7 +819,7 @@ setRcvQueueNtfCreds db connId clientNtfCreds =
       Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret} -> (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret)
       Nothing -> (Nothing, Nothing, Nothing, Nothing)
 
-type SMPConfirmationRow = (SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)
+type SMPConfirmationRow = (Maybe SndPublicAuthKey, C.PublicKeyX25519, ConnInfo, Maybe [SMPQueueInfo], Maybe VersionSMPC)
 
 smpConfirmation :: SMPConfirmationRow -> SMPConfirmation
 smpConfirmation (senderKey, e2ePubKey, connInfo, smpReplyQueues_, smpClientVersion_) =
@@ -952,24 +966,24 @@ updateRcvIds db connId = do
   pure (internalId, internalRcvId, lastExternalSndId, lastRcvHash)
 
 createRcvMsg :: DB.Connection -> ConnId -> RcvQueue -> RcvMsgData -> IO ()
-createRcvMsg db connId rq rcvMsgData = do
+createRcvMsg db connId rq rcvMsgData@RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalRcvId, internalHash} = do
   insertRcvMsgBase_ db connId rcvMsgData
   insertRcvMsgDetails_ db connId rq rcvMsgData
-  updateHashRcv_ db connId rcvMsgData
+  updateRcvMsgHash db connId sndMsgId internalRcvId internalHash
 
-updateSndIds :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
-updateSndIds db connId = do
-  (lastInternalId, lastInternalSndId, prevSndHash) <- retrieveLastIdsAndHashSnd_ db connId
+updateSndIds :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
+updateSndIds db connId = runExceptT $ do
+  (lastInternalId, lastInternalSndId, prevSndHash) <- ExceptT $ retrieveLastIdsAndHashSnd_ db connId
   let internalId = InternalId $ unId lastInternalId + 1
       internalSndId = InternalSndId $ unSndId lastInternalSndId + 1
-  updateLastIdsSnd_ db connId internalId internalSndId
+  liftIO $ updateLastIdsSnd_ db connId internalId internalSndId
   pure (internalId, internalSndId, prevSndHash)
 
 createSndMsg :: DB.Connection -> ConnId -> SndMsgData -> IO ()
-createSndMsg db connId sndMsgData = do
+createSndMsg db connId sndMsgData@SndMsgData {internalSndId, internalHash} = do
   insertSndMsgBase_ db connId sndMsgData
   insertSndMsgDetails_ db connId sndMsgData
-  updateHashSnd_ db connId sndMsgData
+  updateSndMsgHash db connId internalSndId internalHash
 
 createSndMsgDelivery :: DB.Connection -> ConnId -> SndQueue -> InternalId -> IO ()
 createSndMsgDelivery db connId SndQueue {dbQueueId} msgId =
@@ -1000,6 +1014,10 @@ updateSndMsgRcpt db connId sndMsgId MsgReceipt {agentMsgId, msgRcptStatus} =
     "UPDATE snd_messages SET rcpt_internal_id = ?, rcpt_status = ? WHERE conn_id = ? AND internal_snd_id = ?"
     (agentMsgId, msgRcptStatus, connId, sndMsgId)
 
+getConnectionsForDelivery :: DB.Connection -> IO [ConnId]
+getConnectionsForDelivery db =
+  map fromOnly <$> DB.query_ db "SELECT DISTINCT conn_id FROM snd_message_deliveries WHERE failed = 0"
+
 getPendingQueueMsg :: DB.Connection -> ConnId -> SndQueue -> IO (Either StoreError (Maybe (Maybe RcvQueue, PendingMsgData)))
 getPendingQueueMsg db connId SndQueue {dbQueueId} =
   getWorkItem "message" getMsgId getMsgData markMsgFailed
@@ -1045,7 +1063,7 @@ getWorkItem :: Show i => ByteString -> IO (Maybe i) -> (i -> IO (Either StoreErr
 getWorkItem itemName getId getItem markFailed =
   runExceptT $ handleErr "getId" getId >>= mapM tryGetItem
   where
-    tryGetItem itemId = ExceptT (getItem itemId) `catchStoreErrors` \e -> mark itemId >> throwError e
+    tryGetItem itemId = ExceptT (getItem itemId) `catchStoreErrors` \e -> mark itemId >> throwE e
     mark itemId = handleErr ("markFailed ID " <> bshow itemId) $ markFailed itemId
     catchStoreErrors = catchAllErrors (SEInternal . bshow)
     -- Errors caught by this function will suspend worker as if there is no more work,
@@ -1309,38 +1327,39 @@ getPendingCommandServers db connId = do
   where
     smpServer (host, port, keyHash) = SMPServer <$> host <*> port <*> keyHash
 
-getPendingServerCommand :: DB.Connection -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
-getPendingServerCommand db srv_ = getWorkItem "command" getCmdId getCommand markCommandFailed
+getPendingServerCommand :: DB.Connection -> ConnId -> Maybe SMPServer -> IO (Either StoreError (Maybe PendingCommand))
+getPendingServerCommand db connId srv_ = getWorkItem "command" getCmdId getCommand markCommandFailed
   where
     getCmdId :: IO (Maybe Int64)
     getCmdId =
       maybeFirstRow fromOnly $ case srv_ of
         Nothing ->
-          DB.query_
+          DB.query
             db
             [sql|
               SELECT command_id FROM commands
-              WHERE host IS NULL AND port IS NULL AND failed = 0
+              WHERE conn_id = ? AND host IS NULL AND port IS NULL AND failed = 0
               ORDER BY created_at ASC, command_id ASC
               LIMIT 1
             |]
+            (Only connId)
         Just (SMPServer host port _) ->
           DB.query
             db
             [sql|
               SELECT command_id FROM commands
-              WHERE host = ? AND port = ? AND failed = 0
+              WHERE conn_id = ? AND host = ? AND port = ? AND failed = 0
               ORDER BY created_at ASC, command_id ASC
               LIMIT 1
             |]
-            (host, port)
+            (connId, host, port)
     getCommand :: Int64 -> IO (Either StoreError PendingCommand)
     getCommand cmdId =
       firstRow pendingCommand err $
         DB.query
           db
           [sql|
-            SELECT c.corr_id, cs.user_id, c.conn_id, c.command
+            SELECT c.corr_id, cs.user_id, c.command
             FROM commands c
             JOIN connections cs USING (conn_id)
             WHERE c.command_id = ?
@@ -1348,9 +1367,22 @@ getPendingServerCommand db srv_ = getWorkItem "command" getCmdId getCommand mark
           (Only cmdId)
       where
         err = SEInternal $ "command  " <> bshow cmdId <> " returned []"
-        pendingCommand (corrId, userId, connId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
+        pendingCommand (corrId, userId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
     markCommandFailed cmdId = DB.execute db "UPDATE commands SET failed = 1 WHERE command_id = ?" (Only cmdId)
 
+updateCommandServer :: DB.Connection -> AsyncCmdId -> SMPServer -> IO (Either StoreError ())
+updateCommandServer db cmdId srv@(SMPServer host port _) = runExceptT $ do
+  serverKeyHash_ <- ExceptT $ getServerKeyHash_ db srv
+  liftIO $
+    DB.execute
+      db
+      [sql|
+        UPDATE commands
+        SET host = ?, port = ?, server_key_hash = ?
+        WHERE command_id = ?
+      |]
+      (host, port, serverKeyHash_, cmdId)
+
 deleteCommand :: DB.Connection -> AsyncCmdId -> IO ()
 deleteCommand db cmdId =
   DB.execute db "DELETE FROM commands WHERE command_id = ?" (Only cmdId)
@@ -1449,23 +1481,24 @@ getNtfSubscription db connId =
     DB.query
       db
       [sql|
-        SELECT s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
+        SELECT c.user_id, s.host, s.port, COALESCE(nsb.smp_server_key_hash, s.key_hash), ns.ntf_host, ns.ntf_port, ns.ntf_key_hash,
           nsb.smp_ntf_id, nsb.ntf_sub_id, nsb.ntf_sub_status, nsb.ntf_sub_action, nsb.ntf_sub_smp_action, nsb.ntf_sub_action_ts
         FROM ntf_subscriptions nsb
+        JOIN connections c USING (conn_id)
         JOIN servers s ON s.host = nsb.smp_host AND s.port = nsb.smp_port
         JOIN ntf_servers ns USING (ntf_host, ntf_port)
         WHERE nsb.conn_id = ?
       |]
       (Only connId)
   where
-    ntfSubscription (smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_) =
+    ntfSubscription ((userId, smpHost, smpPort, smpKeyHash, ntfHost, ntfPort, ntfKeyHash ) :. (ntfQueueId, ntfSubId, ntfSubStatus, ntfAction_, smpAction_, actionTs_)) =
       let smpServer = SMPServer smpHost smpPort smpKeyHash
           ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
           action = case (ntfAction_, smpAction_, actionTs_) of
-            (Just ntfAction, Nothing, Just actionTs) -> Just (NtfSubNTFAction ntfAction, actionTs)
-            (Nothing, Just smpAction, Just actionTs) -> Just (NtfSubSMPAction smpAction, actionTs)
+            (Just ntfAction, Nothing, Just actionTs) -> Just (NSANtf ntfAction, actionTs)
+            (Nothing, Just smpAction, Just actionTs) -> Just (NSASMP smpAction, actionTs)
             _ -> Nothing
-       in (NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}, action)
+       in (NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}, action)
 
 createNtfSubscription :: DB.Connection -> NtfSubscription -> NtfSubAction -> IO (Either StoreError ())
 createNtfSubscription db ntfSubscription action = runExceptT $ do
@@ -1599,18 +1632,19 @@ getNextNtfSubNTFAction db ntfServer@(NtfServer ntfHost ntfPort _) =
         DB.query
           db
           [sql|
-            SELECT s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
+            SELECT c.user_id, s.host, s.port, COALESCE(ns.smp_server_key_hash, s.key_hash),
               ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_action
             FROM ntf_subscriptions ns
+            JOIN connections c USING (conn_id)
             JOIN servers s ON s.host = ns.smp_host AND s.port = ns.smp_port
             WHERE ns.conn_id = ?
           |]
           (Only connId)
       where
         err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (userId, smpHost, smpPort, smpKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
           let smpServer = SMPServer smpHost smpPort smpKeyHash
-              ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
+              ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
            in (ntfSubscription, action, actionTs)
 
 markNtfSubActionNtfFailed_ :: DB.Connection -> ConnId -> IO ()
@@ -1642,18 +1676,19 @@ getNextNtfSubSMPAction db smpServer@(SMPServer smpHost smpPort _) =
         DB.query
           db
           [sql|
-            SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash,
+            SELECT c.user_id, s.ntf_host, s.ntf_port, s.ntf_key_hash,
               ns.smp_ntf_id, ns.ntf_sub_id, ns.ntf_sub_status, ns.ntf_sub_action_ts, ns.ntf_sub_smp_action
             FROM ntf_subscriptions ns
+            JOIN connections c USING (conn_id)
             JOIN ntf_servers s USING (ntf_host, ntf_port)
             WHERE ns.conn_id = ?
           |]
           (Only connId)
       where
         err = SEInternal $ "ntf subscription " <> bshow connId <> " returned []"
-        ntfSubAction (ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
+        ntfSubAction (userId, ntfHost, ntfPort, ntfKeyHash, ntfQueueId, ntfSubId, ntfSubStatus, actionTs, action) =
           let ntfServer = NtfServer ntfHost ntfPort ntfKeyHash
-              ntfSubscription = NtfSubscription {connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
+              ntfSubscription = NtfSubscription {userId, connId, smpServer, ntfQueueId, ntfServer, ntfSubId, ntfSubStatus}
            in (ntfSubscription, action, actionTs)
 
 markNtfSubActionSMPFailed_ :: DB.Connection -> ConnId -> IO ()
@@ -1782,6 +1817,14 @@ instance ToField (Version v) where toField (Version v) = toField v
 
 instance FromField (Version v) where fromField f = Version <$> fromField f
 
+deriving newtype instance ToField EntityId
+
+deriving newtype instance FromField EntityId
+
+deriving newtype instance ToField ChunkReplicaId
+
+deriving newtype instance FromField ChunkReplicaId
+
 listToEither :: e -> [a] -> Either e a
 listToEither _ (x : _) = Right x
 listToEither e _ = Left e
@@ -1860,28 +1903,34 @@ upsertNtfServer_ db ProtocolServer {host, port, keyHash} = do
 
 insertRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> Maybe C.KeyHash -> IO RcvQueue
 insertRcvQueue_ db connId' rq@RcvQueue {..} serverKeyHash_ = do
-  qId <- newQueueId_ <$> DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (Only connId')
+  -- to preserve ID if the queue already exists.
+  -- possibly, it can be done in one query.
+  currQId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (connId', host server, port server, sndId)
+  qId <- maybe (newQueueId_ <$> DB.query db "SELECT rcv_queue_id FROM rcv_queues WHERE conn_id = ? ORDER BY rcv_queue_id DESC LIMIT 1" (Only connId')) pure currQId_
   DB.execute
     db
     [sql|
       INSERT INTO rcv_queues
-        (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
+        (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, snd_secure, status, rcv_queue_id, rcv_primary, replace_rcv_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
     |]
-    ((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
+    ((host server, port server, rcvId, connId', rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret) :. (sndId, sndSecure, status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
   pure (rq :: NewRcvQueue) {connId = connId', dbQueueId = qId}
 
 -- * createSndConn helpers
 
 insertSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> Maybe C.KeyHash -> IO SndQueue
 insertSndQueue_ db connId' sq@SndQueue {..} serverKeyHash_ = do
-  qId <- newQueueId_ <$> DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (Only connId')
+  -- to preserve ID if the queue already exists.
+  -- possibly, it can be done in one query.
+  currQId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? AND host = ? AND port = ? AND snd_id = ?" (connId', host server, port server, sndId)
+  qId <- maybe (newQueueId_ <$> DB.query db "SELECT snd_queue_id FROM snd_queues WHERE conn_id = ? ORDER BY snd_queue_id DESC LIMIT 1" (Only connId')) pure currQId_
   DB.execute
     db
     [sql|
       INSERT OR REPLACE INTO snd_queues
-        (host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);
+        (host, port, snd_id, snd_secure, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status, snd_queue_id, snd_primary, replace_snd_queue_id, smp_client_version, server_key_hash) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);
     |]
-    ((host server, port server, sndId, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) :. (status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
+    ((host server, port server, sndId, sndSecure, connId', sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret) :. (status, qId, primary, dbReplaceQueueId, smpClientVersion, serverKeyHash_))
   pure (sq :: NewSndQueue) {connId = connId', dbQueueId = qId}
 
 newQueueId_ :: [Only Int64] -> DBQueueId 'QSStored
@@ -1892,9 +1941,11 @@ newQueueId_ (Only maxId : _) = DBQueueId (maxId + 1)
 
 getConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getConn = getAnyConn False
+{-# INLINE getConn #-}
 
 getDeletedConn :: DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getDeletedConn = getAnyConn True
+{-# INLINE getDeletedConn #-}
 
 getAnyConn :: Bool -> DB.Connection -> ConnId -> IO (Either StoreError SomeConn)
 getAnyConn deleted' dbConn connId =
@@ -1915,9 +1966,11 @@ getAnyConn deleted' dbConn connId =
 
 getConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getConns = getAnyConns_ False
+{-# INLINE getConns #-}
 
 getDeletedConns :: DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getDeletedConns = getAnyConns_ True
+{-# INLINE getDeletedConns #-}
 
 getAnyConns_ :: Bool -> DB.Connection -> [ConnId] -> IO [Either StoreError SomeConn]
 getAnyConns_ deleted' db connIds = forM connIds $ E.handle handleDBError . getAnyConn deleted' db
@@ -1950,6 +2003,10 @@ setConnDeleted db waitDelivery connId
   | otherwise =
       DB.execute db "UPDATE connections SET deleted = ? WHERE conn_id = ?" (True, connId)
 
+setConnUserId :: DB.Connection -> UserId -> ConnId -> UserId -> IO ()
+setConnUserId db oldUserId connId newUserId = 
+  DB.execute db "UPDATE connections SET user_id = ? WHERE conn_id = ? and user_id = ?" (newUserId, connId, oldUserId)
+
 setConnAgentVersion :: DB.Connection -> ConnId -> VersionSMPA -> IO ()
 setConnAgentVersion db connId aVersion =
   DB.execute db "UPDATE connections SET smp_agent_version = ? WHERE conn_id = ?" (aVersion, connId)
@@ -2003,7 +2060,7 @@ rcvQueueQuery :: Query
 rcvQueueQuery =
   [sql|
     SELECT c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.rcv_id, q.rcv_private_key, q.rcv_dh_secret,
-      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.status,
+      q.e2e_priv_key, q.e2e_dh_secret, q.snd_id, q.snd_secure, q.status,
       q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id, q.switch_status, q.smp_client_version, q.delete_errors,
       q.ntf_public_key, q.ntf_private_key, q.ntf_id, q.rcv_ntf_dh_secret
     FROM rcv_queues q
@@ -2012,17 +2069,17 @@ rcvQueueQuery =
   |]
 
 toRcvQueue ::
-  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, QueueStatus)
-    :. (DBQueueId 'QSStored, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SMP.RecipientId, SMP.RcvPrivateAuthKey, SMP.RcvDhSecret, C.PrivateKeyX25519, Maybe C.DhSecretX25519, SMP.SenderId, SenderCanSecure)
+    :. (QueueStatus, DBQueueId 'QSStored, Bool, Maybe Int64, Maybe RcvSwitchStatus, Maybe VersionSMPC, Int)
     :. (Maybe SMP.NtfPublicAuthKey, Maybe SMP.NtfPrivateAuthKey, Maybe SMP.NotifierId, Maybe RcvNtfDhSecret) ->
   RcvQueue
-toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status) :. (dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
+toRcvQueue ((userId, keyHash, connId, host, port, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure) :. (status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion_, deleteErrors) :. (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_)) =
   let server = SMPServer host port keyHash
       smpClientVersion = fromMaybe initialSMPClientVersion smpClientVersion_
       clientNtfCreds = case (ntfPublicKey_, ntfPrivateKey_, notifierId_, rcvNtfDhSecret_) of
         (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just $ ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
         _ -> Nothing
-   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
+   in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, sndSecure, status, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}
 
 getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
 getRcvQueueById db connId dbRcvId =
@@ -2043,7 +2100,7 @@ sndQueueQuery :: Query
 sndQueueQuery =
   [sql|
     SELECT
-      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id,
+      c.user_id, COALESCE(q.server_key_hash, s.key_hash), q.conn_id, q.host, q.port, q.snd_id, q.snd_secure,
       q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status,
       q.snd_queue_id, q.snd_primary, q.replace_snd_queue_id, q.switch_status, q.smp_client_version
     FROM snd_queues q
@@ -2052,17 +2109,18 @@ sndQueueQuery =
   |]
 
 toSndQueue ::
-  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId)
+  (UserId, C.KeyHash, ConnId, NonEmpty TransportHost, ServiceName, SenderId, SenderCanSecure)
     :. (Maybe SndPublicAuthKey, SndPrivateAuthKey, Maybe C.PublicKeyX25519, C.DhSecretX25519, QueueStatus)
     :. (DBQueueId 'QSStored, Bool, Maybe Int64, Maybe SndSwitchStatus, VersionSMPC) ->
   SndQueue
 toSndQueue
-  ( (userId, keyHash, connId, host, port, sndId)
-      :. (sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
+  ( (userId, keyHash, connId, host, port, sndId, sndSecure)
+      :. (sndPubKey, sndPrivateKey@(C.APrivateAuthKey a pk), e2ePubKey, e2eDhSecret, status)
       :. (dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion)
     ) =
     let server = SMPServer host port keyHash
-     in SndQueue {userId, connId, server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
+        sndPublicKey = fromMaybe (C.APublicAuthKey a (C.publicKey pk)) sndPubKey
+     in SndQueue {userId, connId, server, sndId, sndSecure, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status, dbQueueId, primary, dbReplaceQueueId, sndSwchStatus, smpClientVersion}
 
 getSndQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError SndQueue)
 getSndQueueById db connId dbSndId =
@@ -2141,10 +2199,10 @@ insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, interna
     ]
   DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, encryptedMsgHash)
 
-updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
-updateHashRcv_ dbConn connId RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalHash, internalRcvId} =
+updateRcvMsgHash :: DB.Connection -> ConnId -> AgentMsgId -> InternalRcvId -> MsgHash -> IO ()
+updateRcvMsgHash db connId sndMsgId internalRcvId internalHash =
   DB.executeNamed
-    dbConn
+    db
     -- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
     [sql|
       UPDATE connections
@@ -2161,9 +2219,9 @@ updateHashRcv_ dbConn connId RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalH
 
 -- * updateSndIds helpers
 
-retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (InternalId, InternalSndId, PrevSndMsgHash)
+retrieveLastIdsAndHashSnd_ :: DB.Connection -> ConnId -> IO (Either StoreError (InternalId, InternalSndId, PrevSndMsgHash))
 retrieveLastIdsAndHashSnd_ dbConn connId = do
-  [(lastInternalId, lastInternalSndId, lastSndHash)] <-
+  firstRow id SEConnNotFound $
     DB.queryNamed
       dbConn
       [sql|
@@ -2172,7 +2230,6 @@ retrieveLastIdsAndHashSnd_ dbConn connId = do
         WHERE conn_id = :conn_id;
       |]
       [":conn_id" := connId]
-  return (lastInternalId, lastInternalSndId, lastSndHash)
 
 updateLastIdsSnd_ :: DB.Connection -> ConnId -> InternalId -> InternalSndId -> IO ()
 updateLastIdsSnd_ dbConn connId newInternalId newInternalSndId =
@@ -2220,10 +2277,10 @@ insertSndMsgDetails_ dbConn connId SndMsgData {..} =
       ":previous_msg_hash" := prevMsgHash
     ]
 
-updateHashSnd_ :: DB.Connection -> ConnId -> SndMsgData -> IO ()
-updateHashSnd_ dbConn connId SndMsgData {..} =
+updateSndMsgHash :: DB.Connection -> ConnId -> InternalSndId -> MsgHash -> IO ()
+updateSndMsgHash db connId internalSndId internalHash =
   DB.executeNamed
-    dbConn
+    db
     -- last_internal_snd_msg_id equality check prevents race condition in case next id was reserved
     [sql|
       UPDATE connections
@@ -2257,8 +2314,8 @@ randomId :: TVar ChaChaDRG -> Int -> IO ByteString
 randomId gVar n = atomically $ U.encode <$> C.randomBytes n gVar
 
 ntfSubAndSMPAction :: NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
-ntfSubAndSMPAction (NtfSubNTFAction action) = (Just action, Nothing)
-ntfSubAndSMPAction (NtfSubSMPAction action) = (Nothing, Just action)
+ntfSubAndSMPAction (NSANtf action) = (Just action, Nothing)
+ntfSubAndSMPAction (NSASMP action) = (Nothing, Just action)
 
 createXFTPServer_ :: DB.Connection -> XFTPServer -> IO Int64
 createXFTPServer_ db newSrv@ProtocolServer {host, port, keyHash} =
@@ -2468,7 +2525,7 @@ deleteRcvFile' :: DB.Connection -> DBRcvFileId -> IO ()
 deleteRcvFile' db rcvFileId =
   DB.execute db "DELETE FROM rcv_files WHERE rcv_file_id = ?" (Only rcvFileId)
 
-getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool)))
+getNextRcvChunkToDownload :: DB.Connection -> XFTPServer -> NominalDiffTime -> IO (Either StoreError (Maybe (RcvFileChunk, Bool, Maybe RcvFileId)))
 getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = do
   getWorkItem "rcv_file_download" getReplicaId getChunkData (markRcvFileFailed db . snd)
   where
@@ -2492,7 +2549,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
             LIMIT 1
           |]
           (host, port, keyHash, RFSReceiving, cutoffTs)
-    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool))
+    getChunkData :: (Int64, DBRcvFileId) -> IO (Either StoreError (RcvFileChunk, Bool, Maybe RcvFileId))
     getChunkData (rcvFileChunkReplicaId, _fileId) =
       firstRow toChunk SEFileNotFound $
         DB.query
@@ -2501,7 +2558,7 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
             SELECT
               f.rcv_file_id, f.rcv_file_entity_id, f.user_id, c.rcv_file_chunk_id, c.chunk_no, c.chunk_size, c.digest, f.tmp_path, c.tmp_path,
               r.rcv_file_chunk_replica_id, r.replica_id, r.replica_key, r.received, r.delay, r.retries,
-              f.approved_relays
+              f.approved_relays, f.redirect_entity_id
             FROM rcv_file_chunk_replicas r
             JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
             JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
@@ -2510,8 +2567,8 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
           |]
           (Only rcvFileChunkReplicaId)
       where
-        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, Bool, Maybe Int64, Int) :. Only Bool) -> (RcvFileChunk, Bool)
-        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (Only approvedRelays)) =
+        toChunk :: ((DBRcvFileId, RcvFileId, UserId, Int64, Int, FileSize Word32, FileDigest, FilePath, Maybe FilePath) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, Bool, Maybe Int64, Int) :. (Bool, Maybe RcvFileId)) -> (RcvFileChunk, Bool, Maybe RcvFileId)
+        toChunk ((rcvFileId, rcvFileEntityId, userId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath, chunkTmpPath) :. (rcvChunkReplicaId, replicaId, replicaKey, received, delay, retries) :. (approvedRelays, redirectEntityId_)) =
           ( RcvFileChunk
               { rcvFileId,
                 rcvFileEntityId,
@@ -2524,7 +2581,8 @@ getNextRcvChunkToDownload db server@ProtocolServer {host, port, keyHash} ttl = d
                 chunkTmpPath,
                 replicas = [RcvFileChunkReplica {rcvChunkReplicaId, server, replicaId, replicaKey, received, delay, retries}]
               },
-            approvedRelays
+            approvedRelays,
+            redirectEntityId_
           )
 
 getNextRcvFileToDecrypt :: DB.Connection -> NominalDiffTime -> IO (Either StoreError (Maybe RcvFile))
@@ -3016,6 +3074,20 @@ deleteDeletedSndChunkReplicasExpired db ttl = do
   cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
   DB.execute db "DELETE FROM deleted_snd_chunk_replicas WHERE created_at < ?" (Only cutoffTs)
 
+updateServersStats :: DB.Connection -> AgentPersistedServerStats -> IO ()
+updateServersStats db stats = do
+  updatedAt <- getCurrentTime
+  DB.execute db "UPDATE servers_stats SET servers_stats = ?, updated_at = ? WHERE servers_stats_id = 1" (stats, updatedAt)
+
+getServersStats :: DB.Connection -> IO (Either StoreError (UTCTime, Maybe AgentPersistedServerStats))
+getServersStats db =
+  firstRow id SEServersStatsNotFound $
+    DB.query_ db "SELECT started_at, servers_stats FROM servers_stats WHERE servers_stats_id = 1"
+
+resetServersStats :: DB.Connection -> UTCTime -> IO ()
+resetServersStats db startedAt =
+  DB.execute db "UPDATE servers_stats SET servers_stats = NULL, started_at = ?, updated_at = ? WHERE servers_stats_id = 1" (startedAt, startedAt)
+
 $(J.deriveJSON defaultJSON ''UpMigration)
 
 $(J.deriveToJSON (sumTypeJSON $ dropPrefix "ME") ''MigrationError)

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -8,20 +9,20 @@ module Simplex.Messaging.Agent.Store.SQLite.Common
     withConnection',
     withTransaction,
     withTransaction',
-    withTransactionCtx,
+    withTransactionPriority,
     dbBusyLoop,
     storeKey,
   )
 where
 
 import Control.Concurrent (threadDelay)
+import Control.Concurrent.STM (retry)
 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
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
-import Simplex.Messaging.Util (diffToMilliseconds)
+import Simplex.Messaging.Util (ifM, unlessM)
 import qualified UnliftIO.Exception as E
 import UnliftIO.MVar
 import UnliftIO.STM
@@ -32,35 +33,40 @@ storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
 data SQLiteStore = SQLiteStore
   { dbFilePath :: FilePath,
     dbKey :: TVar (Maybe ScrubbedBytes),
+    dbSem :: TVar Int,
     dbConnection :: MVar DB.Connection,
     dbClosed :: TVar Bool,
     dbNew :: Bool
   }
 
+withConnectionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
+  | priority = E.bracket_ signal release $ withMVar dbConnection action
+  | otherwise = lowPriority
+  where
+    lowPriority = wait >> withMVar dbConnection (\db -> ifM free (Just <$> action db) (pure Nothing)) >>= maybe lowPriority pure
+    signal = atomically $ modifyTVar' dbSem (+ 1)
+    release = atomically $ modifyTVar' dbSem $ \sem -> if sem > 0 then sem - 1 else 0
+    wait = unlessM free $ atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
+    free = (0 ==) <$> readTVarIO dbSem
+
 withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withConnection SQLiteStore {dbConnection} = withMVar dbConnection
+withConnection st = withConnectionPriority st False
 
 withConnection' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withConnection' st action = withConnection st $ action . DB.conn
 
-withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransaction = withTransactionCtx Nothing
-
 withTransaction' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
 withTransaction' st action = withTransaction st $ action . DB.conn
 
-withTransactionCtx :: Maybe String -> SQLiteStore -> (DB.Connection -> IO a) -> IO a
-withTransactionCtx ctx_ st action = withConnection st $ dbBusyLoop . transactionWithCtx
+withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
+withTransaction st = withTransactionPriority st False
+{-# INLINE withTransaction #-}
+
+withTransactionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
+withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
   where
-    transactionWithCtx db@DB.Connection {conn} = case ctx_ of
-      Nothing -> SQL.withImmediateTransaction conn $ action db
-      Just ctx -> do
-        t1 <- getCurrentTime
-        r <- SQL.withImmediateTransaction conn $ action db
-        t2 <- getCurrentTime
-        putStrLn $ "withTransactionCtx start :: " <> show t1 <> " :: " <> ctx
-        putStrLn $ "withTransactionCtx end   :: " <> show t2 <> " :: " <> ctx <> " :: duration=" <> show (diffToMilliseconds $ diffUTCTime t2 t1)
-        pure r
+    transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
 
 dbBusyLoop :: forall a. IO a -> IO a
 dbBusyLoop action = loop 500 3000000

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -20,15 +21,19 @@ where
 
 import Control.Concurrent.STM
 import Control.Monad (when)
+import Control.Exception
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Text (Text)
 import Data.Time (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffToMilliseconds)
+import Simplex.Messaging.Util (diffToMilliseconds, tshow)
 
 data Connection = Connection
   { conn :: SQL.Connection,
@@ -38,33 +43,41 @@ data Connection = Connection
 data SlowQueryStats = SlowQueryStats
   { count :: Int64,
     timeMax :: Int64,
-    timeAvg :: Int64
+    timeAvg :: Int64,
+    errs :: Map Text Int
   }
   deriving (Show)
 
 timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
 timeIt slow sql a = do
   t <- getCurrentTime
-  r <- a
+  r <- a `catch` \e -> do
+    atomically $ TM.alter (Just . updateQueryErrors e) sql slow
+    throwIO e
   t' <- getCurrentTime
   let diff = diffToMilliseconds $ diffUTCTime t' t
-  atomically $ when (diff > 5) $ TM.alter (updateQueryStats diff) sql slow
+  when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
   pure r
   where
+    updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
+    updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
+    updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
+      stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
     updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
-    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff
-    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg}) =
+    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
+    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
       Just $
         SlowQueryStats
           { count = count + 1,
             timeMax = max timeMax diff,
-            timeAvg = (timeAvg * count + diff) `div` (count + 1)
+            timeAvg = (timeAvg * count + diff) `div` (count + 1),
+            errs
           }
 
 open :: String -> IO Connection
 open f = do
   conn <- SQL.open f
-  slow <- atomically $ TM.empty
+  slow <- TM.emptyIO
   pure Connection {conn, slow}
 
 close :: Connection -> IO ()

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

@@ -29,7 +29,7 @@ import Control.Monad (forM_, when)
 import qualified Data.Aeson.TH as J
 import Data.List (intercalate, sortOn)
 import Data.List.NonEmpty (NonEmpty)
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import Data.Maybe (isNothing, mapMaybe)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeLatin1)
@@ -72,6 +72,8 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -112,7 +114,9 @@ schemaMigrations =
     ("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
     ("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
     ("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
-    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays)
+    ("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
+    ("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
+    ("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats)
   ]
 
 -- | The list of migrations in ascending order by date

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

@@ -0,0 +1,36 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240624_snd_secure :: Query
+m20240624_snd_secure =
+    [sql|
+ALTER TABLE rcv_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+ALTER TABLE snd_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(sql, 'sender_key BLOB NOT NULL,', 'sender_key BLOB,')
+WHERE name = 'conn_confirmations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]
+
+down_m20240624_snd_secure :: Query
+down_m20240624_snd_secure =
+    [sql|
+ALTER TABLE rcv_queues DROP COLUMN snd_secure;
+ALTER TABLE snd_queues DROP COLUMN snd_secure;
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master
+SET sql = replace(sql, 'sender_key BLOB,', 'sender_key BLOB NOT NULL,')
+WHERE name = 'conn_confirmations' AND type = 'table';
+
+PRAGMA writable_schema=0;
+|]

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

@@ -0,0 +1,29 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- servers_stats_id: dummy id, there should always only be one record with servers_stats_id = 1
+-- servers_stats: overall accumulated stats, past and session, reset to null on stats reset
+-- started_at: starting point of tracking stats, reset on stats reset
+m20240702_servers_stats :: Query
+m20240702_servers_stats =
+    [sql|
+CREATE TABLE servers_stats(
+  servers_stats_id INTEGER PRIMARY KEY,
+  servers_stats TEXT,
+  started_at TEXT NOT NULL DEFAULT(datetime('now')),
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
+
+INSERT INTO servers_stats (servers_stats_id) VALUES (1);
+|]
+
+down_m20240702_servers_stats :: Query
+down_m20240702_servers_stats =
+    [sql|
+DROP TABLE servers_stats;
+|]

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

@@ -55,6 +55,7 @@ CREATE TABLE rcv_queues(
   server_key_hash BLOB,
   switch_status TEXT,
   deleted INTEGER NOT NULL DEFAULT 0,
+  snd_secure INTEGER NOT NULL DEFAULT 0,
   PRIMARY KEY(host, port, rcv_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE,
@@ -77,6 +78,7 @@ CREATE TABLE snd_queues(
   replace_snd_queue_id INTEGER NULL,
   server_key_hash BLOB,
   switch_status TEXT,
+  snd_secure INTEGER NOT NULL DEFAULT 0,
   PRIMARY KEY(host, port, snd_id),
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE
@@ -132,7 +134,7 @@ CREATE TABLE conn_confirmations(
   confirmation_id BLOB NOT NULL PRIMARY KEY,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
   e2e_snd_pub_key BLOB NOT NULL,
-  sender_key BLOB NOT NULL,
+  sender_key BLOB,
   ratchet_state BLOB NOT NULL,
   sender_conn_info BLOB NOT NULL,
   accepted INTEGER NOT NULL,
@@ -394,6 +396,13 @@ CREATE TABLE processed_ratchet_key_hashes(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
+CREATE TABLE servers_stats(
+  servers_stats_id INTEGER PRIMARY KEY,
+  servers_stats TEXT,
+  started_at TEXT NOT NULL DEFAULT(datetime('now')),
+  created_at TEXT NOT NULL DEFAULT(datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+);
 CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
 CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
 CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);

src/Simplex/Messaging/Agent/TRcvQueues.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Simplex.Messaging.Agent.TRcvQueues
   ( TRcvQueues (getRcvQueues, getConnections),
+    Queue (..),
     empty,
     clear,
     deleteConn,
@@ -9,9 +11,9 @@ module Simplex.Messaging.Agent.TRcvQueues
     addQueue,
     batchAddQueues,
     deleteQueue,
+    hasSessQueues,
     getSessQueues,
     getDelSessQueues,
-    qKey,
   )
 where
 
@@ -25,46 +27,51 @@ import Simplex.Messaging.Agent.Store (RcvQueue, StoredRcvQueue (..))
 import Simplex.Messaging.Protocol (RecipientId, SMPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Transport
+
+class Queue q where
+  connId' :: q -> ConnId
+  qKey :: q -> (UserId, SMPServer, RecipientId)
 
 -- the fields in this record have the same data with swapped keys for lookup efficiency,
 -- and all methods must maintain this invariant.
-data TRcvQueues = TRcvQueues
-  { getRcvQueues :: TMap (UserId, SMPServer, RecipientId) RcvQueue,
+data TRcvQueues q = TRcvQueues
+  { getRcvQueues :: TMap (UserId, SMPServer, RecipientId) q,
     getConnections :: TMap ConnId (NonEmpty (UserId, SMPServer, RecipientId))
   }
 
-empty :: STM TRcvQueues
-empty = TRcvQueues <$> TM.empty <*> TM.empty
+empty :: IO (TRcvQueues q)
+empty = TRcvQueues <$> TM.emptyIO <*> TM.emptyIO
 
-clear :: TRcvQueues -> STM ()
+clear :: TRcvQueues q -> STM ()
 clear (TRcvQueues qs cs) = TM.clear qs >> TM.clear cs
 
-deleteConn :: ConnId -> TRcvQueues -> STM ()
+deleteConn :: ConnId -> TRcvQueues q -> STM ()
 deleteConn cId (TRcvQueues qs cs) =
   TM.lookupDelete cId cs >>= \case
     Just ks -> modifyTVar' qs $ \qs' -> foldl' (flip M.delete) qs' ks
     Nothing -> pure ()
 
-hasConn :: ConnId -> TRcvQueues -> STM Bool
+hasConn :: ConnId -> TRcvQueues q -> STM Bool
 hasConn cId (TRcvQueues _ cs) = TM.member cId cs
 
-addQueue :: RcvQueue -> TRcvQueues -> STM ()
+addQueue :: Queue q => q -> TRcvQueues q -> STM ()
 addQueue rq (TRcvQueues qs cs) = do
   TM.insert k rq qs
-  TM.alter addQ (connId rq) cs
+  TM.alter addQ (connId' rq) cs
   where
     addQ = Just . maybe (k :| []) (k <|)
     k = qKey rq
 
--- Save time by aggregating modifyTVar
-batchAddQueues :: Foldable t => TRcvQueues -> t RcvQueue -> STM ()
+-- Save time by aggregating modifyTVar'
+batchAddQueues :: (Foldable t, Queue q) => TRcvQueues q -> t q -> STM ()
 batchAddQueues (TRcvQueues qs cs) rqs = do
   modifyTVar' qs $ \now -> foldl' (\rqs' rq -> M.insert (qKey rq) rq rqs') now rqs
-  modifyTVar' cs $ \now -> foldl' (\cs' rq -> M.alter (addQ $ qKey rq) (connId rq) cs') now rqs
+  modifyTVar' cs $ \now -> foldl' (\cs' rq -> M.alter (addQ $ qKey rq) (connId' rq) cs') now rqs
   where
     addQ k = Just . maybe (k :| []) (k <|)
 
-deleteQueue :: RcvQueue -> TRcvQueues -> STM ()
+deleteQueue :: RcvQueue -> TRcvQueues RcvQueue -> STM ()
 deleteQueue rq (TRcvQueues qs cs) = do
   TM.delete k qs
   TM.update delQ (connId rq) cs
@@ -72,21 +79,25 @@ deleteQueue rq (TRcvQueues qs cs) = do
     delQ = L.nonEmpty . L.filter (/= k)
     k = qKey rq
 
-getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM [RcvQueue]
-getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVar qs
+hasSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> STM Bool
+hasSessQueues tSess (TRcvQueues qs _) = any (`isSession` tSess) <$> readTVar qs
+
+getSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues RcvQueue -> IO [RcvQueue]
+getSessQueues tSess (TRcvQueues qs _) = M.foldl' addQ [] <$> readTVarIO qs
   where
     addQ qs' rq = if rq `isSession` tSess then rq : qs' else qs'
 
-getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> TRcvQueues -> STM ([RcvQueue], [ConnId])
-getDelSessQueues tSess (TRcvQueues qs cs) = do
+getDelSessQueues :: (UserId, SMPServer, Maybe ConnId) -> SessionId -> TRcvQueues (SessionId, RcvQueue) -> STM ([RcvQueue], [ConnId])
+getDelSessQueues tSess sessId' (TRcvQueues qs cs) = do
   (removedQs, qs'') <- (\qs' -> M.foldl' delQ ([], qs') qs') <$> readTVar qs
   writeTVar qs $! qs''
   removedConns <- stateTVar cs $ \cs' -> foldl' delConn ([], cs') removedQs
   pure (removedQs, removedConns)
   where
-    delQ acc@(removed, qs') rq
-      | rq `isSession` tSess = (rq : removed, M.delete (qKey rq) qs')
+    delQ acc@(removed, qs') (sessId, rq)
+      | rq `isSession` tSess && sessId == sessId' = (rq : removed, M.delete (qKey rq) qs')
       | otherwise = acc
+    delConn :: ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, RecipientId))) -> RcvQueue -> ([ConnId], M.Map ConnId (NonEmpty (UserId, SMPServer, RecipientId)))
     delConn (removed, cs') rq = M.alterF f cId cs'
       where
         cId = connId rq
@@ -100,5 +111,10 @@ isSession :: RcvQueue -> (UserId, SMPServer, Maybe ConnId) -> Bool
 isSession rq (uId, srv, connId_) =
   userId rq == uId && server rq == srv && maybe True (connId rq ==) connId_
 
-qKey :: RcvQueue -> (UserId, SMPServer, ConnId)
-qKey rq = (userId rq, server rq, connId rq)
+instance Queue RcvQueue where
+  connId' = connId
+  qKey rq = (userId rq, server rq, rcvId rq)
+
+instance Queue (SessionId, RcvQueue) where
+  connId' = connId . snd
+  qKey = qKey . snd

src/Simplex/Messaging/Client.hs

@@ -47,6 +47,8 @@ module Simplex.Messaging.Client
     subscribeSMPQueueNotifications,
     subscribeSMPQueuesNtfs,
     secureSMPQueue,
+    secureSndSMPQueue,
+    proxySecureSndSMPQueue,
     enableSMPQueueNotifications,
     disableSMPQueueNotifications,
     enableSMPQueuesNtfs,
@@ -56,9 +58,13 @@ module Simplex.Messaging.Client
     suspendSMPQueue,
     deleteSMPQueue,
     deleteSMPQueues,
+    createSMPDataBlob,
+    deleteSMPDataBlob,
+    getSMPDataBlob,
+    proxyGetSMPDataBlob,
     connectSMPProxiedRelay,
     proxySMPMessage,
-    forwardSMPMessage,
+    forwardSMPTransmission,
     getSMPQueueInfo,
     sendProtocolCommand,
 
@@ -100,6 +106,7 @@ module Simplex.Messaging.Client
 where
 
 import Control.Applicative ((<|>))
+import Control.Concurrent (ThreadId, forkFinally, killThread, mkWeakThreadId)
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
@@ -111,6 +118,8 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bitraversable (bimapM)
+import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
@@ -127,7 +136,7 @@ import Numeric.Natural
 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.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.TMap (TMap)
@@ -138,13 +147,14 @@ import Simplex.Messaging.Transport.KeepAlive
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM)
 import Simplex.Messaging.Version
+import System.Mem.Weak (Weak, deRefWeak)
 import System.Timeout (timeout)
 
 -- | 'SMPClient' is a handle used to send commands to a specific SMP server.
 --
 -- Use 'getSMPClient' to connect to an SMP server and create a client handle.
 data ProtocolClient v err msg = ProtocolClient
-  { action :: Maybe (Async ()),
+  { action :: Maybe (Weak ThreadId),
     thParams :: THandleParams v 'TClient,
     sessionTs :: UTCTime,
     client_ :: PClient v err msg
@@ -166,17 +176,17 @@ data PClient v err msg = PClient
     msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
   }
 
-smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> STM SMPClient
+smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> IO SMPClient
 smpClientStub g sessionId thVersion thAuth = do
   let ts = UTCTime (read "2024-03-31") 0
-  connected <- newTVar False
-  clientCorrId <- C.newRandomDRG g
-  sentCommands <- TM.empty
-  sendPings <- newTVar False
-  lastReceived <- newTVar ts
-  timeoutErrorCount <- newTVar 0
-  sndQ <- newTBQueue 100
-  rcvQ <- newTBQueue 100
+  connected <- newTVarIO False
+  clientCorrId <- atomically $ C.newRandomDRG g
+  sentCommands <- TM.emptyIO
+  sendPings <- newTVarIO False
+  lastReceived <- newTVarIO ts
+  timeoutErrorCount <- newTVarIO 0
+  sndQ <- newTBQueueIO 100
+  rcvQ <- newTBQueueIO 100
   return
     ProtocolClient
       { action = Nothing,
@@ -236,10 +246,20 @@ data SocksMode
   = -- | always use SOCKS proxy when enabled
     SMAlways
   | -- | use SOCKS proxy only for .onion hosts when no public host is available
-    -- This mode is used in SMP proxy to minimize SOCKS proxy usage.
+    -- This mode is used in SMP proxy and in notifications server to minimize SOCKS proxy usage.
     SMOnion
   deriving (Eq, Show)
 
+instance StrEncoding SocksMode where
+  strEncode = \case
+    SMAlways -> "always"
+    SMOnion -> "onion"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "always" -> pure SMAlways
+      "onion" -> pure SMOnion
+      _ -> fail "Invalid Socks mode"
+
 -- | network configuration for the client
 data NetworkConfig = NetworkConfig
   { -- | use SOCKS5 proxy
@@ -427,7 +447,8 @@ transportSession' = transportSession . client_
 type UserId = Int64
 
 -- | Transport session key - includes entity ID if `sessionMode = TSMEntity`.
-type TransportSession msg = (UserId, ProtoServer msg, Maybe EntityId)
+-- Please note that for SMP connection ID is used as entity ID, not queue ID.
+type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString)
 
 -- | Connects to 'ProtocolServer' using passed client configuration
 -- and queue for messages and notifications.
@@ -438,21 +459,21 @@ getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> T
 getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
-      (getCurrentTime >>= atomically . mkProtocolClient useHost >>= runClient useTransport useHost)
+      (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
         `catch` \(e :: IOException) -> pure . Left $ PCEIOError e
     Left e -> pure $ Left e
   where
     NetworkConfig {tcpConnectTimeout, tcpTimeout, smpPingInterval} = networkConfig
-    mkProtocolClient :: TransportHost -> UTCTime -> STM (PClient v err msg)
+    mkProtocolClient :: TransportHost -> UTCTime -> IO (PClient v err msg)
     mkProtocolClient transportHost ts = do
-      connected <- newTVar False
-      sendPings <- newTVar False
-      lastReceived <- newTVar ts
-      timeoutErrorCount <- newTVar 0
-      clientCorrId <- C.newRandomDRG g
-      sentCommands <- TM.empty
-      sndQ <- newTBQueue qSize
-      rcvQ <- newTBQueue qSize
+      connected <- newTVarIO False
+      sendPings <- newTVarIO False
+      lastReceived <- newTVarIO ts
+      timeoutErrorCount <- newTVarIO 0
+      clientCorrId <- atomically $ C.newRandomDRG g
+      sentCommands <- TM.emptyIO
+      sndQ <- newTBQueueIO qSize
+      rcvQ <- newTBQueueIO qSize
       return
         PClient
           { connected,
@@ -475,15 +496,14 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
       cVar <- newEmptyTMVarIO
       let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN}
           username = proxyUsername transportSession
-      action <-
-        async $
-          runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
-            `finally` atomically (tryPutTMVar cVar $ Left PCENetworkError)
+      tId <-
+        runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar)
+          `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError)
       c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar)
       case c_ of
-        Just (Right c') -> pure $ Right c' {action = Just action}
+        Just (Right c') -> mkWeakThreadId tId >>= \tId' -> pure $ Right c' {action = Just tId'}
         Just (Left e) -> pure $ Left e
-        Nothing -> cancel action $> Left PCENetworkError
+        Nothing -> killThread tId $> Left PCENetworkError
 
     useTransport :: (ServiceName, ATransport)
     useTransport = case port srv of
@@ -531,7 +551,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
           if remaining > 1_000_000 -- delay pings only for significant time
             then loop remaining
             else do
-              whenM (readTVarIO sendPings) $ void . runExceptT $ sendProtocolCommand c Nothing "" (protocolPing @v @err @msg)
+              whenM (readTVarIO sendPings) $ void . runExceptT $ sendProtocolCommand c Nothing NoEntity (protocolPing @v @err @msg)
               -- sendProtocolCommand/getResponse updates counter for each command
               cnt <- readTVarIO timeoutErrorCount
               -- drop client when maxCnt of commands have timed out in sequence, but only after some time has passed after last received response
@@ -552,7 +572,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
     processMsg ProtocolClient {client_ = PClient {sentCommands}} (_, _, (corrId, entId, respOrErr))
       | B.null $ bs corrId = sendMsg $ STEvent clientResp
       | otherwise =
-          atomically (TM.lookup corrId sentCommands) >>= \case
+          TM.lookupIO corrId sentCommands >>= \case
             Nothing -> sendMsg $ STUnexpectedError unexpected
             Just Request {entityId, command, pending, responseVar} -> do
               wasPending <-
@@ -589,7 +609,7 @@ proxyUsername (userId, _, entityId_) = C.sha256Hash $ bshow userId <> maybe "" (
 
 -- | Disconnects client from the server and terminates client threads.
 closeProtocolClient :: ProtocolClient v err msg -> IO ()
-closeProtocolClient = mapM_ uninterruptibleCancel . action
+closeProtocolClient = mapM_ (deRefWeak >=> mapM_ killThread) . action
 {-# INLINE closeProtocolClient #-}
 
 -- | SMP client error type.
@@ -654,9 +674,10 @@ createSMPQueue ::
   RcvPublicDhKey ->
   Maybe BasicAuth ->
   SubscriptionMode ->
+  Bool ->
   ExceptT SMPClientError IO QueueIdsKeys
-createSMPQueue c (rKey, rpKey) dhKey auth subMode =
-  sendSMPCommand c (Just rpKey) "" (NEW rKey dhKey auth subMode) >>= \case
+createSMPQueue c (rKey, rpKey) dhKey auth subMode sndSecure =
+  sendSMPCommand c (Just rpKey) NoEntity (NEW rKey dhKey auth subMode sndSecure) >>= \case
     IDS qik -> pure qik
     r -> throwE $ unexpectedResponse r
 
@@ -728,6 +749,20 @@ secureSMPQueue :: SMPClient -> RcvPrivateAuthKey -> RecipientId -> SndPublicAuth
 secureSMPQueue c rpKey rId senderKey = okSMPCommand (KEY senderKey) c rpKey rId
 {-# INLINE secureSMPQueue #-}
 
+-- | Secure the SMP queue via sender queue ID.
+secureSndSMPQueue :: SMPClient -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO ()
+secureSndSMPQueue c spKey sId senderKey = okSMPCommand (SKEY senderKey) c spKey sId
+{-# INLINE secureSndSMPQueue #-}
+
+proxySecureSndSMPQueue :: SMPClient -> ProxiedRelay -> SndPrivateAuthKey -> SenderId -> SndPublicAuthKey -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySecureSndSMPQueue c proxiedRelay spKey sId senderKey = proxySMPCommand c proxiedRelay (Just spKey) sId (SKEY senderKey) okResult
+{-# INLINE proxySecureSndSMPQueue #-}
+
+okResult :: BrokerMsg -> Maybe ()
+okResult = \case
+  OK -> Just ()
+  _ -> Nothing
+
 -- | Enable notifications for the queue for push notifications server.
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command
@@ -768,6 +803,9 @@ sendSMPMessage c spKey sId flags msg =
     OK -> pure ()
     r -> throwE $ unexpectedResponse r
 
+proxySMPMessage :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> MsgFlags -> MsgBody -> ExceptT SMPClientError IO (Either ProxyClientError ())
+proxySMPMessage c proxiedRelay spKey sId flags msg = proxySMPCommand c proxiedRelay spKey sId (SEND flags msg) okResult
+
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
@@ -798,16 +836,53 @@ deleteSMPQueues :: SMPClient -> NonEmpty (RcvPrivateAuthKey, RecipientId) -> IO
 deleteSMPQueues = okSMPCommands DEL
 {-# INLINE deleteSMPQueues #-}
 
+createSMPDataBlob :: SMPClient -> C.AAuthKeyPair -> BlobId -> DataBlob -> ExceptT SMPClientError IO ()
+createSMPDataBlob c (dKey, dpKey) dId blob = okSMPCommand (WRT dKey blob) c dpKey dId
+{-# INLINE createSMPDataBlob #-}
+
+deleteSMPDataBlob :: SMPClient -> DataPrivateAuthKey -> BlobId -> ExceptT SMPClientError IO ()
+deleteSMPDataBlob = okSMPCommand CLR
+{-# INLINE deleteSMPDataBlob #-}
+
+-- pk is the private key passed to the client out of band.
+-- Associated public key is used as ID to retrieve data blob
+getSMPDataBlob :: SMPClient -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO DataBlob
+getSMPDataBlob c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} pk = do
+  serverKey <- case thAuth thParams of
+    Nothing -> throwE $ PCETransportError TENoServerAuth
+    Just THAuthClient {serverPeerPubKey = k} -> pure k
+  nonce <- liftIO . atomically $ C.randomCbNonce g
+  let dId = EntityId $ BA.convert $ C.pubKeyBytes $ C.publicKey pk
+  sendProtocolCommand_ c (Just nonce) Nothing Nothing dId (Cmd SSender READ) >>= \case
+    DATA encBlob -> decryptDataBlob serverKey pk nonce encBlob
+    r -> throwE $ unexpectedResponse r
+
+proxyGetSMPDataBlob :: SMPClient -> ProxiedRelay -> C.PrivateKeyX25519 -> ExceptT SMPClientError IO (Either ProxyClientError DataBlob)
+proxyGetSMPDataBlob c@ProtocolClient {client_ = PClient {clientCorrId = g}} proxiedRelay@ProxiedRelay {prServerKey} pk = do
+  nonce <- liftIO . atomically $ C.randomCbNonce g
+  let dId = EntityId $ BA.convert $ C.pubKeyBytes $ C.publicKey pk
+  encBlob_ <-
+    proxySMPCommand_ c (Just nonce) proxiedRelay Nothing dId READ $ \case
+      DATA encBlob -> Just encBlob
+      _ -> Nothing
+  bimapM pure (decryptDataBlob prServerKey pk nonce) encBlob_
+
+decryptDataBlob :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> ExceptT (ProtocolClientError ErrorType) IO DataBlob
+decryptDataBlob serverKey pk nonce encBlob = do
+  let ss = C.dh' serverKey pk
+  blobStr <- liftEitherWith PCECryptoError $ C.cbDecrypt ss nonce encBlob
+  liftEitherWith (const $ PCEResponseError BLOCK) $ smpDecode blobStr
+
 -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender
 -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg
 connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay
 connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, tcpTimeout}} relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth
   | thVersion (thParams c) >= sendingProxySMPVersion =
-      sendProtocolCommand_ c Nothing tOut Nothing "" (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
+      sendProtocolCommand_ c Nothing tOut Nothing NoEntity (Cmd SProxiedClient (PRXY relayServ proxyAuth)) >>= \case
         PKEY sId vr (chain, key) ->
           case supportedClientSMPRelayVRange `compatibleVersion` vr of
             Nothing -> throwE $ transportErr TEVersion
-            Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v <$> validateRelay chain key
+            Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v proxyAuth <$> validateRelay chain key
         r -> throwE $ unexpectedResponse r
   | otherwise = throwE $ PCETransportError TEVersion
   where
@@ -826,16 +901,17 @@ connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, t
 data ProxiedRelay = ProxiedRelay
   { prSessionId :: SessionId,
     prVersion :: VersionSMP,
+    prBasicAuth :: Maybe BasicAuth, -- auth is included here to allow reconnecting via the same proxy after NO_SESSION error
     prServerKey :: C.PublicKeyX25519
   }
 
 data ProxyClientError
   = -- | protocol error response from proxy
-    ProxyProtocolError ErrorType
+    ProxyProtocolError {protocolErr :: ErrorType}
   | -- | unexpexted response
-    ProxyUnexpectedResponse String
+    ProxyUnexpectedResponse {responseStr :: String}
   | -- | error between proxy and server
-    ProxyResponseError ErrorType
+    ProxyResponseError {responseErr :: ErrorType}
   deriving (Eq, Show, Exception)
 
 instance StrEncoding ProxyClientError where
@@ -850,6 +926,9 @@ instance StrEncoding ProxyClientError where
       "SYNTAX" -> ProxyResponseError <$> _strP
       _ -> fail "bad ProxyClientError"
 
+proxySMPCommand :: SMPClient -> ProxiedRelay -> Maybe SndPrivateAuthKey -> SenderId -> Command 'Sender -> (BrokerMsg -> Maybe r) -> ExceptT SMPClientError IO (Either ProxyClientError r)
+proxySMPCommand c = proxySMPCommand_ c Nothing
+
 -- consider how to process slow responses - is it handled somehow locally or delegated to the caller
 -- this method is used in the client
 -- sends PFWD :: C.PublicKeyX25519 -> EncTransmission -> Command Sender
@@ -869,42 +948,45 @@ instance StrEncoding ProxyClientError where
 -- 8) PFWD(SEND) -> WTF  -> ProxyUnexpectedResponse - client/proxy protocol logic
 -- 9) PFWD(SEND) -> ???  -> ProxyResponseError - client/proxy syntax
 --
--- We report as proxySMPMessage error (ExceptT error) the errors of two kinds:
+-- We report as proxySMPCommand error (ExceptT error) the errors of two kinds:
 -- - protocol errors from the destination relay wrapped in PRES - to simplify processing of AUTH and QUOTA errors, in this case proxy is "transparent" for such errors (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
 -- - other response/transport/connection errors from the client connected to proxy itself
 -- Other errors are reported in the function result as `Either ProxiedRelayError ()`, including
 -- - protocol  errors from the client connected to proxy in ProxyClientError (PCEProtocolError, PCEUnexpectedResponse, PCEResponseError)
 -- - other errors from the client running on proxy and connected to relay in PREProxiedRelayError
 
-proxySMPMessage ::
+-- This function proxies Sender commands that return OK or ERR
+proxySMPCommand_ ::
   SMPClient ->
+  -- optional correlation ID/nonce for the sending client
+  Maybe C.CbNonce ->
   -- proxy session from PKEY
   ProxiedRelay ->
-  -- message to deliver
+  -- command to deliver
   Maybe SndPrivateAuthKey ->
   SenderId ->
-  MsgFlags ->
-  MsgBody ->
-  ExceptT SMPClientError IO (Either ProxyClientError ())
-proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} (ProxiedRelay sessionId v serverKey) spKey sId flags msg = do
+  Command 'Sender ->
+  (BrokerMsg -> Maybe r) ->
+  ExceptT SMPClientError IO (Either ProxyClientError r)
+proxySMPCommand_ c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g, tcpTimeout}} nonce_ (ProxiedRelay sessionId v _ serverKey) spKey sId command toResult = do
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
   (cmdPubKey, cmdPrivKey) <- liftIO . atomically $ C.generateKeyPair @'C.X25519 g
   let cmdSecret = C.dh' serverKey cmdPrivKey
-  nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
+  nonce@(C.CbNonce corrId) <- liftIO $ maybe (atomically $ C.randomCbNonce g) pure nonce_
   -- encode
-  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender (SEND flags msg))
+  let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command)
   auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
   b <- case batchTransmissions (batch serverThParams) (blockSize serverThParams) [Right (auth, tToSend)] of
     [] -> throwE $ PCETransportError TELargeMsg
     TBError e _ : _ -> throwE $ PCETransportError e
     TBTransmission s _ : _ -> pure s
     TBTransmissions s _ _ : _ -> pure s
-  et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedMsgLength
+  et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedTLength
   -- proxy interaction errors are wrapped
   let tOut = Just $ 2 * tcpTimeout
-  tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing sessionId (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
+  tryE (sendProtocolCommand_ c (Just nonce) tOut Nothing (EntityId sessionId) (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
     Right r -> case r of
       PRES (EncResponse er) -> do
         -- server interaction errors are thrown directly
@@ -912,9 +994,11 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
         case tParse serverThParams t' of
           t'' :| [] -> case tDecodeParseValidate serverThParams t'' of
             (_auth, _signed, (_c, _e, cmd)) -> case cmd of
-              Right OK -> pure $ Right ()
-              Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
-              Right r' -> throwE $ unexpectedResponse r'
+              Right r' -> case toResult r' of
+                Just r'' -> pure $ Right r''
+                Nothing -> case r' of
+                  ERR e -> throwE $ PCEProtocolError e -- this is the error from the destination relay
+                  _ -> throwE $ unexpectedResponse r'
               Left e -> throwE $ PCEResponseError e
           _ -> throwE $ PCETransportError TEBadBlock
       ERR e -> pure . Left $ ProxyProtocolError e -- this will not happen, this error is returned via Left
@@ -929,18 +1013,18 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
 -- sends RFWD :: EncFwdTransmission -> Command Sender
 -- receives RRES :: EncFwdResponse -> BrokerMsg
 -- proxy should send PRES to the client with EncResponse
-forwardSMPMessage :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
-forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
+forwardSMPTransmission :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
+forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
   -- prepare params
   sessSecret <- case thAuth thParams of
-    Nothing -> throwError $ PCETransportError TENoServerAuth
-    Just THAuthClient {sessSecret} -> maybe (throwError $ PCETransportError TENoServerAuth) pure sessSecret
+    Nothing -> throwE $ PCETransportError TENoServerAuth
+    Just THAuthClient {sessSecret} -> maybe (throwE $ PCETransportError TENoServerAuth) pure sessSecret
   nonce <- liftIO . atomically $ C.randomCbNonce g
   -- wrap
   let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
       eft = EncFwdTransmission $ C.cbEncryptNoPad sessSecret nonce (smpEncode fwdT)
   -- send
-  sendProtocolCommand_ c (Just nonce) Nothing Nothing "" (Cmd SSender (RFWD eft)) >>= \case
+  sendProtocolCommand_ c (Just nonce) Nothing Nothing NoEntity (Cmd SSender (RFWD eft)) >>= \case
     RRES (EncFwdResponse efr) -> do
       -- unwrap
       r' <- liftEitherWith PCECryptoError $ C.cbDecryptNoPad sessSecret (C.reverseNonce nonce) efr
@@ -988,7 +1072,7 @@ sendProtocolCommands c@ProtocolClient {thParams = THandleParams {batch, blockSiz
       | diff == 0 = pure $ L.fromList rs
       | diff > 0 = do
           putStrLn "send error: fewer responses than expected"
-          pure $ L.fromList $ rs <> replicate diff (Response "" $ Left $ PCETransportError TEBadBlock)
+          pure $ L.fromList $ rs <> replicate diff (Response NoEntity $ Left $ PCETransportError TEBadBlock)
       | otherwise = do
           putStrLn "send error: more responses than expected"
           pure $ L.fromList $ take (L.length cs) rs
@@ -1062,13 +1146,13 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
   nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
       auth = authTransmission (thAuth thParams) pKey_ nonce tForAuth
-  r <- atomically $ mkRequest (CorrId corrId)
+  r <- mkRequest (CorrId corrId)
   pure ((,tToSend) <$> auth, r)
   where
-    mkRequest :: CorrId -> STM (Request err msg)
+    mkRequest :: CorrId -> IO (Request err msg)
     mkRequest corrId = do
-      pending <- newTVar True
-      responseVar <- newEmptyTMVar
+      pending <- newTVarIO True
+      responseVar <- newEmptyTMVarIO
       let r =
             Request
               { corrId,
@@ -1077,7 +1161,7 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
                 pending,
                 responseVar
               }
-      TM.insert corrId r sentCommands
+      atomically $ TM.insert corrId r sentCommands
       pure r
 
 authTransmission :: Maybe (THandleAuth 'TClient) -> Maybe C.APrivateAuthKey -> C.CbNonce -> ByteString -> Either TransportError (Maybe TransmissionAuth)
@@ -1123,6 +1207,6 @@ $(J.deriveJSON (enumJSON $ dropPrefix "SPF") ''SMPProxyFallback)
 
 $(J.deriveJSON defaultJSON ''NetworkConfig)
 
-$(J.deriveJSON (enumJSON $ dropPrefix "Proxy") ''ProxyClientError)
+$(J.deriveJSON (sumTypeJSON $ dropPrefix "Proxy") ''ProxyClientError)
 
 $(J.deriveJSON defaultJSON ''TBQueueInfo)

src/Simplex/Messaging/Client/Agent.hs

@@ -1,8 +1,7 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -21,17 +20,15 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
-import Data.Bifunctor (bimap, first)
+import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Either (partitionEithers)
-import Data.List (partition)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (listToMaybe)
 import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text.Encoding
 import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
 import Data.Tuple (swap)
@@ -56,8 +53,8 @@ type SMPClientVar = SessionVar (Either (SMPClientError, Maybe UTCTime) (OwnServe
 data SMPClientAgentEvent
   = CAConnected SMPServer
   | CADisconnected SMPServer (Set SMPSub)
-  | CAResubscribed SMPServer (NonEmpty SMPSub)
-  | CASubError SMPServer (NonEmpty (SMPSub, SMPClientError))
+  | CASubscribed SMPServer SMPSubParty (NonEmpty QueueId)
+  | CASubError SMPServer SMPSubParty (NonEmpty (QueueId, SMPClientError))
 
 data SMPSubParty = SPRecipient | SPNotifier
   deriving (Eq, Ord, Show)
@@ -87,9 +84,9 @@ defaultSMPClientAgentConfig =
             maxInterval = 10 * second
           },
       persistErrorInterval = 30, -- seconds
-      msgQSize = 256,
-      agentQSize = 256,
-      agentSubsBatchSize = 900,
+      msgQSize = 1024,
+      agentQSize = 1024,
+      agentSubsBatchSize = 1360,
       ownServerDomains = []
     }
   where
@@ -103,7 +100,7 @@ data SMPClientAgent = SMPClientAgent
     randomDrg :: TVar ChaChaDRG,
     smpClients :: TMap SMPServer SMPClientVar,
     smpSessions :: TMap SessionId (OwnServer, SMPClient),
-    srvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
+    srvSubs :: TMap SMPServer (TMap SMPSub (SessionId, C.APrivateAuthKey)),
     pendingSrvSubs :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey),
     smpSubWorkers :: TMap SMPServer (SessionVar (Async ())),
     workerSeq :: TVar Int
@@ -111,17 +108,17 @@ data SMPClientAgent = SMPClientAgent
 
 type OwnServer = Bool
 
-newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> STM SMPClientAgent
+newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
-  active <- newTVar True
-  msgQ <- newTBQueue msgQSize
-  agentQ <- newTBQueue agentQSize
-  smpClients <- TM.empty
-  smpSessions <- TM.empty
-  srvSubs <- TM.empty
-  pendingSrvSubs <- TM.empty
-  smpSubWorkers <- TM.empty
-  workerSeq <- newTVar 0
+  active <- newTVarIO True
+  msgQ <- newTBQueueIO msgQSize
+  agentQ <- newTBQueueIO agentQSize
+  smpClients <- TM.emptyIO
+  smpSessions <- TM.emptyIO
+  srvSubs <- TM.emptyIO
+  pendingSrvSubs <- TM.emptyIO
+  smpSubWorkers <- TM.emptyIO
+  workerSeq <- newTVarIO 0
   pure
     SMPClientAgent
       { agentCfg,
@@ -171,7 +168,8 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
       case r of
         Right smp -> do
           logInfo . decodeUtf8 $ "Agent connected to " <> showServer srv
-          let c = (isOwnServer ca srv, smp)
+          let !owned = isOwnServer ca srv
+              !c = (owned, smp)
           atomically $ do
             putTMVar (sessionVar v) (Right c)
             TM.insert (sessionId $ thParams smp) c smpSessions
@@ -192,7 +190,7 @@ getSMPServerClient'' ca@SMPClientAgent {agentCfg, smpClients, smpSessions, worke
 isOwnServer :: SMPClientAgent -> SMPServer -> OwnServer
 isOwnServer SMPClientAgent {agentCfg} ProtocolServer {host} =
   let srv = strEncode $ L.head host
-   in any (\s -> s == srv || (B.cons '.' s) `B.isSuffixOf` srv) (ownServerDomains agentCfg)
+   in any (\s -> s == srv || B.cons '.' s `B.isSuffixOf` srv) (ownServerDomains agentCfg)
 
 -- | Run an SMP client for SMPClientVar
 connectClient :: SMPClientAgent -> SMPServer -> SMPClientVar -> IO (Either SMPClientError SMPClient)
@@ -206,20 +204,17 @@ connectClient ca@SMPClientAgent {agentCfg, smpClients, smpSessions, msgQ, random
 
     removeClientAndSubs :: SMPClient -> IO (Maybe (Map SMPSub C.APrivateAuthKey))
     removeClientAndSubs smp = atomically $ do
+      TM.delete sessId smpSessions
       removeSessVar v srv smpClients
-      TM.delete (sessionId $ thParams smp) smpSessions
-      TM.lookupDelete srv (srvSubs ca) >>= mapM updateSubs
+      TM.lookup srv (srvSubs ca) >>= mapM updateSubs
       where
+        sessId = sessionId $ thParams smp
         updateSubs sVar = do
-          ss <- readTVar sVar
-          addPendingSubs sVar ss
-          pure ss
-
-        addPendingSubs sVar ss = do
-          let ps = pendingSrvSubs ca
-          TM.lookup srv ps >>= \case
-            Just ss' -> TM.union ss ss'
-            _ -> TM.insert srv sVar ps
+          -- removing subscriptions that have matching sessionId to disconnected client
+          -- and keep the other ones (they can be made by the new client)
+          pending <- M.map snd <$> stateTVar sVar (M.partition ((sessId ==) . fst))
+          addSubs_ (pendingSrvSubs ca) srv pending
+          pure pending
 
     serverDown :: Map SMPSub C.APrivateAuthKey -> IO ()
     serverDown ss = unless (M.null ss) $ do
@@ -234,7 +229,7 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
   where
     getWorkerVar ts =
       ifM
-        (null <$> getPending)
+        (noPending)
         (pure Nothing) -- prevent race with cleanup and adding pending queues in another call
         (Just <$> getSessVar workerSeq srv smpSubWorkers ts)
     newSubWorker :: SessionVar (Async ()) -> IO ()
@@ -243,12 +238,13 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
       atomically $ putTMVar (sessionVar v) a
     runSubWorker =
       withRetryInterval (reconnectInterval agentCfg) $ \_ loop -> do
-        pending <- atomically getPending
-        forM_ pending $ \cs -> whenM (readTVarIO active) $ do
-          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv cs)
+        pending <- liftIO getPending
+        unless (null pending) $ whenM (readTVarIO active) $ do
+          void $ tcpConnectTimeout `timeout` runExceptT (reconnectSMPClient ca srv pending)
           loop
     ProtocolClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = smpCfg agentCfg
-    getPending = mapM readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+    noPending = maybe (pure True) (fmap M.null . readTVar) =<< TM.lookup srv (pendingSrvSubs ca)
+    getPending = maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (pendingSrvSubs ca)
     cleanup :: SessionVar (Async ()) -> STM ()
     cleanup v = do
       -- Here we wait until TMVar is not empty to prevent worker cleanup happening before worker is added to TMVar.
@@ -258,32 +254,22 @@ reconnectClient ca@SMPClientAgent {active, agentCfg, smpSubWorkers, workerSeq} s
 
 reconnectSMPClient :: SMPClientAgent -> SMPServer -> Map SMPSub C.APrivateAuthKey -> ExceptT SMPClientError IO ()
 reconnectSMPClient ca@SMPClientAgent {agentCfg} srv cs =
-  withSMP ca srv $ \smp -> do
-    subs' <- filterM (fmap not . atomically . hasSub (srvSubs ca) srv . fst) $ M.assocs cs
-    let (nSubs, rSubs) = partition (isNotifier . fst . fst) subs'
+  withSMP ca srv $ \smp -> liftIO $ do
+    currSubs <- maybe (pure M.empty) readTVarIO =<< TM.lookupIO srv (srvSubs ca)
+    let (nSubs, rSubs) = foldr (groupSub currSubs) ([], []) $ M.assocs cs
     subscribe_ smp SPNotifier nSubs
     subscribe_ smp SPRecipient rSubs
   where
-    isNotifier = \case
-      SPNotifier -> True
-      SPRecipient -> False
-    subscribe_ :: SMPClient -> SMPSubParty -> [(SMPSub, C.APrivateAuthKey)] -> ExceptT SMPClientError IO ()
-    subscribe_ smp party = mapM_ subscribeBatch . toChunks (agentSubsBatchSize agentCfg)
+    groupSub :: Map SMPSub (SessionId, C.APrivateAuthKey) -> (SMPSub, C.APrivateAuthKey) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)]) -> ([(QueueId, C.APrivateAuthKey)], [(QueueId, C.APrivateAuthKey)])
+    groupSub currSubs (s@(party, qId), k) acc@(nSubs, rSubs)
+      | M.member s currSubs = acc
+      | otherwise = case party of
+          SPNotifier -> (s' : nSubs, rSubs)
+          SPRecipient -> (nSubs, s' : rSubs)
       where
-        subscribeBatch subs' = do
-          let subs'' :: (NonEmpty (QueueId, C.APrivateAuthKey)) = L.map (first snd) subs'
-          rs <- liftIO $ smpSubscribeQueues party ca smp srv subs''
-          let rs' :: (NonEmpty ((SMPSub, C.APrivateAuthKey), Either SMPClientError ())) =
-                L.zipWith (first . const) subs' rs
-              rs'' :: [Either (SMPSub, SMPClientError) (SMPSub, C.APrivateAuthKey)] =
-                map (\(sub, r) -> bimap (fst sub,) (const sub) r) $ L.toList rs'
-              (errs, oks) = partitionEithers rs''
-              (tempErrs, finalErrs) = partition (temporaryClientError . snd) errs
-          mapM_ (atomically . addSubscription ca srv) oks
-          mapM_ (notify ca . CAResubscribed srv) $ L.nonEmpty $ map fst oks
-          mapM_ (atomically . removePendingSubscription ca srv . fst) finalErrs
-          mapM_ (notify ca . CASubError srv) $ L.nonEmpty finalErrs
-          mapM_ (throwE . snd) $ listToMaybe tempErrs
+        s' = (qId, k)
+    subscribe_ :: SMPClient -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> IO ()
+    subscribe_ smp party = mapM_ (smpSubscribeQueues party ca smp srv) . toChunks (agentSubsBatchSize agentCfg)
 
 notify :: MonadIO m => SMPClientAgent -> SMPClientAgentEvent -> m ()
 notify ca evt = atomically $ writeTBQueue (agentQ ca) evt
@@ -297,14 +283,15 @@ getConnectedSMPServerClient SMPClientAgent {smpClients} srv =
     $>>= \case
       (_, Right r) -> pure $ Just $ Right r
       (v, Left (e, ts_)) ->
-        pure ts_ $>>= \ts ->  -- proxy will create a new connection if ts_ is Nothing
+        pure ts_ $>>= \ts ->
+          -- proxy will create a new connection if ts_ is Nothing
           ifM
             ((ts <) <$> liftIO getCurrentTime) -- error persistence interval period expired?
             (Nothing <$ atomically (removeSessVar v srv smpClients)) -- proxy will create a new connection
             (pure $ Just $ Left e) -- not expired, returning error
 
-lookupSMPServerClient :: SMPClientAgent -> SessionId -> STM (Maybe (OwnServer, SMPClient))
-lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookup sessId smpSessions
+lookupSMPServerClient :: SMPClientAgent -> SessionId -> IO (Maybe (OwnServer, SMPClient))
+lookupSMPServerClient SMPClientAgent {smpSessions} sessId = TM.lookupIO sessId smpSessions
 
 closeSMPClientAgent :: SMPClientAgent -> IO ()
 closeSMPClientAgent c = do
@@ -334,86 +321,102 @@ withSMP ca srv action = (getSMPServerClient' ca srv >>= action) `catchE` logSMPE
       liftIO $ putStrLn $ "SMP error (" <> show srv <> "): " <> show e
       throwE e
 
-subscribeQueue :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> ExceptT SMPClientError IO ()
-subscribeQueue ca srv sub = do
-  atomically $ addPendingSubscription ca srv sub
-  withSMP ca srv $ \smp -> subscribe_ smp `catchE` handleErr
-  where
-    subscribe_ smp = do
-      smpSubscribe smp sub
-      atomically $ addSubscription ca srv sub
-
-    handleErr e = do
-      atomically . when (e /= PCENetworkError && e /= PCEResponseTimeout) $
-        removePendingSubscription ca srv (fst sub)
-      throwE e
-
-subscribeQueuesSMP :: SMPClientAgent -> SMPServer -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO (NonEmpty (RecipientId, Either SMPClientError ()))
+subscribeQueuesSMP :: SMPClientAgent -> SMPServer -> NonEmpty (RecipientId, RcvPrivateAuthKey) -> IO ()
 subscribeQueuesSMP = subscribeQueues_ SPRecipient
 
-subscribeQueuesNtfs :: SMPClientAgent -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO (NonEmpty (NotifierId, Either SMPClientError ()))
+subscribeQueuesNtfs :: SMPClientAgent -> SMPServer -> NonEmpty (NotifierId, NtfPrivateAuthKey) -> IO ()
 subscribeQueuesNtfs = subscribeQueues_ SPNotifier
 
-subscribeQueues_ :: SMPSubParty -> SMPClientAgent -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO (NonEmpty (QueueId, Either SMPClientError ()))
+subscribeQueues_ :: SMPSubParty -> SMPClientAgent -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
 subscribeQueues_ party ca srv subs = do
-  atomically $ forM_ subs $ addPendingSubscription ca srv . first (party,)
+  atomically $ addPendingSubs ca srv party $ L.toList subs
   runExceptT (getSMPServerClient' ca srv) >>= \case
-    Left e -> pure $ L.map ((,Left e) . fst) subs
     Right smp -> smpSubscribeQueues party ca smp srv subs
+    Left _ -> pure () -- no call to reconnectClient - failing getSMPServerClient' does that
 
-smpSubscribeQueues :: SMPSubParty -> SMPClientAgent -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO (NonEmpty (QueueId, Either SMPClientError ()))
+smpSubscribeQueues :: SMPSubParty -> SMPClientAgent -> SMPClient -> SMPServer -> NonEmpty (QueueId, C.APrivateAuthKey) -> IO ()
 smpSubscribeQueues party ca smp srv subs = do
-  rs <- L.zip subs <$> subscribe smp (L.map swap subs)
-  atomically $ forM rs $ \(sub, r) ->
-    (fst sub,) <$> case r of
-      Right () -> do
-        addSubscription ca srv $ first (party,) sub
-        pure $ Right ()
-      Left e -> do
-        when (e /= PCENetworkError && e /= PCEResponseTimeout) $
-          removePendingSubscription ca srv (party, fst sub)
-        pure $ Left e
+  rs <- subscribe smp $ L.map swap subs
+  rs' <-
+    atomically $
+      ifM
+        (activeClientSession ca smp srv)
+        (Just <$> processSubscriptions rs)
+        (pure Nothing)
+  case rs' of
+    Just (tempErrs, finalErrs, oks, _) -> do
+      notify_ CASubscribed $ map fst oks
+      notify_ CASubError finalErrs
+      when tempErrs $ reconnectClient ca srv
+    Nothing -> reconnectClient ca srv
   where
+    processSubscriptions :: NonEmpty (Either SMPClientError ()) -> STM (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
+    processSubscriptions rs = do
+      pending <- maybe (pure M.empty) readTVar =<< TM.lookup srv (pendingSrvSubs ca)
+      let acc@(_, _, oks, notPending) = foldr (groupSub pending) (False, [], [], []) (L.zip subs rs)
+      unless (null oks) $ addSubscriptions ca srv party oks
+      unless (null notPending) $ removePendingSubs ca srv party notPending
+      pure acc
+    sessId = sessionId $ thParams smp
+    groupSub :: Map SMPSub C.APrivateAuthKey -> ((QueueId, C.APrivateAuthKey), Either SMPClientError ()) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId]) -> (Bool, [(QueueId, SMPClientError)], [(QueueId, (SessionId, C.APrivateAuthKey))], [QueueId])
+    groupSub pending ((qId, pk), r) acc@(!tempErrs, finalErrs, oks, notPending) = case r of
+      Right ()
+        | M.member (party, qId) pending -> (tempErrs, finalErrs, (qId, (sessId, pk)) : oks, qId : notPending)
+        | otherwise -> acc
+      Left e
+        | temporaryClientError e -> (True, finalErrs, oks, notPending)
+        | otherwise -> (tempErrs, (qId, e) : finalErrs, oks, qId : notPending)
     subscribe = case party of
       SPRecipient -> subscribeSMPQueues
       SPNotifier -> subscribeSMPQueuesNtfs
+    notify_ :: (SMPServer -> SMPSubParty -> NonEmpty a -> SMPClientAgentEvent) -> [a] -> IO ()
+    notify_ evt qs = mapM_ (notify ca . evt srv party) $ L.nonEmpty qs
+
+activeClientSession' :: SMPClientAgent -> SessionId -> SMPServer -> STM Bool
+activeClientSession' ca sessId srv = sameSess <$> tryReadSessVar srv (smpClients ca)
+  where
+    sameSess = \case
+      Just (Right (_, smp')) -> sessId == sessionId (thParams smp')
+      _ -> False
+
+activeClientSession :: SMPClientAgent -> SMPClient -> SMPServer -> STM Bool
+activeClientSession ca = activeClientSession' ca . sessionId . thParams
 
 showServer :: SMPServer -> ByteString
 showServer ProtocolServer {host, port} =
   strEncode host <> B.pack (if null port then "" else ':' : port)
 
-smpSubscribe :: SMPClient -> (SMPSub, C.APrivateAuthKey) -> ExceptT SMPClientError IO ()
-smpSubscribe smp ((party, queueId), privKey) = subscribe_ smp privKey queueId
+addSubscriptions :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, (SessionId, C.APrivateAuthKey))] -> STM ()
+addSubscriptions = addSubsList_ . srvSubs
+{-# INLINE addSubscriptions #-}
+
+addPendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [(QueueId, C.APrivateAuthKey)] -> STM ()
+addPendingSubs = addSubsList_ . pendingSrvSubs
+{-# INLINE addPendingSubs #-}
+
+addSubsList_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSubParty -> [(QueueId, s)] -> STM ()
+addSubsList_ subs srv party ss = addSubs_ subs srv ss'
   where
-    subscribe_ = case party of
-      SPRecipient -> subscribeSMPQueue
-      SPNotifier -> subscribeSMPQueueNotifications
+    ss' = M.fromList $ map (first (party,)) ss
 
-addSubscription :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> STM ()
-addSubscription ca srv sub = do
-  addSub_ (srvSubs ca) srv sub
-  removePendingSubscription ca srv $ fst sub
-
-addPendingSubscription :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> STM ()
-addPendingSubscription = addSub_ . pendingSrvSubs
-
-addSub_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> (SMPSub, C.APrivateAuthKey) -> STM ()
-addSub_ subs srv (s, key) =
+addSubs_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> Map SMPSub s -> STM ()
+addSubs_ subs srv ss =
   TM.lookup srv subs >>= \case
-    Just m -> TM.insert s key m
-    _ -> TM.singleton s key >>= \v -> TM.insert srv v subs
+    Just m -> TM.union ss m
+    _ -> newTVar ss >>= \v -> TM.insert srv v subs
 
 removeSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
 removeSubscription = removeSub_ . srvSubs
+{-# INLINE removeSubscription #-}
 
-removePendingSubscription :: SMPClientAgent -> SMPServer -> SMPSub -> STM ()
-removePendingSubscription = removeSub_ . pendingSrvSubs
-
-removeSub_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM ()
+removeSub_ :: TMap SMPServer (TMap SMPSub s) -> SMPServer -> SMPSub -> STM ()
 removeSub_ subs srv s = TM.lookup srv subs >>= mapM_ (TM.delete s)
 
-getSubKey :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM (Maybe C.APrivateAuthKey)
-getSubKey subs srv s = TM.lookup srv subs $>>= TM.lookup s
+removePendingSubs :: SMPClientAgent -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
+removePendingSubs = removeSubs_ . pendingSrvSubs
+{-# INLINE removePendingSubs #-}
 
-hasSub :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSub -> STM Bool
-hasSub subs srv s = maybe (pure False) (TM.member s) =<< TM.lookup srv subs
+removeSubs_ :: TMap SMPServer (TMap SMPSub C.APrivateAuthKey) -> SMPServer -> SMPSubParty -> [QueueId] -> STM ()
+removeSubs_ subs srv party qs = TM.lookup srv subs >>= mapM_ (`modifyTVar'` (`M.withoutKeys` ss))
+  where
+    ss = S.fromList $ map (party,) qs

src/Simplex/Messaging/Crypto.hs

@@ -185,9 +185,6 @@ module Simplex.Messaging.Crypto
     maxLenBS,
     unsafeMaxLenBS,
     appendMaxLenBS,
-    hsalsa20,
-    secretBox,
-    secretBoxOpen,
   )
 where
 
@@ -198,8 +195,10 @@ import Control.Monad.Except
 import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
+import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
 import Crypto.Hash (Digest, SHA256 (..), SHA512 (..), hash, hashDigestSize)
+import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
 import qualified Crypto.PubKey.Ed25519 as Ed25519
@@ -229,15 +228,12 @@ import Data.X509
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
-import Foreign.C.ConstPtr (ConstPtr (..))
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
-import qualified Simplex.Messaging.Crypto.NaCl.Bindings as NaCl
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
-import System.IO.Unsafe (unsafePerformIO)
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1214,7 +1210,10 @@ cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> B
 cbEncryptMaxLenBS (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce . unMaxLenBS . padMaxLenBS
 
 cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
-cryptoBox secret nonce msg = either error id $! hsalsa20 secret >>= \sk -> secretBox sk nonce msg -- TODO: fuse
+cryptoBox secret nonce s = BA.convert tag <> c
+  where
+    (rs, c) = xSalsa20 secret nonce s
+    tag = Poly1305.auth rs c
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
 cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
@@ -1234,7 +1233,14 @@ sbDecrypt_ secret nonce = unPad <=< sbDecryptNoPad_ secret nonce
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
 sbDecryptNoPad_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
-sbDecryptNoPad_ secret (CbNonce nonce) packet = first (const CBDecryptError) $! hsalsa20 secret >>= \sk -> secretBoxOpen sk nonce packet -- TODO: fuse
+sbDecryptNoPad_ secret (CbNonce nonce) packet
+  | B.length packet < 16 = Left CBDecryptError
+  | BA.constEq tag' tag = Right msg
+  | otherwise = Left CBDecryptError
+  where
+    (tag', c) = B.splitAt 16 packet
+    (rs, msg) = xSalsa20 secret nonce c
+    tag = Poly1305.auth rs c
 
 -- type for authentication scheme using NaCl @crypto_box@ over the sha512 digest of the message.
 newtype CbAuthenticator = CbAuthenticator ByteString deriving (Eq, Show)
@@ -1328,6 +1334,16 @@ unsafeSbKey s = either error id $ sbKey s
 randomSbKey :: TVar ChaChaDRG -> STM SbKey
 randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar
 
+xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)
+xSalsa20 secret nonce msg = (rs, msg')
+  where
+    zero = B.replicate 16 $ toEnum 0
+    (iv0, iv1) = B.splitAt 8 nonce
+    state0 = XSalsa.initialize 20 secret (zero `B.append` iv0)
+    state1 = XSalsa.derive state0 iv1
+    (rs, state2) = XSalsa.generate state1 32
+    (msg', _) = XSalsa.combine state2 msg
+
 publicToX509 :: PublicKey a -> PubKey
 publicToX509 = \case
   PublicKeyEd25519 k -> PubKeyEd25519 k
@@ -1376,53 +1392,3 @@ keyError :: (a, [ASN1]) -> Either String b
 keyError = \case
   (_, []) -> Left "unknown key algorithm"
   _ -> Left "more than one key"
-
-type NaclDhSecret = BA.ScrubbedBytes
-
--- type NaclDhSecret = C.DhSecret 'C.X25519h -- hashed DH produced by NaCl "crypto_box_beforenm" and used by secretBox/Open
-
--- Run salsa20 in a hash mode to make our DH keys match 'c_crypto_box_beforenm' output.
-hsalsa20 :: ByteArrayAccess key => key -> Either String NaclDhSecret
-hsalsa20 key = unsafePerformIO $ do
-  (r, ba :: NaclDhSecret) <- BA.withByteArray c_0 $ \inpPtr ->
-    BA.withByteArray key $ \keyPtr ->
-      BA.withByteArray sigma $ \sigmaPtr ->
-        BA.allocRet 32 $ \outPtr ->
-          NaCl.c_crypto_core_hsalsa20 outPtr (ConstPtr inpPtr) (ConstPtr keyPtr) (ConstPtr sigmaPtr)
-  pure $! if r /= 0 then Left "crypto_core_hsalsa20" else Right ba
-  where
-    -- sigma[16] = "expand 32-byte k";
-    sigma :: ByteString
-    sigma = "expand 32-byte k"
-    c_0 :: ByteString
-    c_0 = B.replicate 16 '\0'
-{-# NOINLINE hsalsa20 #-}
-
-secretBox :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString
-secretBox sk nonce msg = unsafePerformIO $ do
-  (r, c) <-
-    BA.withByteArray msg0 $ \mPtr ->
-      BA.withByteArray nonce $ \noncePtr ->
-        BA.withByteArray sk $ \skPtr ->
-          BA.allocRet (B.length msg0) $ \cPtr ->
-            NaCl.c_crypto_secretbox cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr noncePtr) (ConstPtr skPtr)
-  pure $! if r /= 0 then Left "crypto_secretbox" else Right (B.drop NaCl.crypto_box_BOXZEROBYTES c)
-  where
-    zeroBytes = B.replicate NaCl.crypto_box_ZEROBYTES '\0'
-    msg0 = zeroBytes <> BA.convert msg
-{-# NOINLINE secretBox #-}
-
-secretBoxOpen :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString
-secretBoxOpen sk nonce ciphertext = unsafePerformIO $ do
-  (r, m) <-
-    BA.withByteArray ciphertext0 $ \cPtr ->
-      BA.withByteArray nonce $ \noncePtr ->
-        BA.withByteArray sk $ \skPtr ->
-          BA.allocRet cLen $ \mPtr ->
-            NaCl.c_crypto_secretbox_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr noncePtr) (ConstPtr skPtr)
-  pure $! if r /= 0 then Left "crypto_secretbox_open" else Right (B.drop NaCl.crypto_box_ZEROBYTES m)
-  where
-    ciphertext0 = boxZeroBytes <> ciphertext
-    boxZeroBytes = B.replicate NaCl.crypto_box_BOXZEROBYTES '\0'
-    cLen = B.length ciphertext0
-{-# NOINLINE secretBoxOpen #-}

src/Simplex/Messaging/Crypto/File.hs

@@ -23,6 +23,7 @@ where
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
+import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.ByteArray as BA
@@ -56,10 +57,10 @@ readFile (CryptoFile path cfArgs) = do
   case cfArgs of
     Just (CFArgs (C.SbKey key) (C.CbNonce nonce)) -> do
       let len = LB.length s - fromIntegral C.authTagSize
-      when (len < 0) $ throwError FTCEInvalidFileSize
+      when (len < 0) $ throwE FTCEInvalidFileSize
       let (s', tag') = LB.splitAt len s
       (tag :| cs) <- liftEitherWith FTCECryptoError $ LC.secretBox LC.sbDecryptChunk key nonce s'
-      unless (BA.constEq (LB.toStrict tag') tag) $ throwError FTCEInvalidAuthTag
+      unless (BA.constEq (LB.toStrict tag') tag) $ throwE FTCEInvalidAuthTag
       pure $ LB.fromChunks cs
     Nothing -> pure s
 
@@ -96,7 +97,7 @@ hGetTag :: CryptoFileHandle -> ExceptT FTCryptoError IO ()
 hGetTag (CFHandle h sb_) = forM_ sb_ $ \sb -> do
   tag <- liftIO $ B.hGet h C.authTagSize
   tag' <- LC.sbAuth <$> readTVarIO sb
-  unless (BA.constEq tag tag') $ throwError FTCEInvalidAuthTag
+  unless (BA.constEq tag tag') $ throwE FTCEInvalidAuthTag
 
 data FTCryptoError
   = FTCECryptoError C.CryptoError