Merge branch 'master-ghc9'

This commit is contained in:
Evgeny Poberezkin
2023-09-18 22:15:20 +01:00
39 changed files with 313 additions and 199 deletions

View File

@@ -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
@@ -171,8 +171,8 @@ jobs:
APPLE_SIMPLEX_NOTARIZATION_APPLE_ID: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_APPLE_ID }}
APPLE_SIMPLEX_NOTARIZATION_PASSWORD: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_PASSWORD }}
run: |
scripts/desktop/build-desktop-mac-ci.sh
echo "::set-output name=package_path::$(echo $PWD/release/main/dmg/SimpleX-*.dmg)"
scripts/ci/build-desktop-mac.sh
echo "::set-output name=package_path::$(echo $PWD/apps/multiplatform/release/main/dmg/SimpleX-*.dmg)"
- name: Linux upload desktop package to release
if: startsWith(github.ref, 'refs/tags/v') && (matrix.os == 'ubuntu-20.04' || matrix.os == 'ubuntu-22.04')
@@ -210,19 +210,18 @@ jobs:
# Unix /
# / Windows
# * 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
# rm -rf dist-newstyle/src/direct-sq* is here because of the bug in cabal's dependency which prevents second build from finishing
- name: Windows build
id: windows_build
if: matrix.os == 'windows-latest'
shell: cmd
shell: bash
run: |
rm -rf dist-newstyle/src/direct-sq*
sed -i "s/, unix /--, unix /" simplex-chat.cabal
cabal build --enable-tests
cabal list-bin simplex-chat > tmp_bin_path
set /p bin_path= < tmp_bin_path
echo ::set-output name=bin_path::%bin_path%
rm -rf dist-newstyle/src/direct-sq*
echo "::set-output name=bin_path::$(cabal list-bin simplex-chat | tail -n 1)"
- name: Windows upload binary to release
if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -8,6 +8,7 @@
module Server where
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson (FromJSON, ToJSON)

View File

@@ -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)

View File

@@ -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: 0cabe0690beee90f460ad7bada72294222e7e109
tag: 81385e39bf5d953ec7f85e6e82014672239c3520
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

View File

@@ -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,14 @@ 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.*
- unix == 2.8.1.1
- unliftio == 0.2.*
- unliftio-core == 0.2.*
- zip == 1.7.*
- zip == 2.0.*
flags:
swift:
@@ -118,7 +119,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.*

View File

@@ -2,7 +2,7 @@
set -e
trap "rm apps/multiplatform/local.properties || true; rm local.properties || true; rm /tmp/simplex.keychain || true" EXIT
trap "rm apps/multiplatform/local.properties 2> /dev/null || true; rm local.properties 2> /dev/null || true; rm /tmp/simplex.keychain" 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,6 +10,10 @@ 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

View File

@@ -0,0 +1,10 @@
#!/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

View File

@@ -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

View File

@@ -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`
@@ -59,11 +75,13 @@ 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

View File

@@ -1,10 +1,11 @@
{
"https://github.com/simplex-chat/simplexmq.git"."0cabe0690beee90f460ad7bada72294222e7e109" = "1yfcrifb2l59wgl14q56ywlil2g2zs57ic62s617whh3w2mnh0kz";
"https://github.com/simplex-chat/simplexmq.git"."81385e39bf5d953ec7f85e6e82014672239c3520" = "1mdfi6w0w6zqrlycxcziwl29bvqrq07ing6czax8mf66b656lr21";
"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";
}

View File

@@ -144,25 +144,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.*
@@ -173,13 +173,14 @@ 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.*
, unix ==2.8.1.1
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==1.7.*
, zip ==2.0.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
@@ -192,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.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.*
@@ -222,13 +223,14 @@ 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.*
, unix ==2.8.1.1
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==1.7.*
, zip ==2.0.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
@@ -241,25 +243,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.*
@@ -271,13 +273,14 @@ 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.*
, unix ==2.8.1.1
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==1.7.*
, zip ==2.0.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
@@ -292,25 +295,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.*
@@ -322,13 +325,14 @@ 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.*
, unix ==2.8.1.1
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==1.7.*
, zip ==2.0.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
@@ -342,25 +346,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.*
@@ -372,14 +376,15 @@ 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.*
, unix ==2.8.1.1
, 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
@@ -396,25 +401,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.*
@@ -426,13 +431,14 @@ 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.*
, unix ==2.8.1.1
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==1.7.*
, zip ==2.0.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
@@ -469,27 +475,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.*
@@ -502,13 +508,14 @@ 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.*
, unix ==2.8.1.1
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==1.7.*
, zip ==2.0.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -12,12 +13,15 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# 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
@@ -212,8 +216,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
@@ -240,9 +244,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
@@ -698,7 +702,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 -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
@@ -911,7 +917,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
@@ -1088,7 +1094,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 <-
@@ -1495,7 +1503,7 @@ processChatCommand = \case
Contact {activeConn = Connection {peerChatVRange}} = ct
withChatLock "joinGroup" . procCmd $ do
subMode <- chatReadVar subscriptionMode
dm <- directMessage $ XGrpAcpt (memberId (membership :: GroupMember))
dm <- directMessage $ XGrpAcpt membership.memberId
agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode
withStore' $ \db -> do
createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode
@@ -1649,7 +1657,7 @@ processChatCommand = \case
case memberConn m of
Just mConn -> do
let msg = XGrpDirectInv cReq msgContent_
(sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ groupId (g :: GroupInfo))
(sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ g.groupId)
withStore' $ \db -> setContactGrpInvSent db ct True
let ct' = ct {contactGrpInvSent = True}
forM_ msgContent_ $ \mc -> do
@@ -2020,7 +2028,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
@@ -2038,7 +2046,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
@@ -3213,7 +3221,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
@@ -3252,7 +3260,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 ->
@@ -3309,8 +3317,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
&& hasDeliveryReceipt (toCMEventTag event)
&& currentMemCount <= smallGroupsRcptsMemLimit
where
canSend :: GroupMember -> m () -> m ()
canSend mem a
| memberRole (mem :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages"
| mem.memberRole <= GRObserver = messageError "member is not allowed to send messages"
| otherwise = a
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId conn msgMeta $
@@ -4460,7 +4469,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 (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership)
dm <- directMessage $ XGrpMemInfo membership.memberId (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
@@ -4470,7 +4479,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
@@ -4494,7 +4503,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
@@ -5075,7 +5084,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
@@ -5160,7 +5169,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:"
@@ -5175,7 +5184,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}} =

View File

@@ -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 (($>))

View File

@@ -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

View File

@@ -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 ((<|>))
@@ -373,7 +376,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}}}

View File

@@ -16,7 +16,9 @@ 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)

View File

@@ -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

View File

@@ -13,6 +13,8 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Protocol where
import Control.Applicative ((<|>))

View File

@@ -5,6 +5,8 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Connections
( getConnectionEntity,
getConnectionsToSubscribe,
@@ -13,6 +15,7 @@ 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)

View File

@@ -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)
@@ -427,7 +432,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
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

View File

@@ -75,7 +75,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)
@@ -483,7 +485,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 = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
@@ -504,7 +506,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 = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP

View File

@@ -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
@@ -94,7 +97,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)
@@ -885,7 +890,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
@@ -933,7 +938,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 (connLevel :: Connection -> Int) activeConn
cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
currentTs <- liftIO getCurrentTime
newMember <- case directConnIds of
Just (directCmdId, directAgentConnId) -> do
@@ -952,7 +957,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 (connLevel :: Connection -> Int) activeConn
let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
currentTs <- getCurrentTime
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode
setCommandConnId db user groupCmdId groupConnId

View File

@@ -10,6 +10,8 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Messages
( getContactConnIds_,
getDirectChatReactions_,
@@ -96,7 +98,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)

View File

@@ -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 -> SubscriptionMode -> ExceptT StoreError IO ()

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -16,6 +16,8 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use newtype instead of data" #-}
@@ -56,21 +58,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' #-}
@@ -183,7 +185,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
@@ -453,7 +455,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 =
@@ -609,7 +611,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

View File

@@ -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

View File

@@ -7,6 +7,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Simplex.Chat.View where
@@ -191,7 +192,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]
@@ -685,7 +686,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}
@@ -823,7 +826,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, "
@@ -855,9 +859,10 @@ viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView
viewGroupsList :: [(GroupInfo, GroupSummary)] -> [StyledString]
viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
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
@@ -1406,7 +1411,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
@@ -1669,7 +1675,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

View File

@@ -49,20 +49,24 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
commit: 0cabe0690beee90f460ad7bada72294222e7e109
commit: 81385e39bf5d953ec7f85e6e82014672239c3520
- 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: []

View File

@@ -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

View File

@@ -1,5 +1,6 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-}
@@ -60,7 +61,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",

View File

@@ -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)

View File

@@ -2,6 +2,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module ChatTests.Files where
import ChatClient