diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 0c7a55b148..4cc2ad7dc4 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -79,10 +79,10 @@ jobs: uses: actions/checkout@v3 - name: Setup Haskell - uses: haskell-actions/setup@v2 + uses: haskell/actions/setup@v2 with: - ghc-version: "9.6.2" - cabal-version: "3.10.1.0" + ghc-version: "8.10.7" + cabal-version: "latest" - name: Cache dependencies uses: actions/cache@v3 @@ -188,7 +188,7 @@ jobs: APPLE_SIMPLEX_NOTARIZATION_APPLE_ID: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_APPLE_ID }} APPLE_SIMPLEX_NOTARIZATION_PASSWORD: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_PASSWORD }} run: | - scripts/ci/build-desktop-mac.sh + scripts/build-desktop-mac.sh path=$(echo $PWD/apps/multiplatform/release/main/dmg/SimpleX-*.dmg) echo "package_path=$path" >> $GITHUB_OUTPUT echo "package_hash=$(echo SHA2-512\(${{ matrix.desktop_asset_name }}\)= $(openssl sha512 $path | cut -d' ' -f 2))" >> $GITHUB_OUTPUT @@ -259,15 +259,15 @@ jobs: # Unix / # / Windows - # rm -rf dist-newstyle/src/direct-sq* is here because of the bug in cabal's dependency which prevents second build from finishing + + # * In powershell multiline commands do not fail if individual commands fail - https://github.community/t/multiline-commands-on-windows-do-not-fail-if-individual-commands-fail/16753 + # * And GitHub Actions does not support parameterizing shell in a matrix job - https://github.community/t/using-matrix-to-specify-shell-is-it-possible/17065 - name: Windows build id: windows_build if: matrix.os == 'windows-latest' - shell: bash + shell: cmd run: | - rm -rf dist-newstyle/src/direct-sq* - sed -i "s/, unix /--, unix /" simplex-chat.cabal cabal build --enable-tests rm -rf dist-newstyle/src/direct-sq* path=$(cabal list-bin simplex-chat | tail -n 1) diff --git a/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt b/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt index cfbc1ed320..849a6c98a7 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 04d8e4ffa1..f30438c384 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 +import Control.Monad.Reader 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 04b6627f38..3a1be2ae08 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 +import Control.Monad.Reader 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 6f198340f8..d59adc04e7 100644 --- a/apps/simplex-chat/Server.hs +++ b/apps/simplex-chat/Server.hs @@ -8,7 +8,6 @@ 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 46abc4652d..09ab424cf0 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 +import Control.Monad.Reader 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 b4024f088c..7c8886d94a 100644 --- a/cabal.project +++ b/cabal.project @@ -2,14 +2,14 @@ packages: . -- packages: . ../simplexmq -- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple -with-compiler: ghc-9.6.2 +with-compiler: ghc-8.10.7 constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 8d47f690838371bc848e4b31a4b09ef6bf67ccc5 + tag: 53c793d5590d3c781aa3fbf72993eee262c7aa83 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: 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/aeson.git - tag: 68330dce8208173c6acf5f62b23acb500ab5d873 + tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7 source-repository-package type: git @@ -43,10 +43,5 @@ source-repository-package source-repository-package type: git - 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 + location: https://github.com/zw3rk/android-support.git + tag: 3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb diff --git a/package.yaml b/package.yaml index 406f9aabaa..ba87c449a8 100644 --- a/package.yaml +++ b/package.yaml @@ -13,25 +13,25 @@ extra-source-files: - cabal.project dependencies: - - aeson == 2.2.* + - aeson == 2.0.* - ansi-terminal >= 0.10 && < 0.12 - async == 2.2.* - attoparsec == 0.14.* - base >= 4.7 && < 5 - base64-bytestring >= 1.0 && < 1.3 - - bytestring == 0.11.* + - bytestring == 0.10.* - composition == 1.0.* - constraints >= 0.12 && < 0.14 - containers == 0.6.* - - cryptonite == 0.30.* + - cryptonite >= 0.27 && < 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.18.* - - mtl == 2.3.* + - memory == 0.15.* + - mtl == 2.2.* - 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.20.* + - template-haskell == 2.16.* - terminal == 0.2.* - - text == 2.0.* + - text == 1.2.* - time == 1.9.* - unliftio == 0.2.* - unliftio-core == 0.2.* - - zip == 2.0.* + - zip == 1.7.* flags: swift: @@ -118,7 +118,7 @@ tests: - simplex-chat - async == 2.2.* - deepseq == 1.4.* - - hspec == 2.11.* + - hspec == 2.7.* - network == 3.1.* - silently == 1.2.* - stm == 2.5.* diff --git a/scripts/ci/prepare-keychain-mac.sh b/scripts/ci/prepare-keychain-mac.sh deleted file mode 100644 index 912e6285af..0000000000 --- a/scripts/ci/prepare-keychain-mac.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/bash - -security create-keychain -p "" simplex.keychain -security set-keychain-settings -u simplex.keychain -security add-certificates -k simplex.keychain "Developer ID Application: SimpleX Chat Ltd (5NN7GUYB6T).cer" -security add-certificates -k simplex.keychain "Developer ID Certification Authority.cer" -# Private key with access from any app -security import "SimpleX Chat.p12" -P "" -k simplex.keychain -A -# Public key -security import "SimpleX Chat.pem" -k simplex.keychain diff --git a/scripts/ci/build-desktop-mac.sh b/scripts/desktop/build-desktop-mac-ci.sh similarity index 63% rename from scripts/ci/build-desktop-mac.sh rename to scripts/desktop/build-desktop-mac-ci.sh index 259b946228..07a3db9c8e 100755 --- a/scripts/ci/build-desktop-mac.sh +++ b/scripts/desktop/build-desktop-mac-ci.sh @@ -2,7 +2,7 @@ set -e -trap "rm apps/multiplatform/local.properties 2> /dev/null || true; rm local.properties 2> /dev/null || true; rm /tmp/simplex.keychain" EXIT +trap "rm apps/multiplatform/local.properties || true; rm local.properties || true; rm /tmp/simplex.keychain || true" EXIT echo "desktop.mac.signing.identity=Developer ID Application: SimpleX Chat Ltd (5NN7GUYB6T)" >> apps/multiplatform/local.properties echo "desktop.mac.signing.keychain=/tmp/simplex.keychain" >> apps/multiplatform/local.properties echo "desktop.mac.notarization.apple_id=$APPLE_SIMPLEX_NOTARIZATION_APPLE_ID" >> apps/multiplatform/local.properties @@ -10,10 +10,6 @@ echo "desktop.mac.notarization.password=$APPLE_SIMPLEX_NOTARIZATION_PASSWORD" >> echo "desktop.mac.notarization.team_id=5NN7GUYB6T" >> apps/multiplatform/local.properties echo "$APPLE_SIMPLEX_SIGNING_KEYCHAIN" | base64 --decode - > /tmp/simplex.keychain -security unlock-keychain -p "" /tmp/simplex.keychain -# Adding keychain to the list of keychains. -# Otherwise, it can find cert but exits while signing with "error: The specified item could not be found in the keychain." -security list-keychains -s `security list-keychains | xargs` /tmp/simplex.keychain scripts/desktop/build-lib-mac.sh cd apps/multiplatform ./gradlew packageDmg diff --git a/scripts/desktop/build-lib-linux.sh b/scripts/desktop/build-lib-linux.sh index 2d9681fc6f..f69b897736 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=9.6.2 +GHC_VERSION=8.10.7 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 -flink-rts -threaded' +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" 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 50bc09df57..b5d738be98 100755 --- a/scripts/desktop/build-lib-mac.sh +++ b/scripts/desktop/build-lib-mac.sh @@ -2,12 +2,9 @@ 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) @@ -15,26 +12,13 @@ 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/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" +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" 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/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 \ - ) -) +cp $GHC_LIBS_DIR/rts/libffi.dylib ./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` @@ -75,13 +59,11 @@ function copy_deps() { } copy_deps $LIB -# Special case -cp $(ghc --print-libdir)/$ARCH-osx-ghc-$GHC_VERSION/libHSghc-boot-th-$GHC_VERSION-ghc$GHC_VERSION.dylib deps 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 26f4ea1122..2ac9c9f1f3 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,11 +1,10 @@ { - "https://github.com/simplex-chat/simplexmq.git"."8d47f690838371bc848e4b31a4b09ef6bf67ccc5" = "1pwasv22ii3wy4xchaknlwczmy5ws7adx7gg2g58lxzrgdjm3650"; + "https://github.com/simplex-chat/simplexmq.git"."53c793d5590d3c781aa3fbf72993eee262c7aa83" = "0f0ldlgqwrapgfw5gnaj00xvb14c8nykyjr9fhy79h4r16g614x8"; "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"."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/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/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj"; - "https://github.com/simplex-chat/android-support.git"."9aa09f148089d6752ce563b14c2df1895718d806" = "0pbf2pf13v2kjzi397nr13f1h3jv0imvsq8rpiyy2qyx5vd50pqn"; - "https://github.com/simplex-chat/network-transport.git"."0013798272a683e35ca38d2fdaf480942311fba8" = "0dnn62apgvc248df0m8ib7phrzn63wm0xs71xvlypv52j6cgwzkb"; + "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97"; } diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 338346b655..3b5bce6dd7 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -145,25 +145,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <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.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -174,13 +174,13 @@ library , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -193,25 +193,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <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.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -223,13 +223,13 @@ executable simplex-bot , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -242,25 +242,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <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.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -272,13 +272,13 @@ executable simplex-bot-advanced , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -293,25 +293,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <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.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -323,13 +323,13 @@ executable simplex-broadcast-bot , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -343,25 +343,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <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.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network ==3.1.* , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -373,14 +373,14 @@ executable simplex-chat , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* , websockets ==0.12.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -397,25 +397,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <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.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network >=3.1.2.7 && <3.2 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -427,13 +427,13 @@ executable simplex-directory-service , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON @@ -470,27 +470,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.2.* + aeson ==2.0.* , ansi-terminal >=0.10 && <0.12 , async ==2.2.* , attoparsec ==0.14.* , base >=4.7 && <5 , base64-bytestring >=1.0 && <1.3 - , bytestring ==0.11.* + , bytestring ==0.10.* , composition ==1.0.* , constraints >=0.12 && <0.14 , containers ==0.6.* - , cryptonite ==0.30.* + , cryptonite >=0.27 && <0.30 , deepseq ==1.4.* , direct-sqlcipher ==2.3.* , directory ==1.3.* , email-validate ==2.3.* , exceptions ==0.10.* , filepath ==1.4.* - , hspec ==2.11.* + , hspec ==2.7.* , http-types ==0.12.* - , memory ==0.18.* - , mtl ==2.3.* + , memory ==0.15.* + , mtl ==2.2.* , network ==3.1.* , optparse-applicative >=0.15 && <0.17 , process ==1.6.* @@ -503,13 +503,13 @@ test-suite simplex-chat-test , socks ==0.6.* , sqlcipher-simple ==0.4.* , stm ==2.5.* - , template-haskell ==2.20.* + , template-haskell ==2.16.* , terminal ==0.2.* - , text ==2.0.* + , text ==1.2.* , time ==1.9.* , unliftio ==0.2.* , unliftio-core ==0.2.* - , zip ==2.0.* + , zip ==1.7.* default-language: Haskell2010 if flag(swift) cpp-options: -DswiftJSON diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index e74eaa0f5c..b331faf5df 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -5,7 +5,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -13,15 +12,12 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} - module Simplex.Chat where import Control.Applicative (optional, (<|>)) -import Control.Concurrent.STM (retry) +import Control.Concurrent.STM (retry, stateTVar) 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 @@ -217,8 +213,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen where configServers :: DefaultAgentServers configServers = - let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers) - xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers) + let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers) + xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers) in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig} agentServers :: ChatConfig -> IO InitialAgentServers agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do @@ -245,9 +241,9 @@ activeAgentServers ChatConfig {defaultServers} p = . filter (\ServerCfg {enabled} -> enabled) cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p)) -cfgServers p s = case p of - SPSMP -> s.smp - SPXFTP -> s.xftp +cfgServers = \case + SPSMP -> smp + SPXFTP -> xftp startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ()) startChatController subConns enableExpireCIs startXFTPWorkers = do @@ -703,9 +699,7 @@ processChatCommand = \case MCVoice {} -> False MCUnknown {} -> True qText = msgContentText qmc - getFileName :: CIFile d -> String - getFileName CIFile{fileName} = fileName - qFileName = maybe qText (T.pack . getFileName) ciFile_ + qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_ qTextOrFile = if T.null qText then qFileName else qText xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta) xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do @@ -918,7 +912,7 @@ processChatCommand = \case pure $ CRContactConnectionDeleted user conn CTGroup -> do Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user chatId - let isOwner = membership.memberRole == GROwner + let isOwner = memberRole (membership :: GroupMember) == GROwner canDelete = isOwner || not (memberCurrent membership) unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo @@ -1095,9 +1089,7 @@ 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 - getMsgTs :: SMP.NMsgMeta -> SystemTime - getMsgTs SMP.NMsgMeta{msgTs} = msgTs - msgTs' = systemToUTCTime . getMsgTs <$> ntfMsgMeta + msgTs' = systemToUTCTime . (SMP.msgTs :: SMP.NMsgMeta -> SystemTime) <$> ntfMsgMeta agentConnId = AgentConnId ntfConnId user_ <- withStore' (`getUserByAConnId` agentConnId) connEntity <- @@ -1504,7 +1496,7 @@ processChatCommand = \case Contact {activeConn = Connection {peerChatVRange}} = ct withChatLock "joinGroup" . procCmd $ do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membership.memberId + dm <- directMessage $ XGrpAcpt (memberId (membership :: GroupMember)) agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode withStore' $ \db -> do createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode @@ -1658,7 +1650,7 @@ processChatCommand = \case case memberConn m of Just mConn -> do let msg = XGrpDirectInv cReq msgContent_ - (sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ g.groupId) + (sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ groupId (g :: GroupInfo)) withStore' $ \db -> setContactGrpInvSent db ct True let ct' = ct {contactGrpInvSent = True} forM_ msgContent_ $ \mc -> do @@ -2022,7 +2014,7 @@ processChatCommand = \case pure $ CRGroupUpdated user g g' Nothing assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m () assertUserGroupRole g@GroupInfo {membership} requiredRole = do - when (membership.memberRole < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole + when (memberRole (membership :: GroupMember) < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved unless (memberActive membership) $ throwChatError CEGroupMemberNotActive @@ -2040,7 +2032,7 @@ processChatCommand = \case runUpdateGroupProfile user g $ update p isReady :: Contact -> Bool isReady ct = - let s = connStatus $ ct.activeConn + let s = connStatus $ activeConn (ct :: Contact) in s == ConnReady || s == ConnSndReady withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse withCurrentCall ctId action = do @@ -3222,7 +3214,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 membership.memberId (fromLocalProfile $ memberProfile membership) + allowAgentConnectionAsync user conn' confId $ XGrpMemInfo (memberId (membership :: GroupMember)) (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 @@ -3261,7 +3253,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 " <> m.localDisplayName <> " is connected" + showToast ("#" <> gName) $ "member " <> localDisplayName (m :: GroupMember) <> " is connected" intros <- withStore' $ \db -> createIntroductions db members m void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m forM_ intros $ \intro -> @@ -3321,9 +3313,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do && hasDeliveryReceipt (toCMEventTag event) && currentMemCount <= smallGroupsRcptsMemLimit where - canSend :: GroupMember -> m () -> m () canSend mem a - | mem.memberRole <= GRObserver = messageError "member is not allowed to send messages" + | memberRole (mem :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages" | otherwise = a RCVD msgMeta msgRcpt -> withAckMessage' agentConnId conn msgMeta $ @@ -4520,7 +4511,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> saveMemberInvitation db toMember introInv subMode <- chatReadVar subscriptionMode -- [incognito] send membership incognito profile, create direct connection as incognito - dm <- directMessage $ XGrpMemInfo membership.memberId (fromLocalProfile $ memberProfile membership) + dm <- directMessage $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) -- [async agent commands] no continuation needed, but commands should be asynchronous for stability groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm subMode @@ -4530,7 +4521,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 - | membership.memberId == memId = + | memberId (membership :: GroupMember) == memId = let gInfo' = gInfo {membership = membership {memberRole = memRole}} in changeMemberRole gInfo' membership $ RGEUserRole memRole | otherwise = do @@ -4554,7 +4545,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 membership.memberId == memId + if memberId (membership :: GroupMember) == memId then checkRole membership $ do deleteGroupLinkIfExists user gInfo -- member records are not deleted to keep history @@ -4796,7 +4787,7 @@ parseFileChunk :: ChatMonad m => ByteString -> m FileChunk parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode appendFileChunk :: forall m. ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> Bool -> m () -appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs} chunkNo chunk final = +appendFileChunk ft@RcvFileTransfer {fileId, fileInvitation, fileStatus, cryptoArgs} chunkNo chunk final = case fileStatus of RFSConnected RcvFileInfo {filePath} -> append_ filePath -- sometimes update of file transfer status to FSConnected @@ -4814,7 +4805,7 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs} chunkNo chun when final $ do closeFileHandle fileId rcvFiles forM_ cryptoArgs $ \cfArgs -> do - tmpFile <- getChatTempDirectory >>= (`uniqueCombine` ft.fileInvitation.fileName) + tmpFile <- getChatTempDirectory >>= (`uniqueCombine` fileName (fileInvitation :: FileInvitation)) tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case Right () -> do removeFile fsFilePath `catchChatError` \_ -> pure () @@ -5153,7 +5144,7 @@ createSndFeatureItems :: forall m. ChatMonad m => User -> Contact -> Contact -> createSndFeatureItems user ct ct' = createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref where - getPref u = (userPreference u).preference + getPref = (preference :: ContactUserPref (FeaturePreference f) -> FeaturePreference f) . userPreference type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d @@ -5238,7 +5229,7 @@ getCreateActiveUser st testView = do Right user -> pure user selectUser :: [User] -> IO User selectUser [user] = do - withTransaction st (`setActiveUser` user.userId) + withTransaction st (`setActiveUser` userId (user :: User)) pure user selectUser users = do putStrLn "Select user profile:" @@ -5253,7 +5244,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` user.userId) + withTransaction st (`setActiveUser` userId (user :: User)) 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 f8fa0d152a..2444785501 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -13,7 +13,6 @@ 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 ecd1659bca..df9c66ceee 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 +import Control.Monad.Reader 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 79463d2107..45e5f9ff74 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -6,14 +6,11 @@ {-# 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 ((<|>)) @@ -376,7 +373,7 @@ contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessag | forUser enabled && forContact enabled = Just ttl | otherwise = Nothing where - TimedMessagesPreference {ttl} = userPreference.preference + TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference) groupTimedTTL :: GroupInfo -> Maybe (Maybe Int) groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}} diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs index 73978549ff..f385e14f4d 100644 --- a/src/Simplex/Chat/Mobile/File.hs +++ b/src/Simplex/Chat/Mobile/File.hs @@ -16,9 +16,7 @@ module Simplex.Chat.Mobile.File ) 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.ByteString (ByteString) diff --git a/src/Simplex/Chat/Mobile/Shared.hs b/src/Simplex/Chat/Mobile/Shared.hs index d0c5b0b86e..d1f60ffce5 100644 --- a/src/Simplex/Chat/Mobile/Shared.hs +++ b/src/Simplex/Chat/Mobile/Shared.hs @@ -16,12 +16,12 @@ type JSONByteString = LB.ByteString getByteString :: Ptr Word8 -> CInt -> IO ByteString getByteString ptr len = do fp <- newForeignPtr_ ptr - pure $ BS fp $ fromIntegral len + pure $ PS fp 0 $ fromIntegral len {-# INLINE getByteString #-} putByteString :: Ptr Word8 -> ByteString -> IO () -putByteString ptr (BS fp len) = - withForeignPtr fp $ \p -> memcpy ptr p len +putByteString ptr (PS fp offset len) = + withForeignPtr fp $ \p -> memcpy ptr (p `plusPtr` offset) len {-# INLINE putByteString #-} putLazyByteString :: Ptr Word8 -> LB.ByteString -> IO () diff --git a/src/Simplex/Chat/Mobile/WebRTC.hs b/src/Simplex/Chat/Mobile/WebRTC.hs index 7840a069fa..19ba2b751b 100644 --- a/src/Simplex/Chat/Mobile/WebRTC.hs +++ b/src/Simplex/Chat/Mobile/WebRTC.hs @@ -8,9 +8,7 @@ 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 6e725e6c26..660f52cdff 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -13,8 +13,6 @@ {-# 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 7da0d1ca85..842c57838e 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -5,8 +5,6 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} - module Simplex.Chat.Store.Connections ( getConnectionEntity, getConnectionsToSubscribe, @@ -15,7 +13,6 @@ module Simplex.Chat.Store.Connections where import Control.Applicative ((<|>)) -import Control.Monad import Control.Monad.Except import Data.Int (Int64) import Data.Maybe (catMaybes, fromMaybe) diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 7e8cee0e74..9c45129385 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -8,8 +7,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} - module Simplex.Chat.Store.Direct ( updateContact_, updateContactProfile_, @@ -64,9 +61,7 @@ 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) @@ -461,7 +456,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers ExceptT $ maybeM getContactRequestByXContactId xContactId_ >>= \case Nothing -> createContactRequest - Just cr -> updateContactRequest cr $> Right cr.contactRequestId + Just cr -> updateContactRequest cr $> Right (contactRequestId (cr :: UserContactRequest)) 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 a710696dad..b45da44a49 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -76,9 +76,7 @@ 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) @@ -486,7 +484,7 @@ 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 = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ + let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_ -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP @@ -507,7 +505,7 @@ 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 = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ + let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_ -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index d6aa3a5b92..f4ae569e19 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -8,9 +8,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedRecordDot #-} - -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat.Store.Groups ( -- * Util methods @@ -98,9 +95,7 @@ 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) @@ -890,7 +885,7 @@ saveIntroInvitation db reMember toMember introInv = do WHERE group_member_intro_id = :intro_id |] [ ":intro_status" := GMIntroInvReceived, - ":group_queue_info" := introInv.groupConnReq, + ":group_queue_info" := groupConnReq (introInv :: IntroInvitation), ":direct_queue_info" := directConnReq introInv, ":updated_at" := currentTs, ":intro_id" := introId intro @@ -938,7 +933,7 @@ getIntroduction_ db reMember toMember = ExceptT $ do createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do let mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange - cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn + cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn currentTs <- liftIO getCurrentTime newMember <- case directConnIds of Just (directCmdId, directAgentConnId) -> do @@ -957,7 +952,7 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO () createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do - let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn + let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn currentTs <- getCurrentTime Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode setCommandConnId db user groupCmdId groupConnId diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index c08e6b11d3..5f64b9e390 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -10,8 +10,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} - module Simplex.Chat.Store.Messages ( getContactConnIds_, getDirectChatReactions_, @@ -98,9 +96,7 @@ 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 e521cb43cf..7f3c9841c0 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -7,8 +7,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} - module Simplex.Chat.Store.Profiles ( AutoAccept (..), UserMsgReceiptSettings (..), @@ -56,9 +54,7 @@ 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 (($>)) @@ -294,7 +290,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 -> SubscriptionMode -> ExceptT StoreError IO () diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index e979c90067..0e146bb992 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -10,11 +10,10 @@ 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 0ef3d3bace..6a148e8778 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 +import Control.Monad.Except 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 8841f15ffd..36cec49d7c 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -12,7 +12,6 @@ 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 db6f16f3ca..ce68d715fe 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -9,7 +9,6 @@ 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 93964316cc..dea948e842 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -16,8 +16,6 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE OverloadedRecordDot #-} - {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use newtype instead of data" #-} @@ -58,21 +56,21 @@ class IsContact a where preferences' :: a -> Maybe Preferences instance IsContact User where - contactId' u = u.userContactId + contactId' = userContactId {-# INLINE contactId' #-} - profile' u = u.profile + profile' = profile {-# INLINE profile' #-} - localDisplayName' u = u.localDisplayName + localDisplayName' = localDisplayName {-# INLINE localDisplayName' #-} preferences' User {profile = LocalProfile {preferences}} = preferences {-# INLINE preferences' #-} instance IsContact Contact where - contactId' c = c.contactId + contactId' = contactId {-# INLINE contactId' #-} - profile' c = c.profile + profile' = profile {-# INLINE profile' #-} - localDisplayName' c = c.localDisplayName + localDisplayName' = localDisplayName {-# INLINE localDisplayName' #-} preferences' Contact {profile = LocalProfile {preferences}} = preferences {-# INLINE preferences' #-} @@ -185,7 +183,7 @@ instance ToJSON Contact where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} contactConn :: Contact -> Connection -contactConn Contact{activeConn} = activeConn +contactConn = activeConn contactConnId :: Contact -> ConnId contactConnId = aConnId . contactConn @@ -468,7 +466,7 @@ instance ToJSON LocalProfile where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} localProfileId :: LocalProfile -> ProfileId -localProfileId LocalProfile{profileId} = profileId +localProfileId = profileId toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile toLocalProfile profileId Profile {displayName, fullName, image, contactLink, preferences} localAlias = @@ -629,7 +627,7 @@ groupMemberRef GroupMember {groupMemberId, memberProfile = p} = GroupMemberRef {groupMemberId, profile = fromLocalProfile p} memberConn :: GroupMember -> Maybe Connection -memberConn GroupMember{activeConn} = activeConn +memberConn = 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 c53e4476f4..a89e383242 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -8,15 +8,12 @@ {-# 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" #-} @@ -88,12 +85,12 @@ allChatFeatures = ] chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f) -chatPrefSel f ps = case f of - SCFTimedMessages -> ps.timedMessages - SCFFullDelete -> ps.fullDelete - SCFReactions -> ps.reactions - SCFVoice -> ps.voice - SCFCalls -> ps.calls +chatPrefSel = \case + SCFTimedMessages -> timedMessages + SCFFullDelete -> fullDelete + SCFReactions -> reactions + SCFVoice -> voice + SCFCalls -> calls chatFeature :: SChatFeature f -> ChatFeature chatFeature = \case @@ -113,12 +110,12 @@ instance PreferenceI (Maybe Preferences) where getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs) instance PreferenceI FullPreferences where - getPreference f ps = case f of - SCFTimedMessages -> ps.timedMessages - SCFFullDelete -> ps.fullDelete - SCFReactions -> ps.reactions - SCFVoice -> ps.voice - SCFCalls -> ps.calls + getPreference = \case + SCFTimedMessages -> timedMessages + SCFFullDelete -> fullDelete + SCFReactions -> reactions + SCFVoice -> voice + SCFCalls -> calls {-# INLINE getPreference #-} setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences @@ -218,13 +215,13 @@ allGroupFeatures = ] groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f) -groupPrefSel f ps = case f of - SGFTimedMessages -> ps.timedMessages - SGFDirectMessages -> ps.directMessages - SGFFullDelete -> ps.fullDelete - SGFReactions -> ps.reactions - SGFVoice -> ps.voice - SGFFiles -> ps.files +groupPrefSel = \case + SGFTimedMessages -> timedMessages + SGFDirectMessages -> directMessages + SGFFullDelete -> fullDelete + SGFReactions -> reactions + SGFVoice -> voice + SGFFiles -> files toGroupFeature :: SGroupFeature f -> GroupFeature toGroupFeature = \case @@ -245,13 +242,13 @@ instance GroupPreferenceI (Maybe GroupPreferences) where getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs) instance GroupPreferenceI FullGroupPreferences where - getGroupPreference f ps = case f of - SGFTimedMessages -> ps.timedMessages - SGFDirectMessages -> ps.directMessages - SGFFullDelete -> ps.fullDelete - SGFReactions -> ps.reactions - SGFVoice -> ps.voice - SGFFiles -> ps.files + getGroupPreference = \case + SGFTimedMessages -> timedMessages + SGFDirectMessages -> directMessages + SGFFullDelete -> fullDelete + SGFReactions -> reactions + SGFVoice -> voice + SGFFiles -> files {-# INLINE getGroupPreference #-} -- collection of optional group preferences @@ -431,19 +428,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}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: TimedMessagesPreference)) instance HasField "allow" FullDeletePreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: FullDeletePreference)) instance HasField "allow" ReactionsPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: ReactionsPreference)) instance HasField "allow" VoicePreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: VoicePreference)) instance HasField "allow" CallsPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: CallsPreference)) instance FeatureI 'CFTimedMessages where type FeaturePreference 'CFTimedMessages = TimedMessagesPreference @@ -520,25 +517,25 @@ class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference groupPrefParam :: GroupFeaturePreference f -> Maybe Int instance HasField "enable" GroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: GroupPreference)) instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: TimedMessagesGroupPreference)) instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: DirectMessagesGroupPreference)) instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: ReactionsGroupPreference)) instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: FullDeleteGroupPreference)) instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: VoiceGroupPreference)) instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference)) instance GroupFeatureI 'GFTimedMessages where type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference @@ -773,9 +770,9 @@ preferenceState pref = in (allow, param) getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f) -getContactUserPreference f ps = case f of - SCFTimedMessages -> ps.timedMessages - SCFFullDelete -> ps.fullDelete - SCFReactions -> ps.reactions - SCFVoice -> ps.voice - SCFCalls -> ps.calls +getContactUserPreference = \case + SCFTimedMessages -> timedMessages + SCFFullDelete -> fullDelete + SCFReactions -> reactions + SCFVoice -> voice + SCFCalls -> calls diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 5db0c317e8..e985156290 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -7,7 +7,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE OverloadedRecordDot #-} module Simplex.Chat.View where @@ -192,7 +191,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 ((entityConnection acEntity).connId) <> ": END"] + CRSubscriptionEnd u acEntity -> ttyUser u [sShow (connId (entityConnection acEntity :: Connection)) <> ": 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] @@ -687,9 +686,7 @@ viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of viewContactsList :: [Contact] -> [StyledString] viewContactsList = - let getLDN :: Contact -> ContactName - getLDN Contact{localDisplayName} = localDisplayName - ldn = T.toLower . getLDN + let ldn = T.toLower . (localDisplayName :: Contact -> ContactName) in map (\ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn where muted' Contact {chatSettings, localDisplayName = ldn} @@ -827,8 +824,7 @@ 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 :: GroupMember -> StyledString - role m = plain . strEncode $ m.memberRole + role m = plain . strEncode $ memberRole (m :: GroupMember) category m = case memberCategory m of GCUserMember -> "you, " GCInviteeMember -> "invited, " @@ -860,10 +856,9 @@ 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_ . fst) gs +viewGroupsList gs = map groupSS $ sortOn ldn_ gs where - ldn_ :: GroupInfo -> Text - ldn_ g = T.toLower g.localDisplayName + ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) . fst groupSS (g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings}, GroupSummary {currentMembers}) = case memberStatus membership of GSMemInvited -> groupInvitation' g @@ -1411,8 +1406,7 @@ 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 :: SndFileTransfer -> FileStatus - fs SndFileTransfer{fileStatus} = fileStatus + fs = fileStatus :: SndFileTransfer -> FileStatus recipientsTransferStatus [] = [] recipientsTransferStatus ts@(SndFileTransfer {fileStatus, fileSize, chunkSize} : _) = [sndStatus <> ": " <> listRecipients ts] where @@ -1675,8 +1669,7 @@ viewChatError logLevel = \case Just entity@(UserContactConnection conn UserContact {userContactLinkId}) -> "[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] " Nothing -> "" - cId :: Connection -> StyledString - cId conn = sShow conn.connId + cId conn = sShow (connId (conn :: Connection)) where fileNotFound fileId = ["file " <> sShow fileId <> " not found"] sqliteError' = \case diff --git a/stack.yaml b/stack.yaml index 0840970e49..868e19faf5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,24 +49,20 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 8d47f690838371bc848e4b31a4b09ef6bf67ccc5 + commit: 53c793d5590d3c781aa3fbf72993eee262c7aa83 - github: kazu-yamamoto/http2 commit: b5a1b7200cf5bc7044af34ba325284271f6dff25 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher - commit: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9 + commit: 34309410eb2069b029b8fc1872deb1e0db123294 # - ../sqlcipher-simple - github: simplex-chat/sqlcipher-simple - commit: a46bd361a19376c5211f1058908fc0ae6bf42446 + commit: 5e154a2aeccc33ead6c243ec07195ab673137221 # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977 - github: simplex-chat/aeson - commit: 68330dce8208173c6acf5f62b23acb500ab5d873 + commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7 - 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 ae2d67c7f0..69ec10a7ab 100644 --- a/tests/Bots/BroadcastTests.hs +++ b/tests/Bots/BroadcastTests.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Bots.BroadcastTests where @@ -34,7 +33,7 @@ broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadc mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts mkBotOpts tmp publishers = BroadcastBotOpts - { coreOptions = testOpts.coreOptions {dbFilePrefix = tmp botDbPrefix}, + { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp botDbPrefix}, publishers, welcomeMessage = defaultWelcomeMessage publishers, prohibitedMessage = defaultWelcomeMessage publishers diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 0e315190c5..f34ab042e8 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} @@ -61,7 +60,7 @@ directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", im mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts mkDirectoryOpts tmp superUsers = DirectoryOpts - { coreOptions = testOpts.coreOptions {dbFilePrefix = tmp serviceDbPrefix}, + { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp serviceDbPrefix}, superUsers, directoryLog = Just $ tmp "directory_service.log", serviceName = "SimpleX-Directory", diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 7da5263253..de6353d2e0 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -6,15 +6,12 @@ {-# 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 f84d4dcb40..949e745d2a 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -2,8 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} - module ChatTests.Files where import ChatClient