deduplicate connections for locking

comment
traversable
2026-09-01 09:28:25 +00:00 · 2023-12-18 21:09:40 +00:00 · 2023-12-18 20:57:39 +00:00 · 2023-12-18 20:53:47 +00:00 · 2023-12-18 18:02:08 +02:00 · 2023-12-18 17:35:30 +02:00
36 changed files with 619 additions and 442 deletions
@@ -11,7 +11,7 @@ on:

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

      - name: Cache dependencies
@@ -5,7 +5,7 @@ FROM ubuntu:${TAG} AS build
 ### Build stage

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

 # Specify bootstrap Haskell versions
 ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
@@ -5,6 +5,7 @@
 module Main where

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

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

 servers :: InitialAgentServers
@@ -38,5 +39,5 @@ main :: IO ()
 main = do
  putStrLn $ "SMP agent listening on port " ++ tcpPort (cfg :: AgentConfig)
  setLogLevel LogInfo -- LogError
-  Right st <- createAgentStore agentDbFile agentDbKey MCConsole
+  Right st <- createAgentStore agentDbFile agentDbKey False MCConsole
  withGlobalLogging logCfg $ runSMPAgent (transport @TLS) cfg servers st
@@ -4,7 +4,10 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport

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

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

-source-repository-package
-    type: git
-    location: https://github.com/kazu-yamamoto/http2.git
-    tag: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
-
 source-repository-package
    type: git
    location: https://github.com/simplex-chat/direct-sqlcipher.git
@@ -30,8 +28,3 @@ source-repository-package
    type: git
    location: https://github.com/simplex-chat/sqlcipher-simple.git
    tag: a46bd361a19376c5211f1058908fc0ae6bf42446
-
-source-repository-package
-    type: git
-    location: https://github.com/simplex-chat/network-transport.git
-    tag: 0013798272a683e35ca38d2fdaf480942311fba8
@@ -32,13 +32,15 @@ dependencies:
  - attoparsec == 0.14.*
  - base >= 4.14 && < 5
  - base64-bytestring >= 1.0 && < 1.3
-  - bytestring == 0.11.*
  - case-insensitive == 1.2.*
  - composition == 1.0.*
  - constraints >= 0.12 && < 0.14
  - containers == 0.6.*
-  - cryptonite == 0.30.*
-  - cryptostore == 0.2.*
+  - 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.*
@@ -50,7 +52,7 @@ dependencies:
  - iproute == 1.7.*
  - iso8601-time == 0.1.*
  - memory == 0.18.*
-  - mtl == 2.3.*
+  - mtl >= 2.3.1 && < 3.0
  - network >= 3.1.2.7 && < 3.2
  - network-info >= 0.2 && < 0.3
  - network-transport == 0.5.6
@@ -62,20 +64,14 @@ dependencies:
  - socks == 0.6.*
  - sqlcipher-simple == 0.4.*
  - stm == 2.5.*
-  - template-haskell == 2.20.*
  - temporary == 1.3.*
-  - text == 2.0.*
-  - time == 1.9.*
-  - time-compat == 1.9.*
+  - time == 1.12.*
  - time-manager == 0.0.*
-  - tls >= 1.6.0 && < 1.7
+  - tls >= 1.7.0 && < 1.8
  - transformers == 0.6.*
  - unliftio == 0.2.*
  - unliftio-core == 0.2.*
  - websockets == 0.12.*
-  - x509 == 1.7.*
-  - x509-store == 1.6.*
-  - x509-validation == 1.6.*
  - yaml == 0.11.*

 flags:
@@ -83,11 +79,25 @@ flags:
    description: Enable swift JSON format
    manual: True
    default: False
+  use_crypton:
+    description: Use crypton etc. in cryptostore
+    manual: True
+    default: True

 when:
  - condition: flag(swift)
    cpp-options:
      - -DswiftJSON
+  - condition: impl(ghc >= 9.6.2)
+    dependencies:
+      - bytestring == 0.11.*
+      - template-haskell == 2.20.*
+      - text >= 2.0.1 && < 2.2
+  - condition: impl(ghc < 9.6.2)
+    dependencies:
+      - bytestring == 0.10.*
+      - template-haskell == 2.16.*
+      - text >= 1.2.3.0 && < 1.3

 library:
  source-dirs: src
@@ -1,6 +1,6 @@
 cabal-version: 1.12

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

@@ -34,6 +34,11 @@ flag swift
  manual: True
  default: False

+flag use_crypton
+  description: Use crypton etc. in cryptostore
+  manual: True
+  default: True
+
 library
  exposed-modules:
      Simplex.FileTransfer.Agent
@@ -174,13 +179,15 @@ library
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , 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.*
@@ -192,7 +199,7 @@ library
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -204,24 +211,28 @@ library
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

 executable ntf-server
  main-is: Main.hs
@@ -239,13 +250,15 @@ executable ntf-server
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , 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.*
@@ -257,7 +270,7 @@ executable ntf-server
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -270,24 +283,28 @@ executable ntf-server
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

 executable smp-agent
  main-is: Main.hs
@@ -305,13 +322,15 @@ executable smp-agent
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , 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.*
@@ -323,7 +342,7 @@ executable smp-agent
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -336,24 +355,28 @@ executable smp-agent
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

 executable smp-server
  main-is: Main.hs
@@ -371,13 +394,15 @@ executable smp-server
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , 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.*
@@ -389,7 +414,7 @@ executable smp-server
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -402,24 +427,28 @@ executable smp-server
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

 executable xftp
  main-is: Main.hs
@@ -437,13 +466,15 @@ executable xftp
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , 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.*
@@ -455,7 +486,7 @@ executable xftp
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -468,24 +499,28 @@ executable xftp
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

 executable xftp-server
  main-is: Main.hs
@@ -503,13 +538,15 @@ executable xftp-server
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , 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.*
@@ -521,7 +558,7 @@ executable xftp-server
    , iproute ==1.7.*
    , iso8601-time ==0.1.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -534,24 +571,28 @@ executable xftp-server
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3

 test-suite simplexmq-test
  type: exitcode-stdio-1.0
@@ -600,13 +641,15 @@ test-suite simplexmq-test
    , attoparsec ==0.14.*
    , base >=4.14 && <5
    , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
    , case-insensitive ==1.2.*
    , composition ==1.0.*
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
-    , cryptonite ==0.30.*
-    , cryptostore ==0.2.*
+    , crypton ==0.34.*
+    , crypton-x509 ==1.7.*
+    , crypton-x509-store ==1.6.*
+    , crypton-x509-validation ==1.6.*
+    , cryptostore ==0.3.*
    , data-default ==0.7.*
    , deepseq ==1.4.*
    , direct-sqlcipher ==2.3.*
@@ -623,7 +666,7 @@ test-suite simplexmq-test
    , iso8601-time ==0.1.*
    , main-tester ==0.2.*
    , memory ==0.18.*
-    , mtl ==2.3.*
+    , mtl >=2.3.1 && <3.0
    , network >=3.1.2.7 && <3.2
    , network-info ==0.2.*
    , network-transport ==0.5.6
@@ -637,22 +680,26 @@ test-suite simplexmq-test
    , socks ==0.6.*
    , sqlcipher-simple ==0.4.*
    , stm ==2.5.*
-    , template-haskell ==2.20.*
    , temporary ==1.3.*
-    , text ==2.0.*
-    , time ==1.9.*
-    , time-compat ==1.9.*
+    , time ==1.12.*
    , time-manager ==0.0.*
    , timeit ==2.0.*
-    , tls >=1.6.0 && <1.7
+    , tls >=1.7.0 && <1.8
    , transformers ==0.6.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
    , websockets ==0.12.*
-    , x509 ==1.7.*
-    , x509-store ==1.6.*
-    , x509-validation ==1.6.*
    , yaml ==0.11.*
  default-language: Haskell2010
  if flag(swift)
    cpp-options: -DswiftJSON
+  if impl(ghc >= 9.6.2)
+    build-depends:
+        bytestring ==0.11.*
+      , template-haskell ==2.20.*
+      , text >=2.0.1 && <2.2
+  if impl(ghc < 9.6.2)
+    build-depends:
+        bytestring ==0.10.*
+      , template-haskell ==2.16.*
+      , text >=1.2.3.0 && <1.3
@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -485,7 +484,7 @@ runXFTPSndWorker c srv doWork = do
            rcvChunks :: [[FileChunk]]
            rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
            sortChunks :: [FileChunk] -> [FileChunk]
-            sortChunks = map reverseReplicas . sortOn (\fc -> fc.chunkNo)
+            sortChunks = map reverseReplicas . sortOn (\FileChunk {chunkNo} -> chunkNo)
            reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
            addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
            addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
@@ -3,7 +3,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -111,7 +110,7 @@ xftpClientServer = B.unpack . strEncode . snd3 . transportSession
    snd3 (_, s, _) = s

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

 xftpSessionTs :: XFTPClient -> UTCTime
 xftpSessionTs = sessionTs . http2Client
@@ -5,7 +5,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -361,7 +360,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
        rcvChunks :: [[FileChunk]]
        rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
        sortChunks :: [FileChunk] -> [FileChunk]
-        sortChunks = map reverseReplicas . sortOn (\c -> c.chunkNo)
+        sortChunks = map reverseReplicas . sortOn (\FileChunk {chunkNo} -> chunkNo)
        reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
        addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
        addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
@@ -420,7 +419,9 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
      a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
      liftIO $ printNoNewLine "Downloading file..."
      downloadedChunks <- newTVarIO []
-      let srv FileChunk {replicas} = (head replicas).server
+      let srv FileChunk {replicas} = case replicas of
+            [] -> error "empty FileChunk.replicas"
+            FileChunkReplica {server} : _ -> server
          srvChunks = groupAllOn srv chunks
      chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk a encPath size downloadedChunks)
      encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
@@ -498,10 +499,9 @@ cliFileDescrInfo InfoOptions {fileDescription} = do
        printParty
        putStrLn $ "File download size: " <> strEnc size
        putStrLn "File server(s):"
-        forM_ replicas $ \srvReplicas -> do
-          let srv = (head srvReplicas).server
-              chSizes = map (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
-          putStrLn $ strEnc srv <> ": " <> strEnc (FileSize $ sum chSizes)
+        forM_ replicas $ \srvReplicas@(FileServerReplica {server} :| _) -> do
+          let chSizes = fmap (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
+          putStrLn $ strEnc server <> ": " <> strEnc (FileSize $ sum chSizes)
      where
        printParty :: IO ()
        printParty = case party of
@@ -4,7 +4,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -45,6 +44,8 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List (foldl', sortOn)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -59,7 +60,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, parseAll)
 import Simplex.Messaging.Protocol (XFTPServer)
-import Simplex.Messaging.Util (bshow, groupAllOn, (<$?>))
+import Simplex.Messaging.Util (bshow, (<$?>))

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

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

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

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

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

 encodeServerReplica :: FileServerReplica -> ByteString
@@ -305,7 +306,7 @@ foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String
 foldReplicasToChunks defChunkSize fs = do
  sd <- foldSizesDigests fs
  -- TODO validate (check that chunks match) or in separate function
-  sortOn (\c -> c.chunkNo) . map reverseReplicas . M.elems <$> foldChunks sd fs
+  sortOn (\FileChunk {chunkNo} -> chunkNo) . map reverseReplicas . M.elems <$> foldChunks sd fs
  where
    foldSizesDigests :: [FileServerReplica] -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
    foldSizesDigests = foldl' addSizeDigest $ Right (M.empty, M.empty)
@@ -8,7 +8,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -65,6 +64,7 @@ module Simplex.Messaging.Agent
    resubscribeConnection,
    resubscribeConnections,
    sendMessage,
+    sendMessages,
    ackMessage,
    switchConnection,
    abortConnectionSwitch,
@@ -120,14 +120,17 @@ import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:), (.:.), (.::), (.::.))
-import Data.Foldable (foldl')
+import Data.Either (rights)
+import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
+import Data.Functor.Identity
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
+import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock
@@ -278,6 +281,12 @@ resubscribeConnections c = withAgentEnv c . resubscribeConnections' c
 sendMessage :: AgentErrorMonad m => AgentClient -> ConnId -> MsgFlags -> MsgBody -> m AgentMsgId
 sendMessage c = withAgentEnv c .:. sendMessage' c

+type MsgReq = (ConnId, MsgFlags, MsgBody)
+
+-- | Send multiple messages to different connections (SEND command)
+sendMessages :: MonadUnliftIO m => AgentClient -> [MsgReq] -> m [Either AgentErrorType AgentMsgId]
+sendMessages c = withAgentEnv c . sendMessages' c
+
 ackMessage :: AgentErrorMonad m => AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> m ()
 ackMessage c = withAgentEnv c .:. ackMessage' c

@@ -850,37 +859,47 @@ getNotificationMessage' c nonce encNtfInfo = do
      (ntfConnId, rcvNtfDhSecret) <- withStore c (`getNtfRcvQueue` smpQueue)
      ntfMsgMeta <- (eitherToMaybe . smpDecode <$> agentCbDecrypt rcvNtfDhSecret nmsgNonce encNMsgMeta) `catchAgentError` \_ -> pure Nothing
      maxMsgs <- asks $ ntfMaxMessages . config
-      (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta},) <$> getNtfMessages ntfConnId maxMsgs ntfMsgMeta []
+      (NotificationInfo {ntfConnId, ntfTs, ntfMsgMeta},) <$> getNtfMessages ntfConnId ntfMsgMeta maxMsgs
    _ -> throwError $ CMD PROHIBITED
  where
-    getNtfMessages ntfConnId maxMs nMeta ms
-      | length ms < maxMs =
-          getConnectionMessage' c ntfConnId >>= \case
-            Just m@SMP.SMPMsgMeta {msgId, msgTs, msgFlags} -> case nMeta of
-              Just SMP.NMsgMeta {msgId = msgId', msgTs = msgTs'}
-                | msgId == msgId' || msgTs > msgTs' -> pure $ reverse (m : ms)
-                | otherwise -> getMsg (m : ms)
-              _
-                | SMP.notification msgFlags -> pure $ reverse (m : ms)
-                | otherwise -> getMsg (m : ms)
-            _ -> pure $ reverse ms
-      | otherwise = pure $ reverse ms
+    getNtfMessages ntfConnId nMeta = getMsg
      where
-        getMsg = getNtfMessages ntfConnId maxMs nMeta
+        getMsg 0 = pure []
+        getMsg n =
+          getConnectionMessage' c ntfConnId >>= \case
+            Just m
+              | lastMsg m -> pure [m]
+              | otherwise -> (m :) <$> getMsg (n - 1)
+            Nothing -> pure []
+        lastMsg SMP.SMPMsgMeta {msgId, msgTs, msgFlags} = case nMeta of
+          Just SMP.NMsgMeta {msgId = msgId', msgTs = msgTs'} -> msgId == msgId' || msgTs > msgTs'
+          Nothing -> SMP.notification msgFlags

 -- | Send message to the connection (SEND command) in Reader monad
 sendMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> MsgFlags -> MsgBody -> m AgentMsgId
-sendMessage' c connId msgFlags msg = withConnLock c connId "sendMessage" $ do
-  SomeConn _ conn <- withStore c (`getConn` connId)
-  case conn of
-    DuplexConnection cData _ sqs -> enqueueMsgs cData sqs
-    SndConnection cData sq -> enqueueMsgs cData [sq]
-    _ -> throwError $ CONN SIMPLEX
+sendMessage' c connId msgFlags msg = liftEither . runIdentity =<< sendMessagesB c (Identity (Right (connId, msgFlags, msg)))
+
+-- | Send multiple messages to different connections (SEND command) in Reader monad
+sendMessages' :: forall m. AgentMonad' m => AgentClient -> [MsgReq] -> m [Either AgentErrorType AgentMsgId]
+sendMessages' c = sendMessagesB c . map Right
+
+sendMessagesB :: forall m t. (AgentMonad' m, Traversable t) => AgentClient -> t (Either AgentErrorType MsgReq) -> m (t (Either AgentErrorType AgentMsgId))
+sendMessagesB c reqs = withConnLocks c connIds "sendMessages" $ do
+  reqs' <- withStoreBatch c (\db -> fmap (mapE $ \req@(connId, _, _) -> bimap storeError (req,) <$> getConn db connId) reqs)
+  let reqs'' = fmap (>>= prepareConn) reqs'
+  enqueueMessagesB c reqs''
  where
-    enqueueMsgs :: ConnData -> NonEmpty SndQueue -> m AgentMsgId
-    enqueueMsgs cData sqs = do
-      when (ratchetSyncSendProhibited cData) $ throwError $ CMD PROHIBITED
-      enqueueMessages c cData sqs msgFlags $ A_MSG msg
+    prepareConn :: (MsgReq, SomeConn) -> Either AgentErrorType (ConnData, NonEmpty SndQueue, MsgFlags, AMessage)
+    prepareConn ((_, msgFlags, msg), SomeConn _ conn) = case conn of
+      DuplexConnection cData _ sqs -> prepareMsgs cData sqs
+      SndConnection cData sq -> prepareMsgs cData [sq]
+      _ -> Left $ CONN SIMPLEX
+      where
+        prepareMsgs :: ConnData -> NonEmpty SndQueue -> Either AgentErrorType (ConnData, NonEmpty SndQueue, MsgFlags, AMessage)
+        prepareMsgs cData sqs
+          | ratchetSyncSendProhibited cData = Left $ CMD PROHIBITED
+          | otherwise = Right (cData, sqs, msgFlags, A_MSG msg)
+    connIds = foldl' (\cs -> either (\_ -> cs) (\(connId, _, _) -> S.insert connId cs)) S.empty reqs

 -- / async command processing v v v

@@ -986,7 +1005,7 @@ runCommandProcessing c@AgentClient {subQ} server_ = do
          withServer $ \srv -> tryWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
            case find (sameQueue (srv, rId)) rqs of
              Just rq'@RcvQueue {server, sndId, status, dbReplaceQueueId = Just replaceQId} ->
-                case find (\q -> replaceQId == q.dbQueueId) rqs of
+                case find ((replaceQId ==) . dbQId) rqs of
                  Just rq1 -> when (status == Confirmed) $ do
                    secureQueue c rq' senderKey
                    withStore' c $ \db -> setRcvQueueStatus db rq' Secured
@@ -1059,22 +1078,37 @@ enqueueMessages c cData sqs msgFlags aMessage = do
  enqueueMessages' c cData sqs msgFlags aMessage

 enqueueMessages' :: AgentMonad m => AgentClient -> ConnData -> NonEmpty SndQueue -> MsgFlags -> AMessage -> m AgentMsgId
-enqueueMessages' c cData (sq :| sqs) msgFlags aMessage = do
-  msgId <- enqueueMessage c cData sq msgFlags aMessage
-  mapM_ (enqueueSavedMessage c cData msgId) $
-    filter (\SndQueue {status} -> status == Secured || status == Active) sqs
-  pure msgId
+enqueueMessages' c cData sqs msgFlags aMessage =
+  liftEither . runIdentity =<< enqueueMessagesB c (Identity (Right (cData, sqs, msgFlags, aMessage)))
+
+enqueueMessagesB :: (AgentMonad' m, Traversable t) => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, MsgFlags, AMessage)) -> m (t (Either AgentErrorType AgentMsgId))
+enqueueMessagesB c reqs = do
+  reqs' <- enqueueMessageB c reqs
+  enqueueSavedMessageB c $ mapMaybe snd $ rights $ toList reqs'
+  pure $ fst <$$> reqs'
+
+isActiveSndQ :: SndQueue -> Bool
+isActiveSndQ SndQueue {status} = status == Secured || status == Active

 enqueueMessage :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> MsgFlags -> AMessage -> m AgentMsgId
-enqueueMessage c cData@ConnData {connId} sq msgFlags aMessage = do
-  resumeMsgDelivery c cData sq
-  aVRange <- asks $ smpAgentVRange . config
-  msgId <- storeSentMsg $ maxVersion aVRange
-  queuePendingMsgs c sq [msgId]
-  pure $ unId msgId
+enqueueMessage c cData sq msgFlags aMessage =
+  liftEither . fmap fst . runIdentity =<< enqueueMessageB c (Identity (Right (cData, [sq], msgFlags, aMessage)))
+
+-- this function is used only for sending messages in batch, it returns the list of successes to enqueue additional deliveries
+enqueueMessageB :: forall m t. (AgentMonad' m, Traversable t) => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, MsgFlags, AMessage)) -> m (t (Either AgentErrorType (AgentMsgId, Maybe (ConnData, [SndQueue], AgentMsgId))))
+enqueueMessageB c reqs = do
+  void . forME reqs $ \(cData, sq :| _, _, _) ->
+    runExceptT $ resumeMsgDelivery c cData sq
+  aVRange <- asks $ maxVersion . smpAgentVRange . config
+  reqMids <- withStoreBatch c $ \db -> fmap (mapE $ storeSentMsg db aVRange) reqs
+  forME reqMids $ \((cData, sq :| sqs, _, _), mId) -> do
+    let InternalId msgId = mId
+    queuePendingMsgs c sq [mId]
+    let sqs' = filter isActiveSndQ sqs
+    pure $ Right (msgId, if null sqs' then Nothing else Just (cData, sqs', msgId))
  where
-    storeSentMsg :: Version -> m InternalId
-    storeSentMsg agentVersion = withStore c $ \db -> runExceptT $ do
+    storeSentMsg :: DB.Connection -> Version -> (ConnData, NonEmpty SndQueue, MsgFlags, AMessage) -> IO (Either AgentErrorType ((ConnData, NonEmpty SndQueue, MsgFlags, AMessage), InternalId))
+    storeSentMsg db agentVersion req@(ConnData {connId}, sq :| _, msgFlags, aMessage) = fmap (first storeError) $ runExceptT $ do
      internalTs <- liftIO getCurrentTime
      (internalId, internalSndId, prevMsgHash) <- liftIO $ updateSndIds db connId
      let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
@@ -1087,14 +1121,25 @@ enqueueMessage c cData@ConnData {connId} sq msgFlags aMessage = do
          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody, internalHash, prevMsgHash}
      liftIO $ createSndMsg db connId msgData
      liftIO $ createSndMsgDelivery db connId sq internalId
-      pure internalId
+      pure (req, internalId)

-enqueueSavedMessage :: AgentMonad m => AgentClient -> ConnData -> AgentMsgId -> SndQueue -> m ()
-enqueueSavedMessage c cData@ConnData {connId} msgId sq = do
-  resumeMsgDelivery c cData sq
-  let mId = InternalId msgId
-  queuePendingMsgs c sq [mId]
-  withStore' c $ \db -> createSndMsgDelivery db connId sq mId
+enqueueSavedMessage :: AgentMonad' m => AgentClient -> ConnData -> AgentMsgId -> SndQueue -> m ()
+enqueueSavedMessage c cData msgId sq = enqueueSavedMessageB c $ Identity (cData, [sq], msgId)
+
+enqueueSavedMessageB :: (AgentMonad' m, Foldable t) => AgentClient -> t (ConnData, [SndQueue], AgentMsgId) -> m ()
+enqueueSavedMessageB c reqs = do
+  -- saving to the database has to be before enqueue to avoid race condition when delivery is read from queue before it is saved
+  void $ withStoreBatch' c $ \db -> concatMap (storeDeliveries db) reqs
+  forM_ reqs $ \(cData, sqs, msgId) ->
+    forM sqs $ \sq -> do
+      void . runExceptT $ resumeMsgDelivery c cData sq
+      let mId = InternalId msgId
+      queuePendingMsgs c sq [mId]
+  where
+    storeDeliveries :: DB.Connection -> (ConnData, [SndQueue], AgentMsgId) -> [IO ()]
+    storeDeliveries db (ConnData {connId}, sqs, msgId) = do
+      let mId = InternalId msgId
+       in map (\sq -> createSndMsgDelivery db connId sq mId) sqs

 resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> m ()
 resumeMsgDelivery c cData@ConnData {connId} sq@SndQueue {server, sndId} = do
@@ -1104,20 +1149,23 @@ resumeMsgDelivery c cData@ConnData {connId} sq@SndQueue {server, sndId} = do
      >>= \a -> atomically (TM.insert qKey a $ smpQueueMsgDeliveries c)
  unlessM msgsQueued $
    withStore' c (\db -> getPendingMsgs db connId sq)
-      >>= queuePendingMsgs c sq
+      >>= queuePendingMsgs' c False sq
  where
    queueDelivering qKey = atomically $ TM.member qKey (smpQueueMsgDeliveries c)
    msgsQueued = atomically $ isJust <$> TM.lookupInsert (server, sndId) True (pendingMsgsQueued c)

 queuePendingMsgs :: AgentMonad' m => AgentClient -> SndQueue -> [InternalId] -> m ()
-queuePendingMsgs c sq msgIds = atomically $ do
-  modifyTVar' (msgDeliveryOp c) $ \s -> s {opsInProgress = opsInProgress s + length msgIds}
+queuePendingMsgs c = queuePendingMsgs' c True
+
+queuePendingMsgs' :: AgentMonad' m => AgentClient -> Bool -> SndQueue -> [InternalId] -> m ()
+queuePendingMsgs' c setDeliveryOps sq msgIds = atomically $ do
+  when setDeliveryOps $ modifyTVar' (msgDeliveryOp c) $ \s -> s {opsInProgress = opsInProgress s + length msgIds}
  -- s <- readTVar (msgDeliveryOp c)
  -- unsafeIOToSTM $ putStrLn $ "msgDeliveryOp: " <> show (opsInProgress s)
  (mq, _) <- getPendingMsgQ c sq
-  mapM_ (writeTQueue mq) msgIds
+  mapM_ (writeTQueue mq . (,setDeliveryOps)) msgIds

-getPendingMsgQ :: AgentClient -> SndQueue -> STM (TQueue InternalId, TMVar ())
+getPendingMsgQ :: AgentClient -> SndQueue -> STM (TQueue (InternalId, Bool), TMVar ())
 getPendingMsgQ c SndQueue {server, sndId} = do
  let qKey = (server, sndId)
  maybe (newMsgQueue qKey) pure =<< TM.lookup qKey (smpQueueMsgQueues c)
@@ -1135,9 +1183,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl
    atomically $ endAgentOperation c AOSndNetwork
    atomically $ throwWhenInactive c
    atomically $ throwWhenNoDelivery c sq
-    msgId <- atomically $ readTQueue mq
+    (msgId, deliveryOp) <- atomically $ readTQueue mq
    atomically $ beginAgentOperation c AOSndNetwork
-    atomically $ endAgentOperation c AOMsgDelivery -- this operation begins in queuePendingMsgs
+    when deliveryOp $ atomically $ endAgentOperation c AOMsgDelivery -- this operation begins in queuePendingMsgs
    let mId = unId msgId
    tryAgentError (withStore c $ \db -> getPendingMsgData db connId msgId) >>= \case
      Left e -> notify $ MERR mId e
@@ -1243,7 +1291,7 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl
                        -- this is the same queue where this loop delivers messages to but with updated state
                        Just SndQueue {dbReplaceQueueId = Just replacedId, primary} ->
                          -- second part of this condition is a sanity check because dbReplaceQueueId cannot point to the same queue, see switchConnection'
-                          case removeQP (\sq' -> sq'.dbQueueId == replacedId && not (sameQueue addr sq')) sqs of
+                          case removeQP (\sq' -> dbQId sq' == replacedId && not (sameQueue addr sq')) sqs of
                            Nothing -> internalErr msgId "sent QTEST: queue not found in connection"
                            Just (sq', sq'' : sqs') -> do
                              checkSQSwchStatus sq' SSSendingQTEST
@@ -1358,7 +1406,7 @@ abortConnectionSwitch' c connId =
          | canAbortRcvSwitch rq -> do
              when (ratchetSyncSendProhibited cData) $ throwError $ CMD PROHIBITED
              -- multiple queues to which the connections switches were possible when repeating switch was allowed
-              let (delRqs, keepRqs) = L.partition (\q -> Just rq.dbQueueId == q.dbReplaceQueueId) rqs
+              let (delRqs, keepRqs) = L.partition ((Just (dbQId rq) ==) . dbReplaceQId) rqs
              case L.nonEmpty keepRqs of
                Just rqs' -> do
                  rq' <- withStore' c $ \db -> do
@@ -1476,7 +1524,7 @@ deleteConnQueues c ntf rqs = do
            | temporaryOrHostError e && deleteErrors rq + 1 < maxErrs -> withStore' c (`incRcvDeleteErrors` rq) $> r
            | otherwise -> withStore' c (`deleteConnRcvQueue` rq) >> notifyRQ rq (Just e) $> Right ()
        pure (rq, r')
-    notifyRQ rq e_ = notify ("", rq.connId, APC SAEConn $ DEL_RCVQ (qServer rq) (queueId rq) e_)
+    notifyRQ rq e_ = notify ("", qConnId rq, APC SAEConn $ DEL_RCVQ (qServer rq) (queueId rq) e_)
    notify = when ntf . atomically . writeTBQueue (subQ c)
    connResults :: [(RcvQueue, Either AgentErrorType ())] -> Map ConnId (Either AgentErrorType ())
    connResults = M.map snd . foldl' addResult M.empty
@@ -1886,10 +1934,13 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
      cData@ConnData {userId, connId, duplexHandshake, connAgentVersion, ratchetSyncState = rss} =
        withConnLock c connId "processSMP" $ case cmd of
          SMP.MSG msg@SMP.RcvMessage {msgId = srvMsgId} ->
-            handleNotifyAck $
-              decryptSMPMessage v rq msg >>= \case
+            handleNotifyAck $ do
+              msg' <- decryptSMPMessage v rq msg
+              handleNotifyAck $ case msg' of
                SMP.ClientRcvMsgBody {msgTs = srvTs, msgFlags, msgBody} -> processClientMsg srvTs msgFlags msgBody
                SMP.ClientRcvMsgQuota {} -> queueDrained >> ack
+              whenM (atomically $ hasGetLock c rq) $
+                notify (MSGNTF $ SMP.rcvMessageMeta srvMsgId msg')
            where
              queueDrained = case conn of
                DuplexConnection _ _ sqs -> void $ enqueueMessages c cData sqs SMP.noMsgFlags $ QCONT (sndAddress rq)
@@ -1922,7 +1973,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
                        case (conn', dbReplaceQueueId) of
                          (DuplexConnection _ rqs _, Just replacedId) -> do
                            when primary . withStore' c $ \db -> setRcvQueuePrimary db connId rq
-                            case find (\q -> replacedId == q.dbQueueId) rqs of
+                            case find ((replacedId ==) . dbQId) rqs of
                              Just rq'@RcvQueue {server, rcvId} -> do
                                checkRQSwchStatus rq' RSSendingQUSE
                                void $ withStore' c $ \db -> setRcvSwitchStatus db rq' $ Just RSReceivedMessage
@@ -2197,7 +2248,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
                case (findQ (qAddress sqInfo) sqs, findQ addr sqs) of
                  (Just _, _) -> qError "QADD: queue address is already used in connection"
                  (_, Just sq@SndQueue {dbQueueId}) -> do
-                    let (delSqs, keepSqs) = L.partition (\q -> Just dbQueueId == q.dbReplaceQueueId) sqs
+                    let (delSqs, keepSqs) = L.partition ((Just dbQueueId == ) . dbReplaceQId) sqs
                    case L.nonEmpty keepSqs of
                      Just sqs' -> do
                        -- move inside case?
@@ -2248,7 +2299,7 @@ processSMPTransmission c@AgentClient {smpClients, subQ} (tSess@(_, srv, _), v, s
            when (ratchetSyncSendProhibited cData') $ throwError $ AGENT (A_QUEUE "ratchet is not synchronized")
            case findQ addr sqs of
              Just sq'@SndQueue {dbReplaceQueueId = Just replaceQId} -> do
-                case find (\q -> replaceQId == q.dbQueueId) sqs of
+                case find ((replaceQId ==) . dbQId) sqs of
                  Just sq1 -> do
                    checkSQSwchStatus sq1 SSSendingQKEY
                    logServer "<--" c srv rId $ "MSG <QUSE> " <> logSecret (snd addr)
@@ -2431,8 +2482,7 @@ storeConfirmation c ConnData {connId, connAgentVersion} sq e2eEncryption_ agentM
 enqueueRatchetKeyMsgs :: forall m. AgentMonad m => AgentClient -> ConnData -> NonEmpty SndQueue -> CR.E2ERatchetParams 'C.X448 -> m AgentMsgId
 enqueueRatchetKeyMsgs c cData (sq :| sqs) e2eEncryption = do
  msgId <- enqueueRatchetKey c cData sq e2eEncryption
-  mapM_ (enqueueSavedMessage c cData msgId) $
-    filter (\SndQueue {status} -> status == Secured || status == Active) sqs
+  mapM_ (enqueueSavedMessage c cData msgId) $ filter isActiveSndQ sqs
  pure msgId

 enqueueRatchetKey :: forall m. AgentMonad m => AgentClient -> ConnData -> SndQueue -> CR.E2ERatchetParams 'C.X448 -> m AgentMsgId
@@ -10,7 +10,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -25,6 +24,7 @@ module Simplex.Messaging.Agent.Client
    ProtocolTestStep (..),
    newAgentClient,
    withConnLock,
+    withConnLocks,
    withInvLock,
    closeAgentClient,
    closeProtocolServerClients,
@@ -73,6 +73,7 @@ module Simplex.Messaging.Agent.Client
    logSecret,
    removeSubscription,
    hasActiveSubscription,
+    hasGetLock,
    agentClientStore,
    agentDRG,
    getAgentSubscriptions,
@@ -99,6 +100,8 @@ module Simplex.Messaging.Agent.Client
    withStore',
    withStoreCtx,
    withStoreCtx',
+    withStoreBatch,
+    withStoreBatch',
    storeError,
    userServers,
    pickServer,
@@ -235,7 +238,7 @@ data AgentClient = AgentClient
    pendingSubs :: TRcvQueues,
    removedSubs :: TMap (UserId, SMPServer, SMP.RecipientId) SMPClientError,
    pendingMsgsQueued :: TMap SndQAddr Bool,
-    smpQueueMsgQueues :: TMap SndQAddr (TQueue InternalId, TMVar ()),
+    smpQueueMsgQueues :: TMap SndQAddr (TQueue (InternalId, Bool), TMVar ()),
    smpQueueMsgDeliveries :: TMap SndQAddr (Async ()),
    connCmdsQueued :: TMap ConnId Bool,
    asyncCmdQueues :: TMap (Maybe SMPServer) (TQueue AsyncCmdId),
@@ -444,7 +447,7 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} tSess@(userId, srv,
          TM.delete tSess smpClients
          qs <- RQ.getDelSessQueues tSess $ activeSubs c
          mapM_ (`RQ.addQueue` pendingSubs c) qs
-          let cs = S.fromList $ map (\q -> q.connId) qs
+          let cs = S.fromList $ map qConnId qs
          cs' <- RQ.getConns $ activeSubs c
          pure (qs, S.toList $ cs `S.difference` cs')

@@ -658,8 +661,17 @@ withConnLock AgentClient {connLocks} connId name = withLockMap_ connLocks connId
 withInvLock :: MonadUnliftIO m => AgentClient -> ByteString -> String -> m a -> m a
 withInvLock AgentClient {invLocks} = withLockMap_ invLocks

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

@@ -827,7 +839,7 @@ mkSMPTransportSession :: (AgentMonad' m, SMPQueueRec q) => AgentClient -> q -> m
 mkSMPTransportSession c q = mkSMPTSession q <$> getSessionMode c

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

 getSessionMode :: AgentMonad' m => AgentClient -> m TransportSessionMode
 getSessionMode = fmap sessionMode . readTVarIO . useNetworkConfig
@@ -898,8 +910,8 @@ subscribeQueues c qs = do
  -- only "checked" queues are subscribed
  (errs <>) <$> sendTSessionBatches "SUB" 90 id (subscribeQueues_ u) c qs'
  where
-    checkQueue rq@RcvQueue {rcvId, server} = do
-      prohibited <- atomically . TM.member (server, rcvId) $ getMsgLocks c
+    checkQueue rq = do
+      prohibited <- atomically $ hasGetLock c rq
      pure $ if prohibited then Left (rq, Left $ CMD PROHIBITED) else Right rq
    subscribeQueues_ :: UnliftIO m -> SMPClient -> NonEmpty RcvQueue -> IO (BatchResponses SMPClientError ())
    subscribeQueues_ u smp qs' = do
@@ -1050,6 +1062,10 @@ sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = do
    ackSMPMessage smp rcvPrivateKey rcvId msgId
  atomically $ releaseGetLock c rq

+hasGetLock :: AgentClient -> RcvQueue -> STM Bool
+hasGetLock c RcvQueue {server, rcvId} =
+  TM.member (server, rcvId) $ getMsgLocks c
+
 releaseGetLock :: AgentClient -> RcvQueue -> STM ()
 releaseGetLock c RcvQueue {server, rcvId} =
  TM.lookup (server, rcvId) (getMsgLocks c) >>= mapM_ (`tryPutTMVar` ())
@@ -1287,6 +1303,18 @@ withStoreCtx_ ctx_ c action = do
    handleInternal :: String -> E.SomeException -> IO (Either StoreError a)
    handleInternal ctxStr e = pure . Left . SEInternal . B.pack $ show e <> ctxStr

+withStoreBatch :: (AgentMonad' m, Traversable t) => AgentClient -> (DB.Connection -> t (IO (Either AgentErrorType a))) -> m (t (Either AgentErrorType a))
+withStoreBatch c actions = do
+  st <- asks store
+  liftIO $ agentOperationBracket c AODatabase (\_ -> pure ()) $
+      withTransaction st $ mapM (`E.catch` handleInternal) . actions
+  where
+    handleInternal :: E.SomeException -> IO (Either AgentErrorType a)
+    handleInternal = pure . Left . INTERNAL . show
+
+withStoreBatch' :: (AgentMonad' m, Traversable t) => AgentClient -> (DB.Connection -> t (IO a)) -> m (t (Either AgentErrorType a))
+withStoreBatch' c actions = withStoreBatch c $ \db -> fmap Right <$> actions db
+
 storeError :: StoreError -> AgentErrorType
 storeError = \case
  SEConnNotFound -> CONN NOT_FOUND
@@ -34,6 +34,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
+import Data.ByteArray (ScrubbedBytes)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map (Map)
@@ -163,7 +164,7 @@ defaultAgentConfig =
      ntfWorkerDelay = 100000, -- microseconds
      ntfSMPWorkerDelay = 500000, -- microseconds
      ntfSubCheckInterval = nominalDay,
-      ntfMaxMessages = 4,
+      ntfMaxMessages = 3,
      -- CA certificate private key is not needed for initialization
      -- ! we do not generate these
      caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
@@ -196,8 +197,8 @@ newSMPAgentEnv config@AgentConfig {initialClientId} store = do
  multicastSubscribers <- newTMVarIO 0
  pure Env {config, store, random, clientCounter, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}

-createAgentStore :: FilePath -> String -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
-createAgentStore dbFilePath dbKey = createSQLiteStore dbFilePath dbKey Migrations.app
+createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createAgentStore dbFilePath dbKey keepKey = createSQLiteStore dbFilePath dbKey keepKey Migrations.app

 data NtfSupervisor = NtfSupervisor
  { ntfTkn :: TVar (Maybe NtfToken),
@@ -1,8 +1,20 @@
-module Simplex.Messaging.Agent.Lock where
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Agent.Lock
+  ( Lock,
+    createLock,
+    withLock,
+    withGetLock,
+    withGetLocks,
+  )
+where

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

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

-withGetLock :: MonadUnliftIO m => STM Lock -> String -> m a -> m a
-withGetLock getLock name a =
+withGetLock :: MonadUnliftIO m => (k -> STM Lock) -> k -> String -> m a -> m a
+withGetLock getLock key name a =
  E.bracket
-    (atomically $ getLock >>= \l -> putTMVar l name $> l)
+    (atomically $ getPutLock getLock key name)
    (atomically . takeTMVar)
    (const a)
+
+withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> Set k -> String -> m a -> m a
+withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const
+  where
+    holdLocks = forConcurrently (S.toList keys) $ \key -> atomically $ getPutLock getLock key name
+    -- only this withGetLocks would be holding the locks,
+    -- so it's safe to combine all lock releases into one transaction
+    releaseLocks = atomically . mapM_ takeTMVar
+
+-- getLock and putTMVar can be in one transaction on the assumption that getLock doesn't write in case the lock already exists,
+-- and in case it is created and added to some shared resource (we use TMap) it also helps avoid contention for the newly created lock.
+getPutLock :: (k -> STM Lock) -> k -> String -> STM Lock
+getPutLock getLock key name = getLock key >>= \l -> putTMVar l name $> l
@@ -193,6 +193,7 @@ import Simplex.Messaging.Protocol
    MsgId,
    NMsgMeta,
    ProtocolServer (..),
+    SMPMsgMeta,
    SMPServer,
    SMPServerWithAuth,
    SndPublicVerifyKey,
@@ -337,6 +338,7 @@ data ACommand (p :: AParty) (e :: AEntity) where
  SENT :: AgentMsgId -> ACommand Agent AEConn
  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn
  MSG :: MsgMeta -> MsgFlags -> MsgBody -> ACommand Agent AEConn
+  MSGNTF :: SMPMsgMeta -> ACommand Agent AEConn
  ACK :: AgentMsgId -> Maybe MsgReceiptInfo -> ACommand Client AEConn
  RCVD :: MsgMeta -> NonEmpty MsgReceipt -> ACommand Agent AEConn
  SWCH :: ACommand Client AEConn
@@ -397,6 +399,7 @@ data ACommandTag (p :: AParty) (e :: AEntity) where
  SENT_ :: ACommandTag Agent AEConn
  MERR_ :: ACommandTag Agent AEConn
  MSG_ :: ACommandTag Agent AEConn
+  MSGNTF_ :: ACommandTag Agent AEConn
  ACK_ :: ACommandTag Client AEConn
  RCVD_ :: ACommandTag Agent AEConn
  SWCH_ :: ACommandTag Client AEConn
@@ -450,6 +453,7 @@ aCommandTag = \case
  SENT _ -> SENT_
  MERR {} -> MERR_
  MSG {} -> MSG_
+  MSGNTF {} -> MSGNTF_
  ACK {} -> ACK_
  RCVD {} -> RCVD_
  SWCH -> SWCH_
@@ -1604,6 +1608,7 @@ instance StrEncoding ACmdTag where
      "SENT" -> ct SENT_
      "MERR" -> ct MERR_
      "MSG" -> ct MSG_
+      "MSGNTF" -> ct MSGNTF_
      "ACK" -> t ACK_
      "RCVD" -> ct RCVD_
      "SWCH" -> t SWCH_
@@ -1659,6 +1664,7 @@ instance (APartyI p, AEntityI e) => StrEncoding (ACommandTag p e) where
    SENT_ -> "SENT"
    MERR_ -> "MERR"
    MSG_ -> "MSG"
+    MSGNTF_ -> "MSGNTF"
    ACK_ -> "ACK"
    RCVD_ -> "RCVD"
    SWCH_ -> "SWCH"
@@ -1727,6 +1733,7 @@ commandP binaryP =
          SENT_ -> s (SENT <$> A.decimal)
          MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP)
          MSG_ -> s (MSG <$> strP <* A.space <*> smpP <* A.space <*> binaryP)
+          MSGNTF_ -> s (MSGNTF <$> strP)
          RCVD_ -> s (RCVD <$> strP <* A.space <*> strP)
          DEL_RCVQ_ -> s (DEL_RCVQ <$> strP_ <*> strP_ <*> strP)
          DEL_CONN_ -> pure DEL_CONN
@@ -1781,6 +1788,7 @@ serializeCommand = \case
  SENT mId -> s (SENT_, Str $ bshow mId)
  MERR mId e -> s (MERR_, Str $ bshow mId, e)
  MSG msgMeta msgFlags msgBody -> B.unwords [s MSG_, s msgMeta, smpEncode msgFlags, serializeBinary msgBody]
+  MSGNTF smpMsgMeta -> s (MSGNTF_, smpMsgMeta)
  ACK mId rcptInfo_ -> s (ACK_, Str $ bshow mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_
  RCVD msgMeta rcpts -> s (RCVD_, msgMeta, rcpts)
  SWCH -> s SWCH_
@@ -8,7 +8,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -27,7 +26,6 @@ import qualified Data.List.NonEmpty as L
 import Data.Maybe (isJust)
 import Data.Time (UTCTime)
 import Data.Type.Equality
-import GHC.Records (HasField)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
 import qualified Simplex.Messaging.Crypto as C
@@ -182,16 +180,34 @@ switchingRQ = find $ isJust . rcvSwchStatus
 {-# INLINE switchingRQ #-}

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

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

 -- * Connection types

@@ -10,7 +10,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -32,7 +31,10 @@ module Simplex.Messaging.Agent.Store.SQLite
    connectSQLiteStore,
    closeSQLiteStore,
    openSQLiteStore,
+    reopenSQLiteStore,
    sqlString,
+    keyString,
+    storeKey,
    execSQL,
    upMigration, -- used in tests

@@ -222,6 +224,8 @@ import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (second)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base64.URL as U
 import Data.Char (toLower)
@@ -268,7 +272,7 @@ import Simplex.Messaging.Parsers (blobFieldParser, defaultJSON, dropPrefix, from
 import Simplex.Messaging.Protocol
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (bshow, eitherToMaybe, groupOn, ifM, ($>>=), (<$$>))
+import Simplex.Messaging.Util (bshow, eitherToMaybe, groupOn, ifM, safeDecodeUtf8, ($>>=), (<$$>))
 import Simplex.Messaging.Version
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Exit (exitFailure)
@@ -317,11 +321,11 @@ instance StrEncoding MigrationConfirmation where
      "error" -> pure MCError
      _ -> fail "invalid MigrationConfirmation"

-createSQLiteStore :: FilePath -> String -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
-createSQLiteStore dbFilePath dbKey migrations confirmMigrations = do
+createSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
+createSQLiteStore dbFilePath dbKey keepKey migrations confirmMigrations = do
  let dbDir = takeDirectory dbFilePath
  createDirectoryIfMissing True dbDir
-  st <- connectSQLiteStore dbFilePath dbKey
+  st <- connectSQLiteStore dbFilePath dbKey keepKey
  r <- migrateSchema st migrations confirmMigrations `onException` closeSQLiteStore st
  case r of
    Right () -> pure $ Right st
@@ -367,17 +371,17 @@ confirmOrExit s = do
  ok <- getLine
  when (map toLower ok /= "y") exitFailure

-connectSQLiteStore :: FilePath -> String -> IO SQLiteStore
-connectSQLiteStore dbFilePath dbKey = do
+connectSQLiteStore :: FilePath -> ScrubbedBytes -> Bool -> IO SQLiteStore
+connectSQLiteStore dbFilePath key keepKey = do
  dbNew <- not <$> doesFileExist dbFilePath
-  dbConn <- dbBusyLoop (connectDB dbFilePath dbKey)
+  dbConn <- dbBusyLoop (connectDB dbFilePath key)
  atomically $ do
    dbConnection <- newTMVar dbConn
-    dbEncrypted <- newTVar . not $ null dbKey
+    dbKey <- newTVar $! storeKey key keepKey
    dbClosed <- newTVar False
-    pure SQLiteStore {dbFilePath, dbEncrypted, dbConnection, dbNew, dbClosed}
+    pure SQLiteStore {dbFilePath, dbKey, dbConnection, dbNew, dbClosed}

-connectDB :: FilePath -> String -> IO DB.Connection
+connectDB :: FilePath -> ScrubbedBytes -> IO DB.Connection
 connectDB path key = do
  db <- DB.open path
  prepare db `onException` DB.close db
@@ -386,7 +390,7 @@ connectDB path key = do
  where
    prepare db = do
      let exec = SQLite3.exec $ SQL.connectionHandle $ DB.conn db
-      unless (null key) . exec $ "PRAGMA key = " <> sqlString key <> ";"
+      unless (BA.null key) . exec $ "PRAGMA key = " <> keyString key <> ";"
      exec . fromQuery $
        [sql|
          PRAGMA busy_timeout = 100;
@@ -403,22 +407,36 @@ closeSQLiteStore st@SQLiteStore {dbClosed} =
      DB.close conn
      atomically $ writeTVar dbClosed True

-openSQLiteStore :: SQLiteStore -> String -> IO ()
-openSQLiteStore SQLiteStore {dbConnection, dbFilePath, dbClosed} key =
-  ifM (readTVarIO dbClosed) open (putStrLn "closeSQLiteStore: already opened")
+openSQLiteStore :: SQLiteStore -> ScrubbedBytes -> Bool -> IO ()
+openSQLiteStore st@SQLiteStore {dbClosed} key keepKey =
+  ifM (readTVarIO dbClosed) (openSQLiteStore_ st key keepKey) (putStrLn "openSQLiteStore: already opened")
+
+openSQLiteStore_ :: SQLiteStore -> ScrubbedBytes -> Bool -> IO ()
+openSQLiteStore_ SQLiteStore {dbConnection, dbFilePath, dbKey, dbClosed} key keepKey =
+  bracketOnError
+    (atomically $ takeTMVar dbConnection)
+    (atomically . tryPutTMVar dbConnection)
+    $ \DB.Connection {slow} -> do
+      DB.Connection {conn} <- connectDB dbFilePath key
+      atomically $ do
+        putTMVar dbConnection DB.Connection {conn, slow}
+        writeTVar dbClosed False
+        writeTVar dbKey $! storeKey key keepKey
+
+reopenSQLiteStore :: SQLiteStore -> IO ()
+reopenSQLiteStore st@SQLiteStore {dbKey, dbClosed} =
+  ifM (readTVarIO dbClosed) open (putStrLn "reopenSQLiteStore: already opened")
  where
    open =
-      bracketOnError
-        (atomically $ takeTMVar dbConnection)
-        (atomically . tryPutTMVar dbConnection)
-        $ \DB.Connection {slow} -> do
-          DB.Connection {conn} <- connectDB dbFilePath key
-          atomically $ do
-            putTMVar dbConnection DB.Connection {conn, slow}
-            writeTVar dbClosed False
+      readTVarIO dbKey >>= \case
+        Just key -> openSQLiteStore_ st key True
+        Nothing -> fail "reopenSQLiteStore: no key"

-sqlString :: String -> Text
-sqlString s = quote <> T.replace quote "''" (T.pack s) <> quote
+keyString :: ScrubbedBytes -> Text
+keyString = sqlString . safeDecodeUtf8 . BA.convert
+
+sqlString :: Text -> Text
+sqlString s = quote <> T.replace quote "''" s <> quote
  where
    quote = "'"

@@ -1972,7 +1990,7 @@ 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, internalHash, internalRcvId} =
+updateHashRcv_ dbConn connId RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalHash, internalRcvId} =
  DB.executeNamed
    dbConn
    -- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
@@ -1983,7 +2001,7 @@ updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
      WHERE conn_id = :conn_id
        AND last_internal_rcv_msg_id = :last_internal_rcv_msg_id;
    |]
-    [ ":last_external_snd_msg_id" := msgMeta.sndMsgId,
+    [ ":last_external_snd_msg_id" := sndMsgId,
      ":last_rcv_msg_hash" := internalHash,
      ":conn_id" := connId,
      ":last_internal_rcv_msg_id" := internalRcvId
@@ -10,10 +10,13 @@ module Simplex.Messaging.Agent.Store.SQLite.Common
    withTransaction',
    withTransactionCtx,
    dbBusyLoop,
+    storeKey,
  )
 where

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

+storeKey :: ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
+storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
+
 data SQLiteStore = SQLiteStore
  { dbFilePath :: FilePath,
-    dbEncrypted :: TVar Bool,
+    dbKey :: TVar (Maybe ScrubbedBytes),
    dbConnection :: TMVar DB.Connection,
    dbClosed :: TVar Bool,
    dbNew :: Bool
@@ -48,7 +48,7 @@ timeIt slow sql a = do
  r <- a
  t' <- getCurrentTime
  let diff = diffToMilliseconds $ diffUTCTime t' t
-  atomically $ when (diff > 50) $ TM.alter (updateQueryStats diff) sql slow
+  atomically $ when (diff > 5) $ TM.alter (updateQueryStats diff) sql slow
  pure r
  where
    updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
@@ -226,9 +226,9 @@ defaultNetworkConfig =
      hostMode = HMOnionViaSocks,
      requiredHostMode = False,
      sessionMode = TSMUser,
-      tcpConnectTimeout = 15_000_000,
-      tcpTimeout = 10_000_000,
-      tcpTimeoutPerKb = 20_000, -- 20ms, should be less than 130ms to avoid Int overflow on 32 bit systems
+      tcpConnectTimeout = 20_000_000,
+      tcpTimeout = 15_000_000,
+      tcpTimeoutPerKb = 45_000, -- 45ms, should be less than 130ms to avoid Int overflow on 32 bit systems
      tcpKeepAlive = Just defaultKeepAliveOpts,
      smpPingInterval = 600_000_000, -- 10min
      smpPingCount = 3,
@@ -1,6 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}

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

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

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

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

    -- * Parse and serialize
    ProtocolMsgTag (..),
@@ -356,6 +358,16 @@ data Message
        msgTs :: SystemTime
      }

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

 rcvMessageMeta :: MsgId -> ClientRcvMsgBody -> SMPMsgMeta
 rcvMessageMeta msgId = \case
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -7,7 +8,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -49,18 +49,16 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (fromRight, partitionEithers)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (intercalate, sort)
+import Data.List (intercalate)
 import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
 import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Data.Type.Equality
-import GHC.Conc (listThreads, threadStatus)
-import GHC.Conc.Sync (threadLabel)
 import GHC.Stats (getRTSStats)
 import GHC.TypeLits (KnownNat)
 import Network.Socket (ServiceName, Socket, socketToHandle)
@@ -92,6 +90,12 @@ import UnliftIO.Directory (doesFileExist, renameFile)
 import UnliftIO.Exception
 import UnliftIO.IO
 import UnliftIO.STM
+#if MIN_VERSION_base(4,18,0)
+import Data.List (sort)
+import Data.Maybe (fromMaybe)
+import GHC.Conc (listThreads, threadStatus)
+import GHC.Conc.Sync (threadLabel)
+#endif

 -- | Runs an SMP server using passed configuration.
 --
@@ -297,12 +301,16 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                  putStat label var = readTVarIO var >>= \v -> hPutStrLn h $ label <> ": " <> show v
              CPStatsRTS -> getRTSStats >>= hPutStrLn h . show
              CPThreads -> do
+#if MIN_VERSION_base(4,18,0)
                threads <- liftIO listThreads
                hPutStrLn h $ "Threads: " <> show (length threads)
                forM_ (sort threads) $ \tid -> do
                  label <- threadLabel tid
                  status <- threadStatus tid
                  hPutStrLn h $ show tid <> " (" <> show status <> ") " <> fromMaybe "" label
+#else
+                hPutStrLn h "Not available on GHC 8.10"
+#endif
              CPSave -> withLock (savingLock srv) "control" $ do
                hPutStrLn h "saving server state..."
                unliftIO u $ saveServer True
@@ -318,7 +326,7 @@ runClientTransport th@THandle {thVersion, sessionId} = do
  c <- atomically $ newClient q thVersion sessionId ts
  s <- asks server
  expCfg <- asks $ inactiveClientExpiration . config
-  labelMyThread . B.unpack $ "client $" <> encode c.sessionId
+  labelMyThread . B.unpack $ "client $" <> encode sessionId
  raceAny_ ([liftIO $ send th c, client c s, receive th c] <> disconnectThread_ c expCfg)
    `finally` clientDisconnected c
  where
@@ -441,8 +449,8 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
 dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"

 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
-client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
-  labelMyThread . B.unpack $ "client $" <> encode clnt.sessionId <> " commands"
+client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
+  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
  forever $
    atomically (readTBQueue rcvQ)
      >>= mapM processCommand
@@ -763,11 +771,11 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Serv
            encrypt msgFlags body =
              let encBody = EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body
               in RcvMessage msgId' msgTs' msgFlags encBody
-            msgId' = msg.msgId
-            msgTs' = msg.msgTs
+            msgId' = messageId msg
+            msgTs' = messageTs msg

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

        getStoreMsgQueue :: T.Text -> RecipientId -> m MsgQueue
        getStoreMsgQueue name rId = time (name <> " getMsgQueue") $ do
@@ -867,7 +875,7 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
                    | maybe True (systemSeconds msgTs >=) old_ -> isNothing <$> writeMsg q msg
                    | otherwise -> pure False
                  MessageQuota {} -> writeMsg q msg $> False
-              when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode msg.msgId
+              when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
            updateMsgV1toV3 QueueRec {rcvDhSecret} RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = do
              let nonce = C.cbNonce msgId
              msgBody <- liftEither . first (msgErr "v1 message decryption") $ C.maxLenBS =<< C.cbDecrypt rcvDhSecret nonce body
@@ -11,7 +11,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
 import Data.Set (Set)
 import qualified Data.Set as S
-import Data.Time.Calendar.Month.Compat (pattern MonthDay)
+import Data.Time.Calendar.Month (pattern MonthDay)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
 import Simplex.Messaging.Encoding.String
@@ -85,6 +85,26 @@ unlessM b = ifM b $ pure ()
 ($>>=) :: (Monad m, Monad f, Traversable f) => m (f a) -> (a -> m (f b)) -> m (f b)
 f $>>= g = f >>= fmap join . mapM g

+mapME :: (Monad m, Traversable t) => (a -> m (Either e b)) -> t (Either e a) -> m (t (Either e b))
+mapME f = mapM (mapE f)
+{-# INLINE mapME #-}
+
+mapME_ :: (Monad m, Traversable t) => (a -> m (Either e b)) -> t (Either e a) -> m ()
+mapME_ f = mapM_ (mapE f)
+{-# INLINE mapME_ #-}
+
+mapE :: Monad m => (a -> m (Either e b)) -> Either e a -> m (Either e b)
+mapE = either (pure . Left)
+{-# INLINE mapE #-}
+
+forME :: (Monad m, Traversable t) => t (Either e a) -> (a -> m (Either e b)) -> m (t (Either e b))
+forME = flip mapME
+{-# INLINE forME #-}
+
+forME_ :: (Monad m, Traversable t) => t (Either e a) -> (a -> m (Either e b)) -> m ()
+forME_ f = void . forME f
+{-# INLINE forME_ #-}
+
 catchAll :: IO a -> (E.SomeException -> IO a) -> IO a
 catchAll = E.catch
 {-# INLINE catchAll #-}
@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -162,7 +161,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
            case chain of
              [_leaf, ca] -> do
                let kh = certFingerprint ca
-                    accept = maybe True (\h -> h.hostFingerprint == kh) knownHost_
+                    accept = maybe True (\h -> hostFingerprint h == kh) knownHost_
                if accept
                  then atomically (putTMVar hostCAHash kh) $> TLS.CertificateUsageAccept
                  else pure $ TLS.CertificateUsageReject TLS.CertificateRejectUnknownCA
@@ -234,7 +233,7 @@ prepareHostSession
      updateKnownHost :: C.KeyHash -> C.PublicKeyX25519 -> ExceptT RCErrorType IO KnownHostPairing
      updateKnownHost ca hostDhPubKey = case knownHost_ of
        Just h -> do
-          unless (h.hostFingerprint == tlsHostFingerprint) . throwError $
+          unless (hostFingerprint h == tlsHostFingerprint) . throwError $
            RCEInternal "TLS host CA is different from host pairing, should be caught in TLS handshake"
          pure (h :: KnownHostPairing) {hostDhPubKey}
        Nothing -> pure KnownHostPairing {hostFingerprint = ca, hostDhPubKey}
@@ -1,88 +0,0 @@
-# This file was automatically generated by 'stack init'
-#
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-#
-# The location of a snapshot can be provided as a file or url. Stack assumes
-# a snapshot provided as a file might change, whereas a url resource does not.
-#
-# resolver: ./custom-snapshot.yaml
-# resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: nightly-2023-08-22
-
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-#   subdirs:
-#   - auto-update
-#   - wai
-packages:
-  - .
-# Dependency packages to be pulled from upstream that are not in the resolver.
-# These entries can reference officially published versions as well as
-# forks / in-progress versions pinned to a git hash. For example:
-#
-extra-deps:
-  - cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
-  - network-3.1.2.7@sha256:e3d78b13db9512aeb106e44a334ab42b7aa48d26c097299084084cb8be5c5568,4888
-  - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
-  - tls-1.6.0@sha256:7ae39373fd2de27fb80e90f76d22aeeb9a074a0ddd120cbd02c9c52f516a9e55,6987
-  # below dependencies are to update Aeson to 2.0.3
-  - OneTuple-0.3.1@sha256:a848c096c9d29e82ffdd30a9998aa2931cbccb3a1bc137539d80f6174d31603e,2262
-  - attoparsec-0.14.4@sha256:79584bdada8b730cb5138fca8c35c76fbef75fc1d1e01e6b1d815a5ee9843191,5810
-  - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005
-  - semialign-1.2.0.1@sha256:0e179b4d3a8eff79001d374d6c91917c6221696b9620f0a4d86852fc6a9b9501,2836
-  - text-short-0.1.5@sha256:962c6228555debdc46f758d0317dea16e5240d01419b42966674b08a5c3d8fa6,3498
-  - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033
-  - github: simplex-chat/aeson
-    commit: aab7b5a14d6c5ea64c64dcaee418de1bb00dcc2b
-  - github: kazu-yamamoto/http2
-    commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
-  # - ../direct-sqlcipher
-  - github: simplex-chat/direct-sqlcipher
-    commit: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
-  # - ../sqlcipher-simple
-  - github: simplex-chat/sqlcipher-simple
-    commit: a46bd361a19376c5211f1058908fc0ae6bf42446
-  - github: simplex-chat/network-transport
-    commit: 0013798272a683e35ca38d2fdaf480942311fba8
-  # - ../hs-tls/core
-  # - github: simplex-chat/hs-tls
-  #   commit: f6cc753611f80af300401cfae63846e9d7c40d9e
-  #   subdirs:
-  #     - core
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=2.1"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
@@ -1010,34 +1010,35 @@ testOnlyCreatePull :: IO ()
 testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
-  getMsg alice bobId
-  Just ("", _, CONF confId _ "bob's connInfo") <- timeout 5_000000 $ get alice
+  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
  allowConnection alice bobId confId "alice's connInfo"
  liftIO $ threadDelay 1_000000
-  getMsg bob aliceId
-  get bob ##> ("", aliceId, INFO "alice's connInfo")
+  getMsg bob aliceId $
+    get bob ##> ("", aliceId, INFO "alice's connInfo")
  liftIO $ threadDelay 1_000000
-  getMsg alice bobId
+  getMsg alice bobId $ pure ()
  get alice ##> ("", bobId, CON)
-  getMsg bob aliceId
-  get bob ##> ("", aliceId, CON)
+  getMsg bob aliceId $
+    get bob ##> ("", aliceId, CON)
  -- exchange messages
  4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
  get alice ##> ("", bobId, SENT 4)
-  getMsg bob aliceId
-  get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+  getMsg bob aliceId $
+    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
  ackMessage bob aliceId 4 Nothing
  5 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
  get bob ##> ("", aliceId, SENT 5)
-  getMsg alice bobId
-  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
+  getMsg alice bobId $
+    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
  ackMessage alice bobId 5 Nothing
  where
-    getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
-    getMsg c cId = do
+    getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
+    getMsg c cId action = do
      liftIO $ noMessages c "nothing should be delivered before GET"
      Just _ <- getConnectionMessage c cId
-      pure ()
+      r <- action
+      get c =##> \case ("", cId', MSGNTF _) -> cId == cId'; _ -> False
+      pure r

 makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
 makeConnection alice bob = makeConnectionForUsers alice 1 bob 1
@@ -2049,7 +2050,7 @@ testTwoUsers = withAgentClients2 $ \a b -> do

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

 testServerMultipleIdentities :: HasCallStack => IO ()
@@ -178,16 +178,16 @@ testMigration ::
 testMigration (initMs, initTables) (finalMs, confirmModes, tablesOrError) = forM_ confirmModes $ \confirmMode -> do
  r <- randomIO :: IO Word32
  let dpPath = testDB <> show r
-  Right st <- createSQLiteStore dpPath "" initMs MCError
+  Right st <- createSQLiteStore dpPath "" False initMs MCError
  st `shouldHaveTables` initTables
  closeSQLiteStore st
  case tablesOrError of
    Right tables -> do
-      Right st' <- createSQLiteStore dpPath "" finalMs confirmMode
+      Right st' <- createSQLiteStore dpPath "" False finalMs confirmMode
      st' `shouldHaveTables` tables
      closeSQLiteStore st'
    Left e -> do
-      Left e' <- createSQLiteStore dpPath "" finalMs confirmMode
+      Left e' <- createSQLiteStore dpPath "" False finalMs confirmMode
      e `shouldBe` e'
  removeFile dpPath
  where
@@ -16,6 +16,7 @@ import Control.Concurrent.STM
 import Control.Exception (SomeException)
 import Control.Monad (replicateM_)
 import Crypto.Random (drgNew)
+import Data.ByteArray (ScrubbedBytes)
 import Data.ByteString.Char8 (ByteString)
 import Data.List (isInfixOf)
 import qualified Data.Text as T
@@ -49,18 +50,18 @@ withStore2 = before connect2 . after (removeStore . fst)
    connect2 :: IO (SQLiteStore, SQLiteStore)
    connect2 = do
      s1 <- createStore
-      s2 <- connectSQLiteStore (dbFilePath s1) ""
+      s2 <- connectSQLiteStore (dbFilePath s1) "" False
      pure (s1, s2)

 createStore :: IO SQLiteStore
-createStore = createEncryptedStore ""
+createStore = createEncryptedStore "" False

-createEncryptedStore :: String -> IO SQLiteStore
-createEncryptedStore key = do
+createEncryptedStore :: ScrubbedBytes -> Bool -> IO SQLiteStore
+createEncryptedStore key keepKey = do
  -- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
  -- IO operations on multiple similarly named files; error seems to be environment specific
  r <- randomIO :: IO Word32
-  Right st <- createSQLiteStore (testDB <> show r) key Migrations.app MCError
+  Right st <- createSQLiteStore (testDB <> show r) key keepKey Migrations.app MCError
  pure st

 removeStore :: SQLiteStore -> IO ()
@@ -112,6 +113,7 @@ storeTests = do
  describe "open/close store" $ do
    it "should close and re-open" testCloseReopenStore
    it "should close and re-open encrypted store" testCloseReopenEncryptedStore
+    it "should close and re-open encrypted store (keep key)" testReopenEncryptedStoreKeepKey

 testConcurrentWrites :: SpecWith (SQLiteStore, SQLiteStore)
 testConcurrentWrites =
@@ -520,28 +522,39 @@ testCloseReopenStore = do
  closeSQLiteStore st
  closeSQLiteStore st
  errorGettingMigrations st
-  openSQLiteStore st ""
-  openSQLiteStore st ""
+  openSQLiteStore st "" False
+  openSQLiteStore st "" False
  hasMigrations st
  closeSQLiteStore st
  errorGettingMigrations st
-  openSQLiteStore st ""
+  reopenSQLiteStore st
  hasMigrations st

 testCloseReopenEncryptedStore :: IO ()
 testCloseReopenEncryptedStore = do
  let key = "test_key"
-  st <- createEncryptedStore key
+  st <- createEncryptedStore key False
  hasMigrations st
  closeSQLiteStore st
  closeSQLiteStore st
  errorGettingMigrations st
-  openSQLiteStore st key
-  openSQLiteStore st key
+  reopenSQLiteStore st `shouldThrow` \(e :: SomeException) -> "reopenSQLiteStore: no key" `isInfixOf` show e
+  openSQLiteStore st key True
+  openSQLiteStore st key True
  hasMigrations st
  closeSQLiteStore st
  errorGettingMigrations st
-  openSQLiteStore st key
+  reopenSQLiteStore st
+  hasMigrations st
+
+testReopenEncryptedStoreKeepKey :: IO ()
+testReopenEncryptedStoreKeepKey = do
+  let key = "test_key"
+  st <- createEncryptedStore key True
+  hasMigrations st
+  closeSQLiteStore st
+  errorGettingMigrations st
+  reopenSQLiteStore st
  hasMigrations st

 getMigrations :: SQLiteStore -> IO Bool
@@ -33,14 +33,14 @@ testVerifySchemaDump :: IO ()
 testVerifySchemaDump = do
  savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
  savedSchema `deepseq` pure ()
-  void $ createSQLiteStore testDB "" Migrations.app MCConsole
+  void $ createSQLiteStore testDB "" False Migrations.app MCConsole
  getSchema testDB appSchema `shouldReturn` savedSchema
  removeFile testDB

 testSchemaMigrations :: IO ()
 testSchemaMigrations = do
  let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Migrations.app
-  Right st <- createSQLiteStore testDB "" noDownMigrations MCError
+  Right st <- createSQLiteStore testDB "" False noDownMigrations MCError
  mapM_ (testDownMigration st) $ drop (length noDownMigrations) Migrations.app
  closeSQLiteStore st
  removeFile testDB
@@ -6,7 +6,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -135,8 +134,8 @@ ntfServerTest ::
 ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
  where
    tPut' :: THandle c -> (Maybe C.ASignature, ByteString, ByteString, smp) -> IO ()
-    tPut' h (sig, corrId, queueId, smp) = do
-      let t' = smpEncode (h.sessionId, corrId, queueId, smp)
+    tPut' h@THandle {sessionId} (sig, corrId, queueId, smp) = do
+      let t' = smpEncode (sessionId, corrId, queueId, smp)
      [Right ()] <- tPut h Nothing [(sig, t')]
      pure ()
    tGet' h = do
@@ -1,6 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}

 module RemoteControl where
@@ -11,6 +10,7 @@ import Crypto.Random (ChaChaDRG, drgNew)
 import qualified Data.Aeson as J
 import Data.List.NonEmpty (NonEmpty (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
+import qualified Simplex.RemoteControl.Client as HC (RCHostClient (action))
 import qualified Simplex.RemoteControl.Client as RC
 import Simplex.RemoteControl.Discovery (mkLastLocalHost, preferAddress)
 import Simplex.RemoteControl.Invitation (RCSignedInvitation, verifySignedInvitation)
@@ -32,33 +32,33 @@ testPreferAddress :: Spec
 testPreferAddress = do
  it "suppresses localhost" $
    mkLastLocalHost addrs
-      `shouldBe` [ "10.20.30.40" @ "eth0",
-                   "10.20.30.42" @ "wlan0",
-                   "127.0.0.1" @ "lo"
+      `shouldBe` [ "10.20.30.40" `on` "eth0",
+                   "10.20.30.42" `on` "wlan0",
+                   "127.0.0.1" `on` "lo"
                 ]
  it "finds by address" $ do
-    preferAddress ("127.0.0.1" @ "lo23") addrs' `shouldBe` addrs -- localhost is back on top
-    preferAddress ("10.20.30.42" @ "wlp2s0") addrs'
-      `shouldBe` [ "10.20.30.42" @ "wlan0",
-                   "10.20.30.40" @ "eth0",
-                   "127.0.0.1" @ "lo"
+    preferAddress ("127.0.0.1" `on` "lo23") addrs' `shouldBe` addrs -- localhost is back on top
+    preferAddress ("10.20.30.42" `on` "wlp2s0") addrs'
+      `shouldBe` [ "10.20.30.42" `on` "wlan0",
+                   "10.20.30.40" `on` "eth0",
+                   "127.0.0.1" `on` "lo"
                 ]
  it "finds by interface" $ do
-    preferAddress ("127.1.2.3" @ "lo") addrs' `shouldBe` addrs
-    preferAddress ("0.0.0.0" @ "eth0") addrs' `shouldBe` addrs'
+    preferAddress ("127.1.2.3" `on` "lo") addrs' `shouldBe` addrs
+    preferAddress ("0.0.0.0" `on` "eth0") addrs' `shouldBe` addrs'
  it "survives duplicates" $ do
-    preferAddress ("0.0.0.0" @ "eth1") addrsDups `shouldBe` addrsDups
-    preferAddress ("0.0.0.0" @ "eth0") ifaceDups `shouldBe` ifaceDups
+    preferAddress ("0.0.0.0" `on` "eth1") addrsDups `shouldBe` addrsDups
+    preferAddress ("0.0.0.0" `on` "eth0") ifaceDups `shouldBe` ifaceDups
  where
-    th @ interface = RCCtrlAddress {address = either error id $ strDecode th, interface}
+    on th interface = RCCtrlAddress {address = either error id $ strDecode th, interface}
    addrs =
-      [ "127.0.0.1" @ "lo", -- localhost may go first and break things
-        "10.20.30.40" @ "eth0",
-        "10.20.30.42" @ "wlan0"
+      [ "127.0.0.1" `on` "lo", -- localhost may go first and break things
+        "10.20.30.40" `on` "eth0",
+        "10.20.30.42" `on` "wlan0"
      ]
    addrs' = mkLastLocalHost addrs
-    addrsDups = "10.20.30.40" @ "eth1" : addrs'
-    ifaceDups = "10.20.30.41" @ "eth0" : addrs'
+    addrsDups = "10.20.30.40" `on` "eth1" : addrs'
+    ifaceDups = "10.20.30.41" `on` "eth0" : addrs'

 testNewPairing :: IO ()
 testNewPairing = do
@@ -98,7 +98,7 @@ testNewPairing = do
    logNote "ctrl: adios"
    pure sessId'

-  waitCatch hc.action >>= \case
+  waitCatch (HC.action hc) >>= \case
    Left err -> fromException err `shouldBe` Just AsyncCancelled
    Right () -> fail "Unexpected controller finish"

@@ -213,7 +213,7 @@ withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
      initServers' = initAgentServers {smp = userServers [ProtoServerWithAuth (SMPServer "localhost" smpPort' testKeyHash) Nothing]}
   in serverBracket
        ( \started -> do
-            Right st <- liftIO $ createAgentStore db' "" MCError
+            Right st <- liftIO $ createAgentStore db' "" False MCError
            runSMPAgentBlocking t cfg' initServers' st started
        )
        afterProcess
@@ -2,9 +2,9 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -161,8 +161,8 @@ smpServerTest ::
 smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
  where
    tPut' :: THandle c -> (Maybe C.ASignature, ByteString, ByteString, smp) -> IO ()
-    tPut' h (sig, corrId, queueId, smp) = do
-      let t' = smpEncode (h.sessionId, corrId, queueId, smp)
+    tPut' h@THandle {sessionId} (sig, corrId, queueId, smp) = do
+      let t' = smpEncode (sessionId, corrId, queueId, smp)
      [Right ()] <- tPut h Nothing [(sig, t')]
      pure ()
    tGet' h = do
@@ -142,7 +142,7 @@ runTestFileChunkDelete s r = do
  deleteXFTPChunk s spKey sId
  liftIO $
    readChunk sId
-      `shouldThrow` \(e :: SomeException) -> "withBinaryFile" `isInfixOf` show e
+      `shouldThrow` \(e :: SomeException) -> "does not exist" `isInfixOf` show e
  downloadXFTPChunk r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
  deleteXFTPChunk s spKey sId
Author	SHA1	Message	Date
Evgeny Poberezkin	d8201f2263	deduplicate connections for locking	2023-12-18 21:09:40 +00:00
Evgeny Poberezkin	c1b33e68e3	comment	2023-12-18 20:57:39 +00:00
Evgeny Poberezkin	1b8bab91b5	traversable	2023-12-18 20:53:47 +00:00
IC Rainbow	70a4984305	remove db-related zipping	2023-12-18 18:02:08 +02:00
IC Rainbow	1aff769285	add liftA2 for 8.10 compat	2023-12-18 17:35:30 +02:00
IC Rainbow	ea714c731c	remove IORefs	2023-12-18 17:13:47 +02:00
Evgeny Poberezkin	cb89b963bf	attempt 5	2023-12-18 11:34:25 +00:00
Evgeny Poberezkin	d8ec57602f	handle errors in batch sending	2023-12-16 19:21:08 +00:00
Evgeny Poberezkin	b9a5b7802c	agent: batch sending messages (attempt 4)	2023-12-16 19:14:53 +00:00
Evgeny Poberezkin	18be2709f5	use crypton instead of cryptonite (#919 )	2023-12-13 09:32:44 +00:00
Evgeny Poberezkin	fb113ff008	agent: include queries longer than 5ms into slow queries (was 50ms)	2023-12-12 15:34:49 +00:00
Evgeny Poberezkin	f576260594	client: increase default network timeouts (#918 )	2023-12-12 12:01:38 +00:00
Evgeny Poberezkin	560dc55312	agent: notify about polled message processing (for iOS notifications) (#908 ) * agent: notify about polled message processing (for iOS notifications) * optionally keep key and support re-opening database * exports * test that cannot reopen when created with keepKey: false * set max number of messages to receive for a notification to 3	2023-12-11 13:03:53 +00:00
Evgeny Poberezkin	a860936072	agent: do not account for delivery of stored messages for agent suspension (#916 )	2023-12-05 23:14:33 +00:00
sh	e7b6b5facd	docker: add missing dependency (#915 )	2023-12-05 11:03:03 +00:00
Evgeny Poberezkin	eaf5317834	compatibility with GHC 8.10.7, narrow dependency ranges (#914 ) * Revert "raise mtl version to 2.3.1 (#912)" This reverts commit `117168ccce`. * Revert "expand dependency ranges (#911)" This reverts commit `90a8fc91d3`. * fix test * remove unnecessary forks * make text version dependent on GHC version * text * remove stack.yaml * bytestring * bytestring * hpack 0.35 * mtl	2023-12-04 00:00:50 +00:00
Alexander Bondarenko	117168ccce	raise mtl version to 2.3.1 (#912 ) * raise mtl version to 2.3.1 * fix test on 8.10	2023-12-02 11:43:36 +00:00
Evgeny Poberezkin	76af9ed242	remove ghc 9.6.3 from cabal.project	2023-12-01 17:51:33 +00:00
Alexander Bondarenko	90a8fc91d3	expand dependency ranges (#911 )	2023-12-01 13:08:26 +00:00
Alexander BondarenkoandEvgeny Poberezkin	6bffcc8503	compatibility with GHC 8.10.7 (#906 ) * build with ghc-8.10 * add 8.10 to matrix * cleanup * stats * remove getField * agent * server * remote * space --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>	2023-11-29 12:53:06 +00:00