Merge branch 'master' into master-ghc8107

.github/workflows/build.yml

@@ -28,10 +28,10 @@ jobs:
             ghc: "9.6.3"
     steps:
       - name: Clone project
-        uses: actions/checkout@v3
+        uses: actions/checkout@v2
 
       - name: Setup Haskell
-        uses: haskell-actions/setup@v2
+        uses: haskell/actions/setup@v1
         with:
           ghc-version: ${{ matrix.ghc }}
           cabal-version: "3.10.1.0"

Dockerfile

@@ -8,8 +8,8 @@ FROM ubuntu:${TAG} AS build
 RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev
 
 # Specify bootstrap Haskell versions
-ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
+ENV BOOTSTRAP_HASKELL_GHC_VERSION=8.10.7
-ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0
+ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.6.2.0
 
 # Install ghcup
 RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
@@ -19,7 +19,7 @@ ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
 
 # Set both as default
 RUN ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" && \
-    ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
+    ghcup set cabal
 
 COPY . /project
 WORKDIR /project

cabal.project

@@ -4,7 +4,7 @@ packages: .
 -- packages: . ../http2
 -- packages: . ../network-transport
 
-with-compiler: ghc-9.6.3
+with-compiler: ghc-8.10.7
 
 source-repository-package
     type: git
@@ -24,14 +24,9 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/direct-sqlcipher.git
-    tag: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
+    tag: 34309410eb2069b029b8fc1872deb1e0db123294
 
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/sqlcipher-simple.git
-    tag: a46bd361a19376c5211f1058908fc0ae6bf42446
+    tag: 5e154a2aeccc33ead6c243ec07195ab673137221
-
-source-repository-package
-    type: git
-    location: https://github.com/simplex-chat/network-transport.git
-    tag: 0013798272a683e35ca38d2fdaf480942311fba8

package.yaml

@@ -32,12 +32,12 @@ dependencies:
   - attoparsec == 0.14.*
   - base >= 4.14 && < 5
   - base64-bytestring >= 1.0 && < 1.3
-  - bytestring == 0.11.*
+  - bytestring == 0.10.*
   - case-insensitive == 1.2.*
   - composition == 1.0.*
   - constraints >= 0.12 && < 0.14
   - containers == 0.6.*
-  - cryptonite == 0.30.*
+  - cryptonite >= 0.27 && < 0.30
   - cryptostore == 0.2.*
   - data-default == 0.7.*
   - direct-sqlcipher == 2.3.*
@@ -49,11 +49,11 @@ dependencies:
   - ini == 0.4.1
   - iproute == 1.7.*
   - iso8601-time == 0.1.*
-  - memory == 0.18.*
+  - memory == 0.15.*
-  - mtl == 2.3.*
+  - mtl == 2.2.*
   - network >= 3.1.2.7 && < 3.2
   - network-info >= 0.2 && < 0.3
-  - network-transport == 0.5.6
+  - network-transport == 0.5.4
   - network-udp >= 0.0 && < 0.1
   - optparse-applicative >= 0.15 && < 0.17
   - process == 1.6.*
@@ -64,12 +64,12 @@ dependencies:
   - stm == 2.5.*
   - template-haskell >= 2.16 && < 2.21
   - temporary == 1.3.*
-  - text == 2.0.*
+  - text == 1.2.*
   - time == 1.9.*
   - time-compat == 1.9.*
   - time-manager == 0.0.*
   - tls >= 1.6.0 && < 1.7
-  - transformers == 0.6.*
+  - transformers == 0.5.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
   - websockets == 0.12.*
@@ -105,7 +105,6 @@ executables:
       - simplexmq
     ghc-options:
       - -threaded
-      - -rtsopts
 
   ntf-server:
     source-dirs: apps/ntf-server
@@ -114,7 +113,6 @@ executables:
       - simplexmq
     ghc-options:
       - -threaded
-      - -rtsopts
 
   xftp-server:
     source-dirs: apps/xftp-server
@@ -123,7 +121,6 @@ executables:
       - simplexmq
     ghc-options:
       - -threaded
-      - -rtsopts
 
   smp-agent:
     source-dirs: apps/smp-agent
@@ -132,7 +129,6 @@ executables:
       - simplexmq
     ghc-options:
       - -threaded
-      - -rtsopts
 
   xftp:
     source-dirs: apps/xftp
@@ -141,7 +137,6 @@ executables:
       - simplexmq
     ghc-options:
       - -threaded
-      - -rtsopts
 
 tests:
   simplexmq-test:
@@ -150,9 +145,9 @@ tests:
     dependencies:
       - simplexmq
       - deepseq == 1.4.*
-      - generic-random == 1.5.*
+      - generic-random >= 1.3 && < 1.5
-      - hspec == 2.11.*
+      - hspec == 2.7.*
-      - hspec-core == 2.11.*
+      - hspec-core == 2.7.*
       - HUnit == 1.6.*
       - QuickCheck == 2.14.*
       - silently == 1.2.*

simplexmq.cabal

@@ -174,12 +174,12 @@ library
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
@@ -191,11 +191,11 @@ library
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -206,12 +206,12 @@ library
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -229,7 +229,7 @@ executable ntf-server
       Paths_simplexmq
   hs-source-dirs:
       apps/ntf-server
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded -rtsopts
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -239,12 +239,12 @@ executable ntf-server
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
@@ -256,11 +256,11 @@ executable ntf-server
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -272,12 +272,12 @@ executable ntf-server
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -295,7 +295,7 @@ executable smp-agent
       Paths_simplexmq
   hs-source-dirs:
       apps/smp-agent
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded -rtsopts
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -305,12 +305,12 @@ executable smp-agent
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
@@ -322,11 +322,11 @@ executable smp-agent
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -338,12 +338,12 @@ executable smp-agent
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -361,7 +361,7 @@ executable smp-server
       Paths_simplexmq
   hs-source-dirs:
       apps/smp-server
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded -rtsopts
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -371,12 +371,12 @@ executable smp-server
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
@@ -388,11 +388,11 @@ executable smp-server
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -404,12 +404,12 @@ executable smp-server
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -427,7 +427,7 @@ executable xftp
       Paths_simplexmq
   hs-source-dirs:
       apps/xftp
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded -rtsopts
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -437,12 +437,12 @@ executable xftp
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
@@ -454,11 +454,11 @@ executable xftp
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -470,12 +470,12 @@ executable xftp
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -493,7 +493,7 @@ executable xftp-server
       Paths_simplexmq
   hs-source-dirs:
       apps/xftp-server
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded -rtsopts
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -503,12 +503,12 @@ executable xftp-server
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlcipher ==2.3.*
@@ -520,11 +520,11 @@ executable xftp-server
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -536,12 +536,12 @@ executable xftp-server
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
@@ -600,33 +600,33 @@ test-suite simplexmq-test
     , attoparsec ==0.14.*
     , base >=4.14 && <5
     , base64-bytestring >=1.0 && <1.3
-    , bytestring ==0.11.*
+    , bytestring ==0.10.*
     , case-insensitive ==1.2.*
     , composition ==1.0.*
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
-    , cryptonite ==0.30.*
+    , cryptonite >=0.27 && <0.30
     , cryptostore ==0.2.*
     , data-default ==0.7.*
     , deepseq ==1.4.*
     , direct-sqlcipher ==2.3.*
     , directory ==1.3.*
     , filepath ==1.4.*
-    , generic-random ==1.5.*
+    , generic-random >=1.3 && <1.5
     , hourglass ==0.2.*
-    , hspec ==2.11.*
+    , hspec ==2.7.*
-    , hspec-core ==2.11.*
+    , hspec-core ==2.7.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
     , ini ==0.4.1
     , iproute ==1.7.*
     , iso8601-time ==0.1.*
     , main-tester ==0.2.*
-    , memory ==0.18.*
+    , memory ==0.15.*
-    , mtl ==2.3.*
+    , mtl ==2.2.*
     , network >=3.1.2.7 && <3.2
     , network-info ==0.2.*
-    , network-transport ==0.5.6
+    , network-transport ==0.5.4
     , network-udp ==0.0.*
     , optparse-applicative >=0.15 && <0.17
     , process ==1.6.*
@@ -639,13 +639,13 @@ test-suite simplexmq-test
     , stm ==2.5.*
     , template-haskell >=2.16 && <2.21
     , temporary ==1.3.*
-    , text ==2.0.*
+    , text ==1.2.*
     , time ==1.9.*
     , time-compat ==1.9.*
     , time-manager ==0.0.*
     , timeit ==2.0.*
     , tls >=1.6.0 && <1.7
-    , transformers ==0.6.*
+    , transformers ==0.5.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*

src/Simplex/FileTransfer/Agent.hs

@@ -9,7 +9,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.FileTransfer.Agent
   ( startXFTPWorkers,

src/Simplex/FileTransfer/Client.hs

@@ -9,7 +9,6 @@
 
 module Simplex.FileTransfer.Client where
 
-import Control.Monad
 import Control.Monad.Except
 import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder, byteString)

src/Simplex/FileTransfer/Client/Agent.hs

@@ -8,7 +8,6 @@
 module Simplex.FileTransfer.Client.Agent where
 
 import Control.Logger.Simple (logInfo)
-import Control.Monad
 import Control.Monad.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
@@ -22,7 +21,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (catchAll_)
+import Simplex.Messaging.Util (catchAll_, tryError)
 import UnliftIO
 
 type XFTPClientVar = TMVar (Either XFTPClientAgentError XFTPClient)

src/Simplex/FileTransfer/Client/Main.hs

@@ -8,7 +8,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.FileTransfer.Client.Main
   ( SendOptions (..),

src/Simplex/FileTransfer/Crypto.hs

@@ -6,7 +6,6 @@
 
 module Simplex.FileTransfer.Crypto where
 
-import Control.Monad
 import Control.Monad.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)

src/Simplex/FileTransfer/Description.hs

@@ -26,6 +26,7 @@ module Simplex.FileTransfer.Description
     YAMLServerReplicas (..), -- for tests
     validateFileDescription,
     groupReplicasByServer,
+    replicaServer,
     fdSeparator,
     kb,
     mb,
@@ -255,6 +256,9 @@ encodeFileReplicas defChunkSize =
           chunks = map (B.unpack . encodeServerReplica) $ L.toList fs
         }
 
+replicaServer :: FileServerReplica -> XFTPServer
+replicaServer = server
+
 encodeServerReplica :: FileServerReplica -> ByteString
 encodeServerReplica FileServerReplica {chunkNo, replicaId, replicaKey, digest, chunkSize} =
   bshow chunkNo

src/Simplex/FileTransfer/Server.hs

@@ -12,7 +12,6 @@
 module Simplex.FileTransfer.Server where
 
 import Control.Logger.Simple
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader

src/Simplex/FileTransfer/Transport.hs

@@ -15,7 +15,6 @@ module Simplex.FileTransfer.Transport
 where
 
 import qualified Control.Exception as E
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Data.Bifunctor (first)

src/Simplex/Messaging/Agent.hs

@@ -13,7 +13,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 -- |
 -- Module      : Simplex.Messaging.Agent
@@ -109,7 +108,6 @@ module Simplex.Messaging.Agent
 where
 
 import Control.Logger.Simple (logError, logInfo, showText)
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
@@ -778,7 +776,7 @@ subscribeConnections' c connIds = do
       ContactConnection _ rq -> Right [rq]
       NewConnection _ -> Left (Right ())
     sndSubResult :: SndQueue -> Either AgentErrorType ()
-    sndSubResult SndQueue {status} = case status of
+    sndSubResult sq = case status (sq :: SndQueue) of
       Confirmed -> Right ()
       Active -> Left $ CONN SIMPLEX
       _ -> Left $ INTERNAL "unexpected queue status"
@@ -2196,7 +2194,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 ((Just dbQueueId == ) . dbReplaceQId) sqs
+                    let (delSqs, keepSqs) = L.partition ((Just dbQueueId ==) . dbReplaceQId) sqs
                     case L.nonEmpty keepSqs of
                       Just sqs' -> do
                         -- move inside case?

src/Simplex/Messaging/Agent/Client.hs

@@ -113,7 +113,6 @@ import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Concurrent.STM (retry, throwSTM)
 import Control.Exception (AsyncException (..))
 import Control.Logger.Simple
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Agent.NtfSubSupervisor
   ( runNtfSupervisor,
@@ -51,13 +50,13 @@ runNtfSupervisor c = do
   ns <- asks ntfSupervisor
   forever $ do
     cmd@(connId, _) <- atomically . readTBQueue $ ntfSubQ ns
-    handleErr connId . agentOperationBracket c AONtfNetwork waitUntilActive $
+    handleError connId . agentOperationBracket c AONtfNetwork waitUntilActive $
       runExceptT (processNtfSub c cmd) >>= \case
         Left e -> notifyErr connId e
         Right _ -> return ()
   where
-    handleErr :: ConnId -> m () -> m ()
+    handleError :: ConnId -> m () -> m ()
-    handleErr connId = E.handle $ \(e :: E.SomeException) -> do
+    handleError connId = E.handle $ \(e :: E.SomeException) -> do
       logError $ "runNtfSupervisor error " <> tshow e
       notifyErr connId e
     notifyErr connId e = notifyInternalError c connId $ "runNtfSupervisor error " <> show e

src/Simplex/Messaging/Agent/Protocol.hs

@@ -80,8 +80,6 @@ module Simplex.Messaging.Agent.Protocol
     SMPServerWithAuth,
     SrvLoc (..),
     SMPQueue (..),
-    qAddress,
-    sameQueue,
     sameQAddress,
     noAuthSrv,
     SMPQueueUri (..),
@@ -1196,15 +1194,8 @@ updateSMPServerHosts srv@ProtocolServer {host} = case host of
 
 class SMPQueue q where
   qServer :: q -> SMPServer
-  queueId :: q -> SMP.QueueId
+  qAddress :: q -> (SMPServer, SMP.QueueId)
-
+  sameQueue :: (SMPServer, SMP.QueueId) -> q -> Bool
-qAddress :: SMPQueue q => q -> (SMPServer, SMP.QueueId)
-qAddress q = (qServer q, queueId q)
-{-# INLINE qAddress #-}
-
-sameQueue :: SMPQueue q => (SMPServer, SMP.QueueId) -> q -> Bool
-sameQueue addr q = sameQAddress addr (qAddress q)
-{-# INLINE sameQueue #-}
 
 data SMPQueueInfo = SMPQueueInfo {clientVersion :: Version, queueAddress :: SMPQueueAddress}
   deriving (Eq, Show)
@@ -1249,20 +1240,26 @@ data SMPQueueAddress = SMPQueueAddress
 instance SMPQueue SMPQueueUri where
   qServer SMPQueueUri {queueAddress} = qServer queueAddress
   {-# INLINE qServer #-}
-  queueId SMPQueueUri {queueAddress} = queueId queueAddress
+  qAddress SMPQueueUri {queueAddress} = qAddress queueAddress
-  {-# INLINE queueId #-}
+  {-# INLINE qAddress #-}
+  sameQueue addr q = sameQAddress addr (qAddress q)
+  {-# INLINE sameQueue #-}
 
 instance SMPQueue SMPQueueInfo where
   qServer SMPQueueInfo {queueAddress} = qServer queueAddress
   {-# INLINE qServer #-}
-  queueId SMPQueueInfo {queueAddress} = queueId queueAddress
+  qAddress SMPQueueInfo {queueAddress} = qAddress queueAddress
-  {-# INLINE queueId #-}
+  {-# INLINE qAddress #-}
+  sameQueue addr q = sameQAddress addr (qAddress q)
+  {-# INLINE sameQueue #-}
 
 instance SMPQueue SMPQueueAddress where
   qServer SMPQueueAddress {smpServer} = smpServer
   {-# INLINE qServer #-}
-  queueId SMPQueueAddress {senderId} = senderId
+  qAddress SMPQueueAddress {smpServer, senderId} = (smpServer, senderId)
-  {-# INLINE queueId #-}
+  {-# INLINE qAddress #-}
+  sameQueue addr q = sameQAddress addr (qAddress q)
+  {-# INLINE sameQueue #-}
 
 sameQAddress :: (SMPServer, SMP.QueueId) -> (SMPServer, SMP.QueueId) -> Bool
 sameQAddress (srv, qId) (srv', qId') = sameSrvAddr srv srv' && qId == qId'

src/Simplex/Messaging/Agent/Server.hs

@@ -11,7 +11,7 @@ module Simplex.Messaging.Agent.Server
 where
 
 import Control.Logger.Simple (logInfo)
-import Control.Monad
+import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader
 import Crypto.Random (MonadRandom)

src/Simplex/Messaging/Agent/Store.hs

@@ -1,8 +1,6 @@
-{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
@@ -38,6 +36,7 @@ import Simplex.Messaging.Protocol
     NotifierId,
     NtfPrivateSignKey,
     NtfPublicVerifyKey,
+    QueueId,
     RcvDhSecret,
     RcvNtfDhSecret,
     RcvPrivateSignKey,
@@ -145,14 +144,18 @@ sndQueueInfo SndQueue {server, sndSwchStatus} =
 instance SMPQueue RcvQueue where
   qServer RcvQueue {server} = server
   {-# INLINE qServer #-}
-  queueId RcvQueue {rcvId} = rcvId
+  qAddress RcvQueue {server, rcvId} = (server, rcvId)
-  {-# INLINE queueId #-}
+  {-# INLINE qAddress #-}
+  sameQueue addr q = sameQAddress addr (qAddress q)
+  {-# INLINE sameQueue #-}
 
 instance SMPQueue SndQueue where
   qServer SndQueue {server} = server
   {-# INLINE qServer #-}
-  queueId SndQueue {sndId} = sndId
+  qAddress SndQueue {server, sndId} = (server, sndId)
-  {-# INLINE queueId #-}
+  {-# INLINE qAddress #-}
+  sameQueue addr q = sameQAddress addr (qAddress q)
+  {-# INLINE sameQueue #-}
 
 findQ :: SMPQueue q => (SMPServer, SMP.QueueId) -> NonEmpty q -> Maybe q
 findQ = find . sameQueue

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

@@ -19,7 +19,6 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Agent.Store.SQLite
@@ -214,9 +213,7 @@ module Simplex.Messaging.Agent.Store.SQLite
   )
 where
 
-import Control.Monad
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A

src/Simplex/Messaging/Client/Agent.hs

@@ -14,7 +14,6 @@ module Simplex.Messaging.Client.Agent where
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Async (Async, uninterruptibleCancel)
 import Control.Logger.Simple
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except
@@ -40,7 +39,7 @@ import Simplex.Messaging.Protocol (BrokerMsg, NotifierId, NtfPrivateSignKey, Pro
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, toChunks, ($>>=))
+import Simplex.Messaging.Util (catchAll_, toChunks, tryE, ($>>=))
 import System.Timeout (timeout)
 import UnliftIO (async)
 import UnliftIO.Exception (Exception)
@@ -273,13 +272,13 @@ withSMP ca srv action = (getSMPServerClient' ca srv >>= action) `catchE` logSMPE
 subscribeQueue :: SMPClientAgent -> SMPServer -> (SMPSub, C.APrivateSignKey) -> ExceptT SMPClientError IO ()
 subscribeQueue ca srv sub = do
   atomically $ addPendingSubscription ca srv sub
-  withSMP ca srv $ \smp -> subscribe_ smp `catchE` handleErr
+  withSMP ca srv $ \smp -> subscribe_ smp `catchE` handleError
   where
     subscribe_ smp = do
       smpSubscribe smp sub
       atomically $ addSubscription ca srv sub
 
-    handleErr e = do
+    handleError e = do
       atomically . when (e /= PCENetworkError && e /= PCEResponseTimeout) $
         removePendingSubscription ca srv (fst sub)
       throwE e

src/Simplex/Messaging/Crypto.hs

@@ -167,7 +167,6 @@ where
 
 import Control.Concurrent.STM
 import Control.Exception (Exception)
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)

src/Simplex/Messaging/Crypto/File.hs

@@ -21,7 +21,6 @@ module Simplex.Messaging.Crypto.File
 where
 
 import Control.Exception
-import Control.Monad
 import Control.Monad.Except
 import qualified Data.Aeson.TH as J
 import qualified Data.ByteArray as BA
@@ -37,7 +36,7 @@ import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.Util (liftEitherWith)
 import System.Directory (getFileSize)
-import UnliftIO (Handle, IOMode (..), liftIO)
+import UnliftIO (Handle, IOMode (..))
 import qualified UnliftIO as IO
 import UnliftIO.STM
 

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -15,7 +15,6 @@
 module Simplex.Messaging.Crypto.Ratchet where
 
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import Crypto.Hash (SHA512)
@@ -39,6 +38,7 @@ import Simplex.Messaging.Crypto
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE')
+import Simplex.Messaging.Util (tryE)
 import Simplex.Messaging.Version
 
 currentE2EEncryptVersion :: Version

src/Simplex/Messaging/Notifications/Server.hs

@@ -12,8 +12,8 @@
 
 module Simplex.Messaging.Notifications.Server where
 
+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 import Data.ByteString.Char8 (ByteString)

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

@@ -12,9 +12,7 @@ module Simplex.Messaging.Notifications.Server.Push.APNS where
 
 import Control.Exception (Exception)
 import Control.Logger.Simple
-import Control.Monad
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import Crypto.Hash.Algorithms (SHA256 (..))
 import qualified Crypto.PubKey.ECC.ECDSA as EC
 import qualified Crypto.PubKey.ECC.Types as ECT

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

@@ -5,7 +5,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Notifications.Server.StoreLog
   ( StoreLog,

src/Simplex/Messaging/Server.hs

@@ -73,7 +73,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore
-import Simplex.Messaging.Server.QueueStore.STM as QS
+import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.TMap (TMap)
@@ -120,8 +120,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
   restoreServerMessages
   restoreServerStats
   raceAny_
-    ( serverThread s "server subscribedQ" subscribedQ subscribers subscriptions cancelSub
+    ( serverThread s subscribedQ subscribers subscriptions cancelSub
-        : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers ntfSubscriptions (\_ -> pure ())
+        : serverThread s ntfSubscribedQ Env.notifiers ntfSubscriptions (\_ -> pure ())
         : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
     )
     `finally` withLock (savingLock s) "final" (saveServer False)
@@ -137,14 +137,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
     serverThread ::
       forall s.
       Server ->
-      String ->
       (Server -> TQueue (QueueId, Client)) ->
       (Server -> TMap QueueId Client) ->
       (Client -> TMap QueueId s) ->
       (s -> IO ()) ->
       M ()
-    serverThread s label subQ subs clientSubs unsub = forever $ do
+    serverThread s subQ subs clientSubs unsub = forever $ do
-      labelMyThread label
       atomically updateSubscribers
         $>>= endPreviousSubscriptions
         >>= liftIO . mapM_ unsub
@@ -161,7 +159,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           TM.lookupInsert qId clnt (subs s) $>>= clientToBeNotified
         endPreviousSubscriptions :: (QueueId, Client) -> M (Maybe s)
         endPreviousSubscriptions (qId, c) = do
-          labelMyThread $ label <> ".endPreviousSubscriptions"
           void . forkIO . atomically $
             writeTBQueue (sndQ c) [(CorrId "", qId, END)]
           atomically $ TM.lookupDelete qId (clientSubs c)
@@ -175,7 +172,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       ms <- asks msgStore
       quota <- asks $ msgQueueQuota . config
       let interval = checkInterval expCfg * 1000000
-      labelMyThread "expireMessages"
       forever $ do
         liftIO $ threadDelay' interval
         old <- liftIO $ expireBeforeEpoch expCfg
@@ -191,7 +187,6 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
 
     logServerStats :: Int64 -> Int64 -> FilePath -> M ()
     logServerStats startAt logInterval statsFilePath = do
-      labelMyThread "logServerStats"
       initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
       liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
       liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
@@ -236,10 +231,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
           threadDelay' interval
 
     runClient :: Transport c => TProxy c -> c -> M ()
-    runClient tp h = do
+    runClient _ h = do
       kh <- asks serverIdentity
       smpVRange <- asks $ smpServerVRange . config
-      labelMyThread $ "smp handshake for " <> transportName tp
       liftIO (runExceptT $ smpServerHandshake h kh smpVRange) >>= \case
         Right th -> runClientTransport th
         Left _ -> pure ()
@@ -253,13 +247,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
       srv <- asks server
       cpStarted <- newEmptyTMVarIO
       u <- askUnliftIO
-      liftIO $ do
+      liftIO $ runTCPServer cpStarted port $ runCPClient u srv
-        labelMyThread "control port server"
-        runTCPServer cpStarted port $ runCPClient u srv
       where
         runCPClient :: UnliftIO (ReaderT Env IO) -> Server -> Socket -> IO ()
         runCPClient u srv sock = do
-          labelMyThread "control port client"
           h <- socketToHandle sock ReadWriteMode
           hSetBuffering h LineBuffering
           hSetNewlineMode h universalNewlineMode
@@ -315,9 +306,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
                 hPutStrLn h "saving server state..."
                 unliftIO u $ saveServer True
                 hPutStrLn h "server state saved!"
-              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, threads, save, help, quit"
+              CPHelp -> hPutStrLn h "commands: stats, save, help, quit"
               CPQuit -> pure ()
-              CPSkip -> pure ()
 
 runClientTransport :: Transport c => THandle c -> M ()
 runClientTransport th@THandle {thVersion, sessionId} = do
@@ -357,14 +347,12 @@ cancelSub sub =
     _ -> return ()
 
 receive :: Transport c => THandle c -> Client -> M ()
-receive th Client {rcvQ, sndQ, activeAt, sessionId} = do
+receive th Client {rcvQ, sndQ, activeAt} = forever $ do
-  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
+  ts <- L.toList <$> liftIO (tGet th)
-  forever $ do
+  atomically . writeTVar activeAt =<< liftIO getSystemTime
-    ts <- L.toList <$> liftIO (tGet th)
+  as <- partitionEithers <$> mapM cmdAction ts
-    atomically . writeTVar activeAt =<< liftIO getSystemTime
+  write sndQ $ fst as
-    as <- partitionEithers <$> mapM cmdAction ts
+  write rcvQ $ snd as
-    write sndQ $ fst as
-    write rcvQ $ snd as
   where
     cmdAction :: SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
     cmdAction (sig, signed, (corrId, queueId, cmdOrError)) =
@@ -378,12 +366,10 @@ receive th Client {rcvQ, sndQ, activeAt, sessionId} = do
     write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
 
 send :: Transport c => THandle c -> Client -> IO ()
-send h@THandle {thVersion = v} Client {sndQ, sessionId, activeAt} = do
+send h@THandle {thVersion = v} Client {sndQ, sessionId, activeAt} = forever $ do
-  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
+  ts <- atomically $ L.sortWith tOrder <$> readTBQueue sndQ
-  forever $ do
+  void . liftIO . tPut h Nothing $ L.map ((Nothing,) . encodeTransmission v sessionId) ts
-    ts <- atomically $ L.sortWith tOrder <$> readTBQueue sndQ
+  atomically . writeTVar activeAt =<< liftIO getSystemTime
-    void . liftIO . tPut h Nothing $ L.map ((Nothing,) . encodeTransmission v sessionId) ts
-    atomically . writeTVar activeAt =<< liftIO getSystemTime
   where
     tOrder :: Transmission BrokerMsg -> Int
     tOrder (_, _, cmd) = case cmd of
@@ -392,8 +378,7 @@ send h@THandle {thVersion = v} Client {sndQ, sessionId, activeAt} = do
       _ -> 1
 
 disconnectTransport :: Transport c => THandle c -> client -> (client -> TVar SystemTime) -> ExpirationConfig -> IO ()
-disconnectTransport THandle {connection, sessionId} c activeAt expCfg = do
+disconnectTransport THandle {connection} c activeAt expCfg = do
-  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disconnectTransport"
   let interval = checkInterval expCfg * 1000000
   forever . liftIO $ do
     threadDelay' interval

src/Simplex/Messaging/Server/Control.hs

@@ -11,12 +11,9 @@ data ControlProtocol
   | CPResume
   | CPClients
   | CPStats
-  | CPStatsRTS
-  | CPThreads
   | CPSave
   | CPHelp
   | CPQuit
-  | CPSkip
 
 instance StrEncoding ControlProtocol where
   strEncode = \case
@@ -24,22 +21,16 @@ instance StrEncoding ControlProtocol where
     CPResume -> "resume"
     CPClients -> "clients"
     CPStats -> "stats"
-    CPStatsRTS -> "stats-rts"
-    CPThreads -> "threads"
     CPSave -> "save"
     CPHelp -> "help"
     CPQuit -> "quit"
-    CPSkip -> ""
   strP =
     A.takeTill (== ' ') >>= \case
       "suspend" -> pure CPSuspend
       "resume" -> pure CPResume
       "clients" -> pure CPClients
       "stats" -> pure CPStats
-      "stats-rts" -> pure CPStatsRTS
-      "threads" -> pure CPThreads
       "save" -> pure CPSave
       "help" -> pure CPHelp
       "quit" -> pure CPQuit
-      "" -> pure CPSkip
       _ -> fail "bad ControlProtocol command"

src/Simplex/Messaging/Transport/Client.hs

@@ -21,6 +21,7 @@ module Simplex.Messaging.Transport.Client
 where
 
 import Control.Applicative (optional)
+import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A

src/Simplex/Messaging/Transport/HTTP2/Client.hs

@@ -10,7 +10,7 @@ module Simplex.Messaging.Transport.HTTP2.Client where
 import Control.Concurrent.Async
 import Control.Exception (IOException, try)
 import qualified Control.Exception as E
-import Control.Monad
+import Control.Monad.Except
 import Data.ByteString.Char8 (ByteString)
 import Data.Functor (($>))
 import Data.Time (UTCTime, getCurrentTime)

src/Simplex/Messaging/Transport/Server.hs

@@ -20,8 +20,9 @@ module Simplex.Messaging.Transport.Server
 where
 
 import Control.Applicative ((<|>))
+import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
-import Control.Monad
+import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import qualified Crypto.Store.X509 as SX
 import Data.Default (def)
@@ -35,7 +36,7 @@ import qualified Network.TLS as T
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (catchAll_, labelMyThread, tshow)
+import Simplex.Messaging.Util (catchAll_, tshow)
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak, deRefWeak)
 import UnliftIO.Concurrent
@@ -71,7 +72,6 @@ runTransportServerSocket :: (MonadUnliftIO m, T.TLSParams p, Transport a) => TMV
 runTransportServerSocket started getSocket threadLabel serverParams cfg server = do
   u <- askUnliftIO
   let tCfg = serverTransportConfig cfg
-  labelMyThread $ "transport server for " <> threadLabel
   liftIO . runTCPServerSocket started getSocket $ \conn ->
     E.bracket
       (connectTLS Nothing tCfg serverParams conn >>= getServerConnection tCfg)

src/Simplex/Messaging/Util.hs

@@ -3,10 +3,11 @@
 
 module Simplex.Messaging.Util where
 
+import Control.Concurrent (threadDelay)
 import qualified Control.Exception as E
-import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
+import Control.Monad.Trans.Except
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -18,7 +19,6 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Time (NominalDiffTime)
-import GHC.Conc (labelThread, myThreadId, threadDelay)
 import UnliftIO
 import qualified UnliftIO.Exception as UE
 
@@ -66,6 +66,14 @@ liftEitherWith :: MonadError e' m => (e -> e') -> Either e a -> m a
 liftEitherWith f = liftEither . first f
 {-# INLINE liftEitherWith #-}
 
+tryError :: MonadError e m => m a -> m (Either e a)
+tryError action = (Right <$> action) `catchError` (pure . Left)
+{-# INLINE tryError #-}
+
+tryE :: Monad m => ExceptT e m a -> ExceptT e m (Either e a)
+tryE m = (Right <$> m) `catchE` (pure . Left)
+{-# INLINE tryE #-}
+
 liftE :: (e -> e') -> ExceptT e IO a -> ExceptT e' IO a
 liftE f a = ExceptT $ first f <$> runExceptT a
 {-# INLINE liftE #-}
@@ -152,6 +160,3 @@ diffToMicroseconds diff = fromIntegral ((truncate $ diff * 1000000) :: Integer)
 
 diffToMilliseconds :: NominalDiffTime -> Int64
 diffToMilliseconds diff = fromIntegral ((truncate $ diff * 1000) :: Integer)
-
-labelMyThread :: MonadIO m => String -> m ()
-labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: nightly-2023-08-22
+resolver: lts-18.28
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -52,12 +52,10 @@ extra-deps:
     commit: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
   # - ../direct-sqlcipher
   - github: simplex-chat/direct-sqlcipher
-    commit: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
+    commit: 34309410eb2069b029b8fc1872deb1e0db123294
   # - ../sqlcipher-simple
   - github: simplex-chat/sqlcipher-simple
-    commit: a46bd361a19376c5211f1058908fc0ae6bf42446
+    commit: 5e154a2aeccc33ead6c243ec07195ab673137221
-  - github: simplex-chat/network-transport
-    commit: 0013798272a683e35ca38d2fdaf480942311fba8
   # - ../hs-tls/core
   # - github: simplex-chat/hs-tls
   #   commit: f6cc753611f80af300401cfae63846e9d7c40d9e

tests/AgentTests/ConnectionRequestTests.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module AgentTests.ConnectionRequestTests where
 

tests/AgentTests/FunctionalAPITests.hs

@@ -61,6 +61,7 @@ import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Transport (ATransport (..))
+import Simplex.Messaging.Util (tryError)
 import Simplex.Messaging.Version
 import System.Directory (copyFile, renameFile)
 import Test.Hspec

tests/AgentTests/NotificationTests.hs

@@ -11,9 +11,7 @@ module AgentTests.NotificationTests where
 -- import Control.Logger.Simple (LogConfig (..), LogLevel (..), setLogLevel, withGlobalLogging)
 import AgentTests.FunctionalAPITests (exchangeGreetingsMsgId, get, getSMPAgentClient', makeConnection, nGet, runRight, runRight_, switchComplete, testServerMatrix2, (##>), (=##>), pattern Msg)
 import Control.Concurrent (killThread, threadDelay)
-import Control.Monad
 import Control.Monad.Except
-import Control.Monad.Trans.Except
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Types as JT
 import Data.Bifunctor (bimap, first)
@@ -35,6 +33,7 @@ import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), SMPMsg
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.Transport (ATransport)
+import Simplex.Messaging.Util (tryE)
 import System.Directory (doesFileExist, removeFile)
 import Test.Hspec
 import UnliftIO

tests/AgentTests/SQLiteTests.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module AgentTests.SQLiteTests (storeTests) where
 

tests/CoreTests/BatchingTests.hs

@@ -3,7 +3,7 @@
 module CoreTests.BatchingTests (batchingTests) where
 
 import Control.Concurrent.STM
-import Control.Monad
+import Control.Monad.Except
 import Crypto.Random (MonadRandom (..))
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B

tests/CoreTests/CryptoFileTests.hs

@@ -4,7 +4,6 @@ module CoreTests.CryptoFileTests (cryptoFileTests) where
 
 import AgentTests.FunctionalAPITests (runRight_)
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import Crypto.Random (getRandomBytes)
 import qualified Data.ByteString.Lazy as LB
 import GHC.IO.IOMode (IOMode (..))

tests/CoreTests/UtilTests.hs

@@ -4,7 +4,6 @@ module CoreTests.UtilTests where
 
 import Control.Exception (Exception, SomeException, throwIO)
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import Data.IORef
 import Simplex.Messaging.Client.Agent ()
 import Simplex.Messaging.Util

tests/NtfClient.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}

tests/ServerTests.hs

@@ -15,7 +15,7 @@ import AgentTests.NotificationTests (removeFileIfExists)
 import Control.Concurrent (ThreadId, killThread, threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
-import Control.Monad
+import Control.Monad.Except (forM, forM_)
 import Control.Monad.IO.Class
 import Data.Bifunctor (first)
 import Data.ByteString.Base64

tests/XFTPAgent.hs

@@ -9,9 +9,7 @@ module XFTPAgent where
 import AgentTests.FunctionalAPITests (get, getSMPAgentClient', rfGet, runRight, runRight_, sfGet)
 import Control.Concurrent (threadDelay)
 import Control.Logger.Simple
-import Control.Monad
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.Int (Int64)

tests/XFTPServerTests.hs

@@ -10,9 +10,7 @@ import AgentTests.FunctionalAPITests (runRight_)
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (SomeException)
-import Control.Monad
 import Control.Monad.Except
-import Control.Monad.IO.Unlift
 import Crypto.Random (getRandomBytes)
 import qualified Data.ByteString.Base64.URL as B64
 import Data.ByteString.Char8 (ByteString)