diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 1ac690d220..06afe89413 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -78,10 +78,10 @@ jobs: uses: actions/checkout@v3 - name: Setup Haskell - uses: haskell/actions/setup@v2 + uses: haskell-actions/setup@v2 with: - ghc-version: "8.10.7" - cabal-version: "latest" + ghc-version: "9.6.2" + cabal-version: "3.10.1.0" - name: Cache dependencies uses: actions/cache@v3 diff --git a/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt b/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt index 849a6c98a7..cfbc1ed320 100644 --- a/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt +++ b/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt @@ -67,7 +67,7 @@ if(NOT APPLE) else() # Without direct linking it can't find hs_init in linking step add_library( rts SHARED IMPORTED ) - FILE(GLOB RTSLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/deps/libHSrts_thr-*.${OS_LIB_EXT}) + FILE(GLOB RTSLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/deps/libHSrts*_thr-*.${OS_LIB_EXT}) set_target_properties( rts PROPERTIES IMPORTED_LOCATION ${RTSLIB}) target_link_libraries(app-lib rts simplex) diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index f30438c384..04d8e4ffa1 100644 --- a/apps/simplex-bot-advanced/Main.hs +++ b/apps/simplex-bot-advanced/Main.hs @@ -8,7 +8,7 @@ module Main where import Control.Concurrent.Async import Control.Concurrent.STM -import Control.Monad.Reader +import Control.Monad import qualified Data.Text as T import Simplex.Chat.Bot import Simplex.Chat.Controller diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs index 3a1be2ae08..04b6627f38 100644 --- a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs +++ b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs @@ -9,7 +9,7 @@ module Broadcast.Bot where import Control.Concurrent (forkIO) import Control.Concurrent.Async import Control.Concurrent.STM -import Control.Monad.Reader +import Control.Monad import qualified Data.Text as T import Broadcast.Options import Simplex.Chat.Bot diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs index d59adc04e7..6f198340f8 100644 --- a/apps/simplex-chat/Server.hs +++ b/apps/simplex-chat/Server.hs @@ -8,6 +8,7 @@ module Server where +import Control.Monad import Control.Monad.Except import Control.Monad.Reader import Data.Aeson (FromJSON, ToJSON) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 09ab424cf0..46abc4652d 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -15,7 +15,7 @@ where import Control.Concurrent (forkIO) import Control.Concurrent.Async import Control.Concurrent.STM -import Control.Monad.Reader +import Control.Monad import qualified Data.ByteString.Char8 as B import Data.List (sortOn) import Data.Maybe (fromMaybe, maybeToList) diff --git a/cabal.project b/cabal.project index 519633e1c2..7e216822c1 100644 --- a/cabal.project +++ b/cabal.project @@ -2,14 +2,14 @@ packages: . -- packages: . ../simplexmq -- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple -with-compiler: ghc-8.10.7 +with-compiler: ghc-9.6.2 constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 44abb90c63dba63ab5f6d379131e5a7e0f625e98 + tag: 002f36dde042b8957507ec2ca348a0f4494a4cd6 source-repository-package type: git @@ -24,17 +24,17 @@ source-repository-package source-repository-package type: git location: https://github.com/simplex-chat/direct-sqlcipher.git - tag: 34309410eb2069b029b8fc1872deb1e0db123294 + tag: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9 source-repository-package type: git location: https://github.com/simplex-chat/sqlcipher-simple.git - tag: 5e154a2aeccc33ead6c243ec07195ab673137221 + tag: a46bd361a19376c5211f1058908fc0ae6bf42446 source-repository-package type: git location: https://github.com/simplex-chat/aeson.git - tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7 + tag: 68330dce8208173c6acf5f62b23acb500ab5d873 source-repository-package type: git @@ -43,5 +43,10 @@ source-repository-package source-repository-package type: git - location: https://github.com/zw3rk/android-support.git - tag: 3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb + location: https://github.com/simplex-chat/android-support.git + tag: 9aa09f148089d6752ce563b14c2df1895718d806 + +source-repository-package + type: git + location: https://github.com/simplex-chat/network-transport.git + tag: 0013798272a683e35ca38d2fdaf480942311fba8 diff --git a/package.yaml b/package.yaml index 6d3975aa4c..cd74b83cf8 100644 --- a/package.yaml +++ b/package.yaml @@ -13,25 +13,25 @@ extra-source-files: - cabal.project dependencies: - - aeson == 2.0.* + - aeson == 2.2.* - ansi-terminal >= 0.10 && < 0.12 - async == 2.2.* - attoparsec == 0.14.* - base >= 4.7 && < 5 - base64-bytestring >= 1.0 && < 1.3 - - bytestring == 0.10.* + - bytestring == 0.11.* - composition == 1.0.* - constraints >= 0.12 && < 0.14 - containers == 0.6.* - - cryptonite >= 0.27 && < 0.30 + - cryptonite == 0.30.* - directory == 1.3.* - direct-sqlcipher == 2.3.* - email-validate == 2.3.* - exceptions == 0.10.* - filepath == 1.4.* - http-types == 0.12.* - - memory == 0.15.* - - mtl == 2.2.* + - memory == 0.18.* + - mtl == 2.3.* - network >= 3.1.2.7 && < 3.2 - optparse-applicative >= 0.15 && < 0.17 - process == 1.6.* @@ -42,13 +42,13 @@ dependencies: - socks == 0.6.* - sqlcipher-simple == 0.4.* - stm == 2.5.* - - template-haskell == 2.16.* + - template-haskell == 2.20.* - terminal == 0.2.* - - text == 1.2.* + - text == 2.0.* - time == 1.9.* - unliftio == 0.2.* - unliftio-core == 0.2.* - - zip == 1.7.* + - zip == 2.0.* flags: swift: @@ -118,7 +118,7 @@ tests: - simplex-chat - async == 2.2.* - deepseq == 1.4.* - - hspec == 2.7.* + - hspec == 2.11.* - network == 3.1.* - silently == 1.2.* - stm == 2.5.* diff --git a/scripts/desktop/build-lib-linux.sh b/scripts/desktop/build-lib-linux.sh index 41ca8a64f7..ab2664792f 100755 --- a/scripts/desktop/build-lib-linux.sh +++ b/scripts/desktop/build-lib-linux.sh @@ -2,12 +2,12 @@ OS=linux ARCH=${1:-`uname -a | rev | cut -d' ' -f2 | rev`} -GHC_VERSION=8.10.7 +GHC_VERSION=9.6.2 BUILD_DIR=dist-newstyle/build/$ARCH-$OS/ghc-${GHC_VERSION}/simplex-chat-* rm -rf $BUILD_DIR -cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN' --ghc-options="-optl-L$(ghc --print-libdir)/rts -optl-Wl,--as-needed,-lHSrts_thr-ghc$GHC_VERSION" +cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN -flink-rts -threaded' cd $BUILD_DIR/build #patchelf --add-needed libHSrts_thr-ghc${GHC_VERSION}.so libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so #patchelf --add-rpath '$ORIGIN' libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so diff --git a/scripts/desktop/build-lib-mac.sh b/scripts/desktop/build-lib-mac.sh index 5a8ac3d3fb..58500e3c54 100755 --- a/scripts/desktop/build-lib-mac.sh +++ b/scripts/desktop/build-lib-mac.sh @@ -2,9 +2,12 @@ OS=mac ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}" +GHC_VERSION=9.6.2 + if [ "$ARCH" == "arm64" ]; then ARCH=aarch64 fi + LIB_EXT=dylib LIB=libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT GHC_LIBS_DIR=$(ghc --print-libdir) @@ -12,13 +15,26 @@ GHC_LIBS_DIR=$(ghc --print-libdir) BUILD_DIR=dist-newstyle/build/$ARCH-*/ghc-*/simplex-chat-* rm -rf $BUILD_DIR -cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/rts -optl-lHSrts_thr-ghc8.10.7 -optl-lffi" +cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" cd $BUILD_DIR/build mkdir deps 2> /dev/null # It's not included by default for some reason. Compiled lib tries to find system one but it's not always available -cp $GHC_LIBS_DIR/rts/libffi.dylib ./deps +#cp $GHC_LIBS_DIR/libffi.dylib ./deps +( + BUILD=$PWD + cp /tmp/libffi-3.4.4/*-apple-darwin*/.libs/libffi.dylib $BUILD/deps || \ + ( \ + cd /tmp && \ + curl "https://gitlab.haskell.org/ghc/libffi-tarballs/-/raw/libffi-3.4.4/libffi-3.4.4.tar.gz?inline=false" -o libffi.tar.gz && \ + tar -xzvf libffi.tar.gz && \ + cd "libffi-3.4.4" && \ + ./configure && \ + make && \ + cp *-apple-darwin*/.libs/libffi.dylib $BUILD/deps \ + ) +) DYLIBS=`otool -L $LIB | grep @rpath | tail -n +2 | cut -d' ' -f 1 | cut -d'/' -f2` RPATHS=`otool -l $LIB | grep "path "| cut -d' ' -f11` @@ -63,7 +79,7 @@ rm deps/`basename $LIB` if [ -e deps/libHSdrct-*.$LIB_EXT ]; then LIBCRYPTO_PATH=$(otool -l deps/libHSdrct-*.$LIB_EXT | grep libcrypto | cut -d' ' -f11) - install_name_tool -change $LIBCRYPTO_PATH @rpath/libcrypto.1.1.$LIB_EXT deps/libHSdrct*.$LIB_EXT + install_name_tool -change $LIBCRYPTO_PATH @rpath/libcrypto.1.1.$LIB_EXT deps/libHSdrct-*.$LIB_EXT cp $LIBCRYPTO_PATH deps/libcrypto.1.1.$LIB_EXT chmod 755 deps/libcrypto.1.1.$LIB_EXT fi diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index a2d7fe0e92..c39a77abe6 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,10 +1,11 @@ { - "https://github.com/simplex-chat/simplexmq.git"."44abb90c63dba63ab5f6d379131e5a7e0f625e98" = "16mi6lqgn6b57jv34kx72j5h5ga2x4avpv49dibk3xjqjb041q9a"; + "https://github.com/simplex-chat/simplexmq.git"."002f36dde042b8957507ec2ca348a0f4494a4cd6" = "1gp1z9i1glvkq8vgy1damy7g562a5cz47f8sichjmfg2ngly8zpl"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb"; - "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; - "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0"; - "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; + "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp"; + "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; + "https://github.com/simplex-chat/aeson.git"."68330dce8208173c6acf5f62b23acb500ab5d873" = "1l51p1v54c88c1jmxcvbz4gy0cns7l46ihzzfjwxxrvcrrrxgcjp"; "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj"; - "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97"; + "https://github.com/simplex-chat/android-support.git"."9aa09f148089d6752ce563b14c2df1895718d806" = "0pbf2pf13v2kjzi397nr13f1h3jv0imvsq8rpiyy2qyx5vd50pqn"; + "https://github.com/simplex-chat/network-transport.git"."0013798272a683e35ca38d2fdaf480942311fba8" = "0dnn62apgvc248df0m8ib7phrzn63wm0xs71xvlypv52j6cgwzkb"; } diff --git a/simplex-chat.cabal b/simplex-chat.cabal index e53f047a24..a970777d8d 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack @@ -10,7 +10,7 @@ category: Web, System, Services, Cryptography homepage: https://github.com/simplex-chat/simplex-chat#readme author: simplex.chat maintainer: chat@simplex.chat -copyright: 2020-23 simplex.chat +copyright: 2020-22 simplex.chat license: AGPL-3 license-file: LICENSE build-type: Simple @@ -138,25 +138,25 @@ library src ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -167,13 +167,13 @@ library , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -186,25 +186,25 @@ executable simplex-bot apps/simplex-bot ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -216,13 +216,13 @@ executable simplex-bot , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -235,25 +235,25 @@ executable simplex-bot-advanced apps/simplex-bot-advanced ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -265,13 +265,13 @@ executable simplex-bot-advanced , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -286,25 +286,25 @@ executable simplex-broadcast-bot apps/simplex-broadcast-bot/src ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -316,13 +316,13 @@ executable simplex-broadcast-bot , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -336,25 +336,25 @@ executable simplex-chat apps/simplex-chat ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network ==3.1.* , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -366,14 +366,14 @@ executable simplex-chat , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* , websockets ==0.12.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -390,25 +390,25 @@ executable simplex-directory-service apps/simplex-directory-service/src ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -420,13 +420,13 @@ executable simplex-directory-service , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -463,27 +463,27 @@ test-suite simplex-chat-test apps/simplex-directory-service/src ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded build-depends: - aeson ==2.0.* + aeson ==2.2.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.10.* + , bytestring ==0.11.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite >=0.27 && <0.30 + , cryptonite ==0.30.* , deepseq ==1.4.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* - , hspec ==2.7.* + , hspec ==2.11.* , http-types ==0.12.* - , memory ==0.15.* - , mtl ==2.2.* + , memory ==0.18.* + , mtl ==2.3.* , network ==3.1.* , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -496,13 +496,13 @@ test-suite simplex-chat-test , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.16.* + , template-haskell ==2.20.* , terminal ==0.2.* - , text ==1.2.* + , text ==2.0.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==1.7.* + , zip ==2.0.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f701d65031..c2c8dcaf31 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -12,13 +12,17 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedRecordDot #-} + +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat where import Control.Applicative (optional, (<|>)) -import Control.Concurrent.STM (retry, stateTVar) +import Control.Concurrent.STM (retry) import qualified Control.Exception as E import Control.Logger.Simple +import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift import Control.Monad.Reader @@ -208,8 +212,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen where configServers :: DefaultAgentServers configServers = - let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers) - xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers) + let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers) + xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers) in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig} agentServers :: ChatConfig -> IO InitialAgentServers agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do @@ -236,9 +240,9 @@ activeAgentServers ChatConfig {defaultServers} p = . filter (\ServerCfg {enabled} -> enabled) cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p)) -cfgServers = \case - SPSMP -> smp - SPXFTP -> xftp +cfgServers p s = case p of + SPSMP -> s.smp + SPXFTP -> s.xftp startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ()) startChatController subConns enableExpireCIs startXFTPWorkers = do @@ -685,7 +689,9 @@ processChatCommand = \case MCVoice {} -> False MCUnknown {} -> True qText = msgContentText qmc - qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_ + getFileName :: CIFile d -> String + getFileName CIFile{fileName} = fileName + qFileName = maybe qText (T.pack . getFileName) ciFile_ qTextOrFile = if T.null qText then qFileName else qText xftpSndFileTransfer :: User -> FilePath -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta) xftpSndFileTransfer user file fileSize n contactOrGroup = do @@ -896,7 +902,7 @@ processChatCommand = \case pure $ CRContactConnectionDeleted user conn CTGroup -> do Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user chatId - let isOwner = memberRole (membership :: GroupMember) == GROwner + let isOwner = membership.memberRole == GROwner canDelete = isOwner || not (memberCurrent membership) unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo @@ -1073,7 +1079,9 @@ processChatCommand = \case APIGetNtfMessage nonce encNtfInfo -> withUser $ \_ -> do (NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo let ntfMessages = map (\SMP.SMPMsgMeta {msgTs, msgFlags} -> NtfMsgInfo {msgTs = systemToUTCTime msgTs, msgFlags}) msgs - msgTs' = systemToUTCTime . (SMP.msgTs :: SMP.NMsgMeta -> SystemTime) <$> ntfMsgMeta + getMsgTs :: SMP.NMsgMeta -> SystemTime + getMsgTs SMP.NMsgMeta{msgTs} = msgTs + msgTs' = systemToUTCTime . getMsgTs <$> ntfMsgMeta agentConnId = AgentConnId ntfConnId user_ <- withStore' (`getUserByAConnId` agentConnId) connEntity <- @@ -1429,7 +1437,7 @@ processChatCommand = \case APIJoinGroup groupId -> withUser $ \user@User {userId} -> do ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} <- withStore $ \db -> getGroupInvitation db user groupId withChatLock "joinGroup" . procCmd $ do - agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest . directMessage $ XGrpAcpt (memberId (membership :: GroupMember)) + agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest . directMessage $ XGrpAcpt membership.memberId withStore' $ \db -> do createMemberConnection db userId fromMember agentConnId updateGroupMemberStatus db userId fromMember GSMemAccepted @@ -1893,7 +1901,7 @@ processChatCommand = \case pure $ CRGroupUpdated user g g' Nothing assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m () assertUserGroupRole g@GroupInfo {membership} requiredRole = do - when (memberRole (membership :: GroupMember) < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole + when (membership.memberRole < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved unless (memberActive membership) $ throwChatError CEGroupMemberNotActive @@ -1911,7 +1919,7 @@ processChatCommand = \case runUpdateGroupProfile user g $ update p isReady :: Contact -> Bool isReady ct = - let s = connStatus $ activeConn (ct :: Contact) + let s = connStatus $ ct.activeConn in s == ConnReady || s == ConnSndReady withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse withCurrentCall ctId action = do @@ -3033,7 +3041,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do | sameMemberId memId m -> do -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn confId $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) + allowAgentConnectionAsync user conn confId $ XGrpMemInfo (membership.memberId) (fromLocalProfile $ memberProfile membership) | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" _ -> messageError "CONF from member must have x.grp.mem.info" INFO connInfo -> do @@ -3071,7 +3079,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} whenGroupNtfs user gInfo $ do setActive $ ActiveG gName - showToast ("#" <> gName) $ "member " <> localDisplayName (m :: GroupMember) <> " is connected" + showToast ("#" <> gName) $ "member " <> m.localDisplayName <> " is connected" intros <- withStore' $ \db -> createIntroductions db members m void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m forM_ intros $ \intro -> @@ -3127,7 +3135,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do && currentMemCount <= smallGroupsRcptsMemLimit where canSend a - | memberRole (m :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages" + | m.memberRole <= GRObserver = messageError "member is not allowed to send messages" | otherwise = a RCVD msgMeta msgRcpt -> withAckMessage' agentConnId conn msgMeta $ @@ -4259,7 +4267,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do Just m' -> pure m' withStore' $ \db -> saveMemberInvitation db toMember introInv -- [incognito] send membership incognito profile, create direct connection as incognito - let msg = XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) + let msg = XGrpMemInfo membership.memberId (fromLocalProfile $ memberProfile membership) -- [async agent commands] no continuation needed, but commands should be asynchronous for stability groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq $ directMessage msg directConnIds <- joinAgentConnectionAsync user enableNtfs directConnReq $ directMessage msg @@ -4268,7 +4276,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> MsgMeta -> m () xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg msgMeta - | memberId (membership :: GroupMember) == memId = + | membership.memberId == memId = let gInfo' = gInfo {membership = membership {memberRole = memRole}} in changeMemberRole gInfo' membership $ RGEUserRole memRole | otherwise = do @@ -4292,7 +4300,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m () xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg msgMeta = do members <- withStore' $ \db -> getGroupMembers db user gInfo - if memberId (membership :: GroupMember) == memId + if membership.memberId == memId then checkRole membership $ do deleteGroupLinkIfExists user gInfo -- member records are not deleted to keep history @@ -4815,7 +4823,7 @@ createSndFeatureItems :: forall m. ChatMonad m => User -> Contact -> Contact -> createSndFeatureItems user ct ct' = createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref where - getPref = (preference :: ContactUserPref (FeaturePreference f) -> FeaturePreference f) . userPreference + getPref u = (userPreference u).preference type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d @@ -4900,7 +4908,7 @@ getCreateActiveUser st testView = do Right user -> pure user selectUser :: [User] -> IO User selectUser [user] = do - withTransaction st (`setActiveUser` userId (user :: User)) + withTransaction st (`setActiveUser` user.userId) pure user selectUser users = do putStrLn "Select user profile:" @@ -4915,7 +4923,7 @@ getCreateActiveUser st testView = do | n <= 0 || n > length users -> putStrLn "invalid user number" >> loop | otherwise -> do let user = users !! (n - 1) - withTransaction st (`setActiveUser` userId (user :: User)) + withTransaction st (`setActiveUser` user.userId) pure user userStr :: User -> String userStr User {localDisplayName, profile = LocalProfile {fullName}} = diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index 2444785501..f8fa0d152a 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -13,6 +13,7 @@ module Simplex.Chat.Archive where import qualified Codec.Archive.Zip as Z +import Control.Monad import Control.Monad.Except import Control.Monad.Reader import Data.Functor (($>)) diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs index 234963b44c..486792b4c9 100644 --- a/src/Simplex/Chat/Bot.hs +++ b/src/Simplex/Chat/Bot.hs @@ -8,7 +8,7 @@ module Simplex.Chat.Bot where import Control.Concurrent.Async import Control.Concurrent.STM -import Control.Monad.Reader +import Control.Monad import qualified Data.ByteString.Char8 as B import qualified Data.Text as T import Simplex.Chat.Controller diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 33b6041841..67154f50af 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -6,11 +6,14 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module Simplex.Chat.Messages where import Control.Applicative ((<|>)) @@ -371,7 +374,7 @@ contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessag | forUser enabled && forContact enabled = Just ttl | otherwise = Nothing where - TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference) + TimedMessagesPreference {ttl} = userPreference.preference groupTimedTTL :: GroupInfo -> Maybe (Maybe Int) groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}} diff --git a/src/Simplex/Chat/Mobile/WebRTC.hs b/src/Simplex/Chat/Mobile/WebRTC.hs index e05c9d609e..98b622b5dc 100644 --- a/src/Simplex/Chat/Mobile/WebRTC.hs +++ b/src/Simplex/Chat/Mobile/WebRTC.hs @@ -8,7 +8,9 @@ module Simplex.Chat.Mobile.WebRTC ( reservedSize, ) where +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import qualified Crypto.Cipher.Types as AES import Data.Bifunctor (bimap) import qualified Data.ByteArray as BA diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 31d1eb5738..3cb7e94f9a 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -13,6 +13,8 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module Simplex.Chat.Protocol where import Control.Applicative ((<|>)) diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index e31598812e..0e48efa019 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -4,6 +4,8 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module Simplex.Chat.Store.Connections ( getConnectionEntity, ) diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index de1c5014bf..34bb754090 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -7,6 +8,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module Simplex.Chat.Store.Direct ( updateContact_, updateContactProfile_, @@ -60,7 +63,9 @@ module Simplex.Chat.Store.Direct ) where +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import Data.Either (rights) import Data.Functor (($>)) import Data.Int (Int64) @@ -424,7 +429,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi ExceptT $ maybeM getContactRequestByXContactId xContactId_ >>= \case Nothing -> createContactRequest - Just cr -> updateContactRequest cr $> Right (contactRequestId (cr :: UserContactRequest)) + Just cr -> updateContactRequest cr $> Right cr.contactRequestId getContactRequest db user cReqId createContactRequest :: IO (Either StoreError Int64) createContactRequest = do diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 249dfedc37..e33268675a 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -74,7 +74,9 @@ module Simplex.Chat.Store.Files where import Control.Applicative ((<|>)) +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import Data.Either (rights) import Data.Int (Int64) import Data.Maybe (fromMaybe, isJust, listToMaybe) @@ -478,7 +480,9 @@ createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do currentTs <- liftIO getCurrentTime rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr - let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_ + let getFDId :: RcvFileDescr -> Int64 + getFDId RcvFileDescr{fileDescrId} = fileDescrId + let rfdId = getFDId <$> rfd_ xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP fileId <- liftIO $ do @@ -498,7 +502,9 @@ createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvi createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do currentTs <- liftIO getCurrentTime rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr - let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_ + let getFDId :: RcvFileDescr -> Int64 + getFDId RcvFileDescr{fileDescrId} = fileDescrId + let rfdId = getFDId <$> rfd_ xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP fileId <- liftIO $ do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 32a3b91102..d48074e374 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -8,6 +8,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedRecordDot #-} + +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat.Store.Groups ( -- * Util methods @@ -86,7 +89,9 @@ module Simplex.Chat.Store.Groups ) where +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG) import Data.Either (rights) import Data.Int (Int64) @@ -862,7 +867,7 @@ saveIntroInvitation db reMember toMember introInv = do WHERE group_member_intro_id = :intro_id |] [ ":intro_status" := GMIntroInvReceived, - ":group_queue_info" := groupConnReq (introInv :: IntroInvitation), + ":group_queue_info" := introInv.groupConnReq, ":direct_queue_info" := directConnReq introInv, ":updated_at" := currentTs, ":intro_id" := introId intro @@ -909,7 +914,9 @@ getIntroduction_ db reMember toMember = ExceptT $ do createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> (CommandId, ConnId) -> Maybe ProfileId -> ExceptT StoreError IO GroupMember createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) (groupCmdId, groupAgentConnId) (directCmdId, directAgentConnId) customUserProfileId = do - let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn + let cLevel = 1 + case activeConn of + Just (Connection{connLevel}) -> connLevel + _ -> 0 currentTs <- liftIO getCurrentTime Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId memberContactId Nothing customUserProfileId cLevel currentTs liftIO $ setCommandConnId db user directCmdId directConnId @@ -932,7 +939,9 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> (CommandId, ConnId) -> (CommandId, ConnId) -> Maybe ProfileId -> IO () createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} (groupCmdId, groupAgentConnId) (directCmdId, directAgentConnId) customUserProfileId = do - let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn + let cLevel = 1 + case activeConn of + Just (Connection{connLevel}) -> connLevel + _ -> 0 currentTs <- getCurrentTime Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId viaContactId cLevel currentTs setCommandConnId db user groupCmdId groupConnId diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 7bc2eaf4d4..2e48f02e8d 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -10,6 +10,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module Simplex.Chat.Store.Messages ( getContactConnIds_, getDirectChatReactions_, @@ -97,7 +99,9 @@ module Simplex.Chat.Store.Messages ) where +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG) import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 48f2dd144e..831b8d7cd2 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module Simplex.Chat.Store.Profiles ( AutoAccept (..), UserMsgReceiptSettings (..), @@ -54,7 +56,9 @@ module Simplex.Chat.Store.Profiles ) where +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import Data.Aeson (ToJSON) import qualified Data.Aeson as J import Data.Functor (($>)) @@ -290,7 +294,7 @@ getUserContactProfiles db User {userId} = |] (Only userId) where - toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> (Profile) + toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> Profile toContactProfile (displayName, fullName, image, contactLink, preferences) = Profile {displayName, fullName, image, contactLink, preferences} createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> ExceptT StoreError IO () diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index c4e6b8d909..27cda36cc0 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -10,10 +10,11 @@ module Simplex.Chat.Store.Shared where -import Control.Concurrent.STM (stateTVar) import Control.Exception (Exception) import qualified Control.Exception as E +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG, randomBytesGenerate) import Data.Aeson (ToJSON) import qualified Data.Aeson as J diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index 6a148e8778..0ef3d3bace 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -5,7 +5,7 @@ module Simplex.Chat.Terminal where import Control.Exception (handle, throwIO) -import Control.Monad.Except +import Control.Monad import qualified Data.List.NonEmpty as L import Database.SQLite.Simple (SQLError (..)) import qualified Database.SQLite.Simple as DB diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 36cec49d7c..8841f15ffd 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -12,6 +12,7 @@ module Simplex.Chat.Terminal.Input where import Control.Applicative (optional, (<|>)) import Control.Concurrent (forkFinally, forkIO, killThread, mkWeakThreadId, threadDelay) +import Control.Monad import Control.Monad.Except import Control.Monad.Reader import qualified Data.Attoparsec.ByteString.Char8 as A diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index ce68d715fe..db6f16f3ca 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -9,6 +9,7 @@ module Simplex.Chat.Terminal.Output where import Control.Concurrent (ThreadId) +import Control.Monad import Control.Monad.Catch (MonadMask) import Control.Monad.Except import Control.Monad.Reader diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index ac71ce6122..180356c3f6 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -16,6 +16,8 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverloadedRecordDot #-} + {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use newtype instead of data" #-} @@ -54,21 +56,21 @@ class IsContact a where preferences' :: a -> Maybe Preferences instance IsContact User where - contactId' = userContactId + contactId' u = u.userContactId {-# INLINE contactId' #-} - profile' = profile + profile' u = u.profile {-# INLINE profile' #-} - localDisplayName' = localDisplayName + localDisplayName' u = u.localDisplayName {-# INLINE localDisplayName' #-} preferences' User {profile = LocalProfile {preferences}} = preferences {-# INLINE preferences' #-} instance IsContact Contact where - contactId' = contactId + contactId' c = c.contactId {-# INLINE contactId' #-} - profile' = profile + profile' c = c.profile {-# INLINE profile' #-} - localDisplayName' = localDisplayName + localDisplayName' c = c.localDisplayName {-# INLINE localDisplayName' #-} preferences' Contact {profile = LocalProfile {preferences}} = preferences {-# INLINE preferences' #-} @@ -179,7 +181,7 @@ instance ToJSON Contact where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} contactConn :: Contact -> Connection -contactConn = activeConn +contactConn Contact{activeConn} = activeConn contactConnId :: Contact -> ConnId contactConnId = aConnId . contactConn @@ -447,7 +449,7 @@ instance ToJSON LocalProfile where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} localProfileId :: LocalProfile -> ProfileId -localProfileId = profileId +localProfileId LocalProfile{profileId} = profileId toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile toLocalProfile profileId Profile {displayName, fullName, image, contactLink, preferences} localAlias = @@ -596,7 +598,7 @@ groupMemberRef GroupMember {groupMemberId, memberProfile = p} = GroupMemberRef {groupMemberId, profile = fromLocalProfile p} memberConn :: GroupMember -> Maybe Connection -memberConn = activeConn +memberConn GroupMember{activeConn} = activeConn memberConnId :: GroupMember -> Maybe ConnId memberConnId GroupMember {activeConn} = aConnId <$> activeConn diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs index a89e383242..c53e4476f4 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -8,12 +8,15 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} + {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} {-# HLINT ignore "Use newtype instead of data" #-} @@ -85,12 +88,12 @@ allChatFeatures = ] chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f) -chatPrefSel = \case - SCFTimedMessages -> timedMessages - SCFFullDelete -> fullDelete - SCFReactions -> reactions - SCFVoice -> voice - SCFCalls -> calls +chatPrefSel f ps = case f of + SCFTimedMessages -> ps.timedMessages + SCFFullDelete -> ps.fullDelete + SCFReactions -> ps.reactions + SCFVoice -> ps.voice + SCFCalls -> ps.calls chatFeature :: SChatFeature f -> ChatFeature chatFeature = \case @@ -110,12 +113,12 @@ instance PreferenceI (Maybe Preferences) where getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs) instance PreferenceI FullPreferences where - getPreference = \case - SCFTimedMessages -> timedMessages - SCFFullDelete -> fullDelete - SCFReactions -> reactions - SCFVoice -> voice - SCFCalls -> calls + getPreference f ps = case f of + SCFTimedMessages -> ps.timedMessages + SCFFullDelete -> ps.fullDelete + SCFReactions -> ps.reactions + SCFVoice -> ps.voice + SCFCalls -> ps.calls {-# INLINE getPreference #-} setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences @@ -215,13 +218,13 @@ allGroupFeatures = ] groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f) -groupPrefSel = \case - SGFTimedMessages -> timedMessages - SGFDirectMessages -> directMessages - SGFFullDelete -> fullDelete - SGFReactions -> reactions - SGFVoice -> voice - SGFFiles -> files +groupPrefSel f ps = case f of + SGFTimedMessages -> ps.timedMessages + SGFDirectMessages -> ps.directMessages + SGFFullDelete -> ps.fullDelete + SGFReactions -> ps.reactions + SGFVoice -> ps.voice + SGFFiles -> ps.files toGroupFeature :: SGroupFeature f -> GroupFeature toGroupFeature = \case @@ -242,13 +245,13 @@ instance GroupPreferenceI (Maybe GroupPreferences) where getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs) instance GroupPreferenceI FullGroupPreferences where - getGroupPreference = \case - SGFTimedMessages -> timedMessages - SGFDirectMessages -> directMessages - SGFFullDelete -> fullDelete - SGFReactions -> reactions - SGFVoice -> voice - SGFFiles -> files + getGroupPreference f ps = case f of + SGFTimedMessages -> ps.timedMessages + SGFDirectMessages -> ps.directMessages + SGFFullDelete -> ps.fullDelete + SGFReactions -> ps.reactions + SGFVoice -> ps.voice + SGFFiles -> ps.files {-# INLINE getGroupPreference #-} -- collection of optional group preferences @@ -428,19 +431,19 @@ class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureA prefParam :: FeaturePreference f -> Maybe Int instance HasField "allow" TimedMessagesPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, allow (p :: TimedMessagesPreference)) + hasField p = (\allow -> p {allow}, p.allow) instance HasField "allow" FullDeletePreference FeatureAllowed where - hasField p = (\allow -> p {allow}, allow (p :: FullDeletePreference)) + hasField p = (\allow -> p {allow}, p.allow) instance HasField "allow" ReactionsPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, allow (p :: ReactionsPreference)) + hasField p = (\allow -> p {allow}, p.allow) instance HasField "allow" VoicePreference FeatureAllowed where - hasField p = (\allow -> p {allow}, allow (p :: VoicePreference)) + hasField p = (\allow -> p {allow}, p.allow) instance HasField "allow" CallsPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, allow (p :: CallsPreference)) + hasField p = (\allow -> p {allow}, p.allow) instance FeatureI 'CFTimedMessages where type FeaturePreference 'CFTimedMessages = TimedMessagesPreference @@ -517,25 +520,25 @@ class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference groupPrefParam :: GroupFeaturePreference f -> Maybe Int instance HasField "enable" GroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: GroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: TimedMessagesGroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: DirectMessagesGroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: ReactionsGroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: FullDeleteGroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: VoiceGroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference)) + hasField p = (\enable -> p {enable}, p.enable) instance GroupFeatureI 'GFTimedMessages where type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference @@ -770,9 +773,9 @@ preferenceState pref = in (allow, param) getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f) -getContactUserPreference = \case - SCFTimedMessages -> timedMessages - SCFFullDelete -> fullDelete - SCFReactions -> reactions - SCFVoice -> voice - SCFCalls -> calls +getContactUserPreference f ps = case f of + SCFTimedMessages -> ps.timedMessages + SCFFullDelete -> ps.fullDelete + SCFReactions -> ps.reactions + SCFVoice -> ps.voice + SCFCalls -> ps.calls diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index adb2909ec7..7752876ede 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -7,6 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedRecordDot #-} module Simplex.Chat.View where @@ -187,7 +188,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRContactConnecting u _ -> ttyUser u [] CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"] - CRSubscriptionEnd u acEntity -> ttyUser u [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"] + CRSubscriptionEnd u acEntity -> ttyUser u [sShow ((entityConnection acEntity).connId) <> ": END"] CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e] @@ -654,7 +655,9 @@ viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of viewContactsList :: [Contact] -> [StyledString] viewContactsList = - let ldn = T.toLower . (localDisplayName :: Contact -> ContactName) + let getLDN :: Contact -> ContactName + getLDN Contact{localDisplayName} = localDisplayName + ldn = T.toLower . getLDN in map (\ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn where muted' Contact {chatSettings, localDisplayName = ldn} @@ -792,7 +795,8 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt where removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft groupMember m = memIncognito m <> ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m - role m = plain . strEncode $ memberRole (m :: GroupMember) + role :: GroupMember -> StyledString + role m = plain . strEncode $ m.memberRole category m = case memberCategory m of GCUserMember -> "you, " GCInviteeMember -> "invited, " @@ -824,9 +828,10 @@ viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView viewGroupsList :: [(GroupInfo, GroupSummary)] -> [StyledString] viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g "] -viewGroupsList gs = map groupSS $ sortOn ldn_ gs +viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs where - ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) . fst + ldn_ :: GroupInfo -> Text + ldn_ g = T.toLower g.localDisplayName groupSS (g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings}, GroupSummary {currentMembers}) = case memberStatus membership of GSMemInvited -> groupInvitation' g @@ -1363,7 +1368,8 @@ viewFileTransferStatus (FTSnd FileTransferMeta {cancelled} fts@(ft : _), chunksN case concatMap recipientsTransferStatus $ groupBy ((==) `on` fs) $ sortOn fs fts of [recipientsStatus] -> ["sending " <> sndFile ft <> " " <> recipientsStatus] recipientsStatuses -> ("sending " <> sndFile ft <> ": ") : map (" " <>) recipientsStatuses - fs = fileStatus :: SndFileTransfer -> FileStatus + fs :: SndFileTransfer -> FileStatus + fs SndFileTransfer{fileStatus} = fileStatus recipientsTransferStatus [] = [] recipientsTransferStatus ts@(SndFileTransfer {fileStatus, fileSize, chunkSize} : _) = [sndStatus <> ": " <> listRecipients ts] where @@ -1624,7 +1630,8 @@ viewChatError logLevel = \case Just entity@(UserContactConnection conn UserContact {userContactLinkId}) -> "[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] " Nothing -> "" - cId conn = sShow (connId (conn :: Connection)) + cId :: Connection -> StyledString + cId conn = sShow conn.connId where fileNotFound fileId = ["file " <> sShow fileId <> " not found"] sqliteError' = \case diff --git a/stack.yaml b/stack.yaml index ecdce33753..7ab91ce7d1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,20 +49,24 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 44abb90c63dba63ab5f6d379131e5a7e0f625e98 + commit: 002f36dde042b8957507ec2ca348a0f4494a4cd6 - github: kazu-yamamoto/http2 commit: b5a1b7200cf5bc7044af34ba325284271f6dff25 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher - commit: 34309410eb2069b029b8fc1872deb1e0db123294 + commit: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9 # - ../sqlcipher-simple - github: simplex-chat/sqlcipher-simple - commit: 5e154a2aeccc33ead6c243ec07195ab673137221 + commit: a46bd361a19376c5211f1058908fc0ae6bf42446 # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977 - github: simplex-chat/aeson - commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7 + commit: 68330dce8208173c6acf5f62b23acb500ab5d873 - github: simplex-chat/haskell-terminal commit: f708b00009b54890172068f168bf98508ffcd495 + - github: simplex-chat/android-support + commit: 9aa09f148089d6752ce563b14c2df1895718d806 + - github: simplex-chat/network-transport + commit: 0013798272a683e35ca38d2fdaf480942311fba8 # # extra-deps: [] diff --git a/tests/Bots/BroadcastTests.hs b/tests/Bots/BroadcastTests.hs index 69ec10a7ab..ae2d67c7f0 100644 --- a/tests/Bots/BroadcastTests.hs +++ b/tests/Bots/BroadcastTests.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Bots.BroadcastTests where @@ -33,7 +34,7 @@ broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadc mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts mkBotOpts tmp publishers = BroadcastBotOpts - { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp botDbPrefix}, + { coreOptions = testOpts.coreOptions {dbFilePrefix = tmp botDbPrefix}, publishers, welcomeMessage = defaultWelcomeMessage publishers, prohibitedMessage = defaultWelcomeMessage publishers diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 21bdb6577b..4d7813c301 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} @@ -59,7 +60,7 @@ directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", im mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts mkDirectoryOpts tmp superUsers = DirectoryOpts - { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp serviceDbPrefix}, + { coreOptions = testOpts.coreOptions {dbFilePrefix = tmp serviceDbPrefix}, superUsers, directoryLog = Just $ tmp "directory_service.log", serviceName = "SimpleX-Directory", diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index e612f3d09e..690e16a148 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -6,12 +6,15 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module ChatClient where import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay) import Control.Concurrent.Async import Control.Concurrent.STM import Control.Exception (bracket, bracket_) +import Control.Monad import Control.Monad.Except import Data.Functor (($>)) import Data.List (dropWhileEnd, find) diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 4343b547c9..6600e175bd 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -2,6 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + module ChatTests.Files where import ChatClient