mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-07-03 23:47:16 +00:00
Compare commits
16 commits
stable
...
v5.3.1-fdr
Author | SHA1 | Date | |
---|---|---|---|
|
6a578cfe3c | ||
|
dacc075fe8 | ||
|
55418e2bc0 | ||
|
f2b5c0f3a8 | ||
|
5ebdf5dba9 | ||
|
8e045764df | ||
|
503d3d77e6 | ||
|
81bd7d97c5 | ||
|
8f57925067 | ||
|
9bf99db82e | ||
|
5615cdbf1a | ||
|
d802ae0058 | ||
|
8f2278198c | ||
|
10937a5a4e | ||
|
6aff6e9804 | ||
|
95477cae7e |
40 changed files with 200 additions and 307 deletions
16
.github/workflows/build.yml
vendored
16
.github/workflows/build.yml
vendored
|
@ -79,10 +79,10 @@ jobs:
|
||||||
uses: actions/checkout@v3
|
uses: actions/checkout@v3
|
||||||
|
|
||||||
- name: Setup Haskell
|
- name: Setup Haskell
|
||||||
uses: haskell-actions/setup@v2
|
uses: haskell/actions/setup@v2
|
||||||
with:
|
with:
|
||||||
ghc-version: "9.6.2"
|
ghc-version: "8.10.7"
|
||||||
cabal-version: "3.10.1.0"
|
cabal-version: "latest"
|
||||||
|
|
||||||
- name: Cache dependencies
|
- name: Cache dependencies
|
||||||
uses: actions/cache@v3
|
uses: actions/cache@v3
|
||||||
|
@ -188,7 +188,7 @@ jobs:
|
||||||
APPLE_SIMPLEX_NOTARIZATION_APPLE_ID: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_APPLE_ID }}
|
APPLE_SIMPLEX_NOTARIZATION_APPLE_ID: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_APPLE_ID }}
|
||||||
APPLE_SIMPLEX_NOTARIZATION_PASSWORD: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_PASSWORD }}
|
APPLE_SIMPLEX_NOTARIZATION_PASSWORD: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_PASSWORD }}
|
||||||
run: |
|
run: |
|
||||||
scripts/ci/build-desktop-mac.sh
|
scripts/build-desktop-mac.sh
|
||||||
path=$(echo $PWD/apps/multiplatform/release/main/dmg/SimpleX-*.dmg)
|
path=$(echo $PWD/apps/multiplatform/release/main/dmg/SimpleX-*.dmg)
|
||||||
echo "package_path=$path" >> $GITHUB_OUTPUT
|
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
|
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 /
|
# Unix /
|
||||||
|
|
||||||
# / Windows
|
# / 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
|
- name: Windows build
|
||||||
id: windows_build
|
id: windows_build
|
||||||
if: matrix.os == 'windows-latest'
|
if: matrix.os == 'windows-latest'
|
||||||
shell: bash
|
shell: cmd
|
||||||
run: |
|
run: |
|
||||||
rm -rf dist-newstyle/src/direct-sq*
|
|
||||||
sed -i "s/, unix /--, unix /" simplex-chat.cabal
|
|
||||||
cabal build --enable-tests
|
cabal build --enable-tests
|
||||||
rm -rf dist-newstyle/src/direct-sq*
|
rm -rf dist-newstyle/src/direct-sq*
|
||||||
path=$(cabal list-bin simplex-chat | tail -n 1)
|
path=$(cabal list-bin simplex-chat | tail -n 1)
|
||||||
|
|
|
@ -67,7 +67,7 @@ if(NOT APPLE)
|
||||||
else()
|
else()
|
||||||
# Without direct linking it can't find hs_init in linking step
|
# Without direct linking it can't find hs_init in linking step
|
||||||
add_library( rts SHARED IMPORTED )
|
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})
|
set_target_properties( rts PROPERTIES IMPORTED_LOCATION ${RTSLIB})
|
||||||
|
|
||||||
target_link_libraries(app-lib rts simplex)
|
target_link_libraries(app-lib rts simplex)
|
||||||
|
|
|
@ -8,7 +8,7 @@ module Main where
|
||||||
|
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Monad
|
import Control.Monad.Reader
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Simplex.Chat.Bot
|
import Simplex.Chat.Bot
|
||||||
import Simplex.Chat.Controller
|
import Simplex.Chat.Controller
|
||||||
|
|
|
@ -9,7 +9,7 @@ module Broadcast.Bot where
|
||||||
import Control.Concurrent (forkIO)
|
import Control.Concurrent (forkIO)
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Monad
|
import Control.Monad.Reader
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Broadcast.Options
|
import Broadcast.Options
|
||||||
import Simplex.Chat.Bot
|
import Simplex.Chat.Bot
|
||||||
|
|
|
@ -8,7 +8,6 @@
|
||||||
|
|
||||||
module Server where
|
module Server where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Aeson (FromJSON, ToJSON)
|
import Data.Aeson (FromJSON, ToJSON)
|
||||||
|
|
|
@ -15,7 +15,7 @@ where
|
||||||
import Control.Concurrent (forkIO)
|
import Control.Concurrent (forkIO)
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Monad
|
import Control.Monad.Reader
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
import Data.Maybe (fromMaybe, maybeToList)
|
import Data.Maybe (fromMaybe, maybeToList)
|
||||||
|
|
|
@ -2,14 +2,14 @@ packages: .
|
||||||
-- packages: . ../simplexmq
|
-- packages: . ../simplexmq
|
||||||
-- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple
|
-- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple
|
||||||
|
|
||||||
with-compiler: ghc-9.6.2
|
with-compiler: ghc-8.10.7
|
||||||
|
|
||||||
constraints: zip +disable-bzip2 +disable-zstd
|
constraints: zip +disable-bzip2 +disable-zstd
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/simplex-chat/simplexmq.git
|
location: https://github.com/simplex-chat/simplexmq.git
|
||||||
tag: 8d47f690838371bc848e4b31a4b09ef6bf67ccc5
|
tag: 53c793d5590d3c781aa3fbf72993eee262c7aa83
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
|
@ -24,17 +24,17 @@ source-repository-package
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/simplex-chat/direct-sqlcipher.git
|
location: https://github.com/simplex-chat/direct-sqlcipher.git
|
||||||
tag: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
|
tag: 34309410eb2069b029b8fc1872deb1e0db123294
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/simplex-chat/sqlcipher-simple.git
|
location: https://github.com/simplex-chat/sqlcipher-simple.git
|
||||||
tag: a46bd361a19376c5211f1058908fc0ae6bf42446
|
tag: 5e154a2aeccc33ead6c243ec07195ab673137221
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/simplex-chat/aeson.git
|
location: https://github.com/simplex-chat/aeson.git
|
||||||
tag: 68330dce8208173c6acf5f62b23acb500ab5d873
|
tag: 3eb66f9a68f103b5f1489382aad89f5712a64db7
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
|
@ -43,10 +43,5 @@ source-repository-package
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/simplex-chat/android-support.git
|
location: https://github.com/zw3rk/android-support.git
|
||||||
tag: 9aa09f148089d6752ce563b14c2df1895718d806
|
tag: 3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb
|
||||||
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/simplex-chat/network-transport.git
|
|
||||||
tag: 0013798272a683e35ca38d2fdaf480942311fba8
|
|
||||||
|
|
18
package.yaml
18
package.yaml
|
@ -13,25 +13,25 @@ extra-source-files:
|
||||||
- cabal.project
|
- cabal.project
|
||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- aeson == 2.2.*
|
- aeson == 2.0.*
|
||||||
- ansi-terminal >= 0.10 && < 0.12
|
- ansi-terminal >= 0.10 && < 0.12
|
||||||
- async == 2.2.*
|
- async == 2.2.*
|
||||||
- attoparsec == 0.14.*
|
- attoparsec == 0.14.*
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- base64-bytestring >= 1.0 && < 1.3
|
- base64-bytestring >= 1.0 && < 1.3
|
||||||
- bytestring == 0.11.*
|
- bytestring == 0.10.*
|
||||||
- composition == 1.0.*
|
- composition == 1.0.*
|
||||||
- constraints >= 0.12 && < 0.14
|
- constraints >= 0.12 && < 0.14
|
||||||
- containers == 0.6.*
|
- containers == 0.6.*
|
||||||
- cryptonite == 0.30.*
|
- cryptonite >= 0.27 && < 0.30
|
||||||
- directory == 1.3.*
|
- directory == 1.3.*
|
||||||
- direct-sqlcipher == 2.3.*
|
- direct-sqlcipher == 2.3.*
|
||||||
- email-validate == 2.3.*
|
- email-validate == 2.3.*
|
||||||
- exceptions == 0.10.*
|
- exceptions == 0.10.*
|
||||||
- filepath == 1.4.*
|
- filepath == 1.4.*
|
||||||
- http-types == 0.12.*
|
- http-types == 0.12.*
|
||||||
- memory == 0.18.*
|
- memory == 0.15.*
|
||||||
- mtl == 2.3.*
|
- mtl == 2.2.*
|
||||||
- network >= 3.1.2.7 && < 3.2
|
- network >= 3.1.2.7 && < 3.2
|
||||||
- optparse-applicative >= 0.15 && < 0.17
|
- optparse-applicative >= 0.15 && < 0.17
|
||||||
- process == 1.6.*
|
- process == 1.6.*
|
||||||
|
@ -42,13 +42,13 @@ dependencies:
|
||||||
- socks == 0.6.*
|
- socks == 0.6.*
|
||||||
- sqlcipher-simple == 0.4.*
|
- sqlcipher-simple == 0.4.*
|
||||||
- stm == 2.5.*
|
- stm == 2.5.*
|
||||||
- template-haskell == 2.20.*
|
- template-haskell == 2.16.*
|
||||||
- terminal == 0.2.*
|
- terminal == 0.2.*
|
||||||
- text == 2.0.*
|
- text == 1.2.*
|
||||||
- time == 1.9.*
|
- time == 1.9.*
|
||||||
- unliftio == 0.2.*
|
- unliftio == 0.2.*
|
||||||
- unliftio-core == 0.2.*
|
- unliftio-core == 0.2.*
|
||||||
- zip == 2.0.*
|
- zip == 1.7.*
|
||||||
|
|
||||||
flags:
|
flags:
|
||||||
swift:
|
swift:
|
||||||
|
@ -118,7 +118,7 @@ tests:
|
||||||
- simplex-chat
|
- simplex-chat
|
||||||
- async == 2.2.*
|
- async == 2.2.*
|
||||||
- deepseq == 1.4.*
|
- deepseq == 1.4.*
|
||||||
- hspec == 2.11.*
|
- hspec == 2.7.*
|
||||||
- network == 3.1.*
|
- network == 3.1.*
|
||||||
- silently == 1.2.*
|
- silently == 1.2.*
|
||||||
- stm == 2.5.*
|
- stm == 2.5.*
|
||||||
|
|
|
@ -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
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
set -e
|
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.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.signing.keychain=/tmp/simplex.keychain" >> apps/multiplatform/local.properties
|
||||||
echo "desktop.mac.notarization.apple_id=$APPLE_SIMPLEX_NOTARIZATION_APPLE_ID" >> 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 "desktop.mac.notarization.team_id=5NN7GUYB6T" >> apps/multiplatform/local.properties
|
||||||
echo "$APPLE_SIMPLEX_SIGNING_KEYCHAIN" | base64 --decode - > /tmp/simplex.keychain
|
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
|
scripts/desktop/build-lib-mac.sh
|
||||||
cd apps/multiplatform
|
cd apps/multiplatform
|
||||||
./gradlew packageDmg
|
./gradlew packageDmg
|
|
@ -2,12 +2,12 @@
|
||||||
|
|
||||||
OS=linux
|
OS=linux
|
||||||
ARCH=${1:-`uname -a | rev | cut -d' ' -f2 | rev`}
|
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-*
|
BUILD_DIR=dist-newstyle/build/$ARCH-$OS/ghc-${GHC_VERSION}/simplex-chat-*
|
||||||
|
|
||||||
rm -rf $BUILD_DIR
|
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
|
cd $BUILD_DIR/build
|
||||||
#patchelf --add-needed libHSrts_thr-ghc${GHC_VERSION}.so libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so
|
#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
|
#patchelf --add-rpath '$ORIGIN' libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so
|
||||||
|
|
|
@ -2,12 +2,9 @@
|
||||||
|
|
||||||
OS=mac
|
OS=mac
|
||||||
ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}"
|
ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}"
|
||||||
GHC_VERSION=9.6.2
|
|
||||||
|
|
||||||
if [ "$ARCH" == "arm64" ]; then
|
if [ "$ARCH" == "arm64" ]; then
|
||||||
ARCH=aarch64
|
ARCH=aarch64
|
||||||
fi
|
fi
|
||||||
|
|
||||||
LIB_EXT=dylib
|
LIB_EXT=dylib
|
||||||
LIB=libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT
|
LIB=libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT
|
||||||
GHC_LIBS_DIR=$(ghc --print-libdir)
|
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-*
|
BUILD_DIR=dist-newstyle/build/$ARCH-*/ghc-*/simplex-chat-*
|
||||||
|
|
||||||
rm -rf $BUILD_DIR
|
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
|
cd $BUILD_DIR/build
|
||||||
mkdir deps 2> /dev/null
|
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
|
# 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
|
cp $GHC_LIBS_DIR/rts/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`
|
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`
|
RPATHS=`otool -l $LIB | grep "path "| cut -d' ' -f11`
|
||||||
|
@ -75,13 +59,11 @@ function copy_deps() {
|
||||||
}
|
}
|
||||||
|
|
||||||
copy_deps $LIB
|
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`
|
rm deps/`basename $LIB`
|
||||||
|
|
||||||
if [ -e deps/libHSdrct-*.$LIB_EXT ]; then
|
if [ -e deps/libHSdrct-*.$LIB_EXT ]; then
|
||||||
LIBCRYPTO_PATH=$(otool -l deps/libHSdrct-*.$LIB_EXT | grep libcrypto | cut -d' ' -f11)
|
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
|
cp $LIBCRYPTO_PATH deps/libcrypto.1.1.$LIB_EXT
|
||||||
chmod 755 deps/libcrypto.1.1.$LIB_EXT
|
chmod 755 deps/libcrypto.1.1.$LIB_EXT
|
||||||
fi
|
fi
|
||||||
|
|
|
@ -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/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||||
"https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
|
"https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
|
||||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
|
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
|
||||||
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
|
"https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";
|
||||||
"https://github.com/simplex-chat/aeson.git"."68330dce8208173c6acf5f62b23acb500ab5d873" = "1l51p1v54c88c1jmxcvbz4gy0cns7l46ihzzfjwxxrvcrrrxgcjp";
|
"https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
|
||||||
"https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
|
"https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
|
||||||
"https://github.com/simplex-chat/android-support.git"."9aa09f148089d6752ce563b14c2df1895718d806" = "0pbf2pf13v2kjzi397nr13f1h3jv0imvsq8rpiyy2qyx5vd50pqn";
|
"https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";
|
||||||
"https://github.com/simplex-chat/network-transport.git"."0013798272a683e35ca38d2fdaf480942311fba8" = "0dnn62apgvc248df0m8ib7phrzn63wm0xs71xvlypv52j6cgwzkb";
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -145,25 +145,25 @@ library
|
||||||
src
|
src
|
||||||
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network >=3.1.2.7 && <3.2
|
, network >=3.1.2.7 && <3.2
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -174,13 +174,13 @@ library
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
@ -193,25 +193,25 @@ executable simplex-bot
|
||||||
apps/simplex-bot
|
apps/simplex-bot
|
||||||
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network >=3.1.2.7 && <3.2
|
, network >=3.1.2.7 && <3.2
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -223,13 +223,13 @@ executable simplex-bot
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
@ -242,25 +242,25 @@ executable simplex-bot-advanced
|
||||||
apps/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
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network >=3.1.2.7 && <3.2
|
, network >=3.1.2.7 && <3.2
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -272,13 +272,13 @@ executable simplex-bot-advanced
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
@ -293,25 +293,25 @@ executable simplex-broadcast-bot
|
||||||
apps/simplex-broadcast-bot/src
|
apps/simplex-broadcast-bot/src
|
||||||
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network >=3.1.2.7 && <3.2
|
, network >=3.1.2.7 && <3.2
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -323,13 +323,13 @@ executable simplex-broadcast-bot
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
@ -343,25 +343,25 @@ executable simplex-chat
|
||||||
apps/simplex-chat
|
apps/simplex-chat
|
||||||
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network ==3.1.*
|
, network ==3.1.*
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -373,14 +373,14 @@ executable simplex-chat
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, websockets ==0.12.*
|
, websockets ==0.12.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
@ -397,25 +397,25 @@ executable simplex-directory-service
|
||||||
apps/simplex-directory-service/src
|
apps/simplex-directory-service/src
|
||||||
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network >=3.1.2.7 && <3.2
|
, network >=3.1.2.7 && <3.2
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -427,13 +427,13 @@ executable simplex-directory-service
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
@ -470,27 +470,27 @@ test-suite simplex-chat-test
|
||||||
apps/simplex-directory-service/src
|
apps/simplex-directory-service/src
|
||||||
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson ==2.2.*
|
aeson ==2.0.*
|
||||||
, ansi-terminal >=0.10 && <0.12
|
, ansi-terminal >=0.10 && <0.12
|
||||||
, async ==2.2.*
|
, async ==2.2.*
|
||||||
, attoparsec ==0.14.*
|
, attoparsec ==0.14.*
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, base64-bytestring >=1.0 && <1.3
|
, base64-bytestring >=1.0 && <1.3
|
||||||
, bytestring ==0.11.*
|
, bytestring ==0.10.*
|
||||||
, composition ==1.0.*
|
, composition ==1.0.*
|
||||||
, constraints >=0.12 && <0.14
|
, constraints >=0.12 && <0.14
|
||||||
, containers ==0.6.*
|
, containers ==0.6.*
|
||||||
, cryptonite ==0.30.*
|
, cryptonite >=0.27 && <0.30
|
||||||
, deepseq ==1.4.*
|
, deepseq ==1.4.*
|
||||||
, direct-sqlcipher ==2.3.*
|
, direct-sqlcipher ==2.3.*
|
||||||
, directory ==1.3.*
|
, directory ==1.3.*
|
||||||
, email-validate ==2.3.*
|
, email-validate ==2.3.*
|
||||||
, exceptions ==0.10.*
|
, exceptions ==0.10.*
|
||||||
, filepath ==1.4.*
|
, filepath ==1.4.*
|
||||||
, hspec ==2.11.*
|
, hspec ==2.7.*
|
||||||
, http-types ==0.12.*
|
, http-types ==0.12.*
|
||||||
, memory ==0.18.*
|
, memory ==0.15.*
|
||||||
, mtl ==2.3.*
|
, mtl ==2.2.*
|
||||||
, network ==3.1.*
|
, network ==3.1.*
|
||||||
, optparse-applicative >=0.15 && <0.17
|
, optparse-applicative >=0.15 && <0.17
|
||||||
, process ==1.6.*
|
, process ==1.6.*
|
||||||
|
@ -503,13 +503,13 @@ test-suite simplex-chat-test
|
||||||
, socks ==0.6.*
|
, socks ==0.6.*
|
||||||
, sqlcipher-simple ==0.4.*
|
, sqlcipher-simple ==0.4.*
|
||||||
, stm ==2.5.*
|
, stm ==2.5.*
|
||||||
, template-haskell ==2.20.*
|
, template-haskell ==2.16.*
|
||||||
, terminal ==0.2.*
|
, terminal ==0.2.*
|
||||||
, text ==2.0.*
|
, text ==1.2.*
|
||||||
, time ==1.9.*
|
, time ==1.9.*
|
||||||
, unliftio ==0.2.*
|
, unliftio ==0.2.*
|
||||||
, unliftio-core ==0.2.*
|
, unliftio-core ==0.2.*
|
||||||
, zip ==2.0.*
|
, zip ==1.7.*
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
if flag(swift)
|
if flag(swift)
|
||||||
cpp-options: -DswiftJSON
|
cpp-options: -DswiftJSON
|
||||||
|
|
|
@ -5,7 +5,6 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
@ -13,15 +12,12 @@
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat where
|
module Simplex.Chat where
|
||||||
|
|
||||||
import Control.Applicative (optional, (<|>))
|
import Control.Applicative (optional, (<|>))
|
||||||
import Control.Concurrent.STM (retry)
|
import Control.Concurrent.STM (retry, stateTVar)
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
import Control.Logger.Simple
|
import Control.Logger.Simple
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Unlift
|
import Control.Monad.IO.Unlift
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
@ -217,8 +213,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
||||||
where
|
where
|
||||||
configServers :: DefaultAgentServers
|
configServers :: DefaultAgentServers
|
||||||
configServers =
|
configServers =
|
||||||
let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers)
|
let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers)
|
||||||
xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers)
|
xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers)
|
||||||
in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig}
|
in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig}
|
||||||
agentServers :: ChatConfig -> IO InitialAgentServers
|
agentServers :: ChatConfig -> IO InitialAgentServers
|
||||||
agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
|
agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
|
||||||
|
@ -245,9 +241,9 @@ activeAgentServers ChatConfig {defaultServers} p =
|
||||||
. filter (\ServerCfg {enabled} -> enabled)
|
. filter (\ServerCfg {enabled} -> enabled)
|
||||||
|
|
||||||
cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p))
|
cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p))
|
||||||
cfgServers p s = case p of
|
cfgServers = \case
|
||||||
SPSMP -> s.smp
|
SPSMP -> smp
|
||||||
SPXFTP -> s.xftp
|
SPXFTP -> xftp
|
||||||
|
|
||||||
startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ())
|
startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ())
|
||||||
startChatController subConns enableExpireCIs startXFTPWorkers = do
|
startChatController subConns enableExpireCIs startXFTPWorkers = do
|
||||||
|
@ -703,9 +699,7 @@ processChatCommand = \case
|
||||||
MCVoice {} -> False
|
MCVoice {} -> False
|
||||||
MCUnknown {} -> True
|
MCUnknown {} -> True
|
||||||
qText = msgContentText qmc
|
qText = msgContentText qmc
|
||||||
getFileName :: CIFile d -> String
|
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
|
||||||
getFileName CIFile{fileName} = fileName
|
|
||||||
qFileName = maybe qText (T.pack . getFileName) ciFile_
|
|
||||||
qTextOrFile = if T.null qText then qFileName else qText
|
qTextOrFile = if T.null qText then qFileName else qText
|
||||||
xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
|
xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
|
||||||
xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
|
xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
|
||||||
|
@ -918,7 +912,7 @@ processChatCommand = \case
|
||||||
pure $ CRContactConnectionDeleted user conn
|
pure $ CRContactConnectionDeleted user conn
|
||||||
CTGroup -> do
|
CTGroup -> do
|
||||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user chatId
|
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)
|
canDelete = isOwner || not (memberCurrent membership)
|
||||||
unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner
|
unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner
|
||||||
filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo
|
filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo
|
||||||
|
@ -1095,9 +1089,7 @@ processChatCommand = \case
|
||||||
APIGetNtfMessage nonce encNtfInfo -> withUser $ \_ -> do
|
APIGetNtfMessage nonce encNtfInfo -> withUser $ \_ -> do
|
||||||
(NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo
|
(NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo
|
||||||
let ntfMessages = map (\SMP.SMPMsgMeta {msgTs, msgFlags} -> NtfMsgInfo {msgTs = systemToUTCTime msgTs, msgFlags}) msgs
|
let ntfMessages = map (\SMP.SMPMsgMeta {msgTs, msgFlags} -> NtfMsgInfo {msgTs = systemToUTCTime msgTs, msgFlags}) msgs
|
||||||
getMsgTs :: SMP.NMsgMeta -> SystemTime
|
msgTs' = systemToUTCTime . (SMP.msgTs :: SMP.NMsgMeta -> SystemTime) <$> ntfMsgMeta
|
||||||
getMsgTs SMP.NMsgMeta{msgTs} = msgTs
|
|
||||||
msgTs' = systemToUTCTime . getMsgTs <$> ntfMsgMeta
|
|
||||||
agentConnId = AgentConnId ntfConnId
|
agentConnId = AgentConnId ntfConnId
|
||||||
user_ <- withStore' (`getUserByAConnId` agentConnId)
|
user_ <- withStore' (`getUserByAConnId` agentConnId)
|
||||||
connEntity <-
|
connEntity <-
|
||||||
|
@ -1504,7 +1496,7 @@ processChatCommand = \case
|
||||||
Contact {activeConn = Connection {peerChatVRange}} = ct
|
Contact {activeConn = Connection {peerChatVRange}} = ct
|
||||||
withChatLock "joinGroup" . procCmd $ do
|
withChatLock "joinGroup" . procCmd $ do
|
||||||
subMode <- chatReadVar subscriptionMode
|
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
|
agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode
|
||||||
withStore' $ \db -> do
|
withStore' $ \db -> do
|
||||||
createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode
|
createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode
|
||||||
|
@ -1658,7 +1650,7 @@ processChatCommand = \case
|
||||||
case memberConn m of
|
case memberConn m of
|
||||||
Just mConn -> do
|
Just mConn -> do
|
||||||
let msg = XGrpDirectInv cReq msgContent_
|
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
|
withStore' $ \db -> setContactGrpInvSent db ct True
|
||||||
let ct' = ct {contactGrpInvSent = True}
|
let ct' = ct {contactGrpInvSent = True}
|
||||||
forM_ msgContent_ $ \mc -> do
|
forM_ msgContent_ $ \mc -> do
|
||||||
|
@ -2022,7 +2014,7 @@ processChatCommand = \case
|
||||||
pure $ CRGroupUpdated user g g' Nothing
|
pure $ CRGroupUpdated user g g' Nothing
|
||||||
assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m ()
|
assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m ()
|
||||||
assertUserGroupRole g@GroupInfo {membership} requiredRole = do
|
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 (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
|
||||||
when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
|
when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
|
||||||
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
|
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
|
||||||
|
@ -2040,7 +2032,7 @@ processChatCommand = \case
|
||||||
runUpdateGroupProfile user g $ update p
|
runUpdateGroupProfile user g $ update p
|
||||||
isReady :: Contact -> Bool
|
isReady :: Contact -> Bool
|
||||||
isReady ct =
|
isReady ct =
|
||||||
let s = connStatus $ ct.activeConn
|
let s = connStatus $ activeConn (ct :: Contact)
|
||||||
in s == ConnReady || s == ConnSndReady
|
in s == ConnReady || s == ConnSndReady
|
||||||
withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
|
withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
|
||||||
withCurrentCall ctId action = do
|
withCurrentCall ctId action = do
|
||||||
|
@ -3222,7 +3214,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||||
| sameMemberId memId m -> do
|
| sameMemberId memId m -> do
|
||||||
-- TODO update member profile
|
-- TODO update member profile
|
||||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
-- [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"
|
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
|
||||||
_ -> messageError "CONF from member must have x.grp.mem.info"
|
_ -> messageError "CONF from member must have x.grp.mem.info"
|
||||||
INFO connInfo -> do
|
INFO connInfo -> do
|
||||||
|
@ -3261,7 +3253,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||||
toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
|
toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
|
||||||
whenGroupNtfs user gInfo $ do
|
whenGroupNtfs user gInfo $ do
|
||||||
setActive $ ActiveG gName
|
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
|
intros <- withStore' $ \db -> createIntroductions db members m
|
||||||
void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
|
void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
|
||||||
forM_ intros $ \intro ->
|
forM_ intros $ \intro ->
|
||||||
|
@ -3321,9 +3313,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||||
&& hasDeliveryReceipt (toCMEventTag event)
|
&& hasDeliveryReceipt (toCMEventTag event)
|
||||||
&& currentMemCount <= smallGroupsRcptsMemLimit
|
&& currentMemCount <= smallGroupsRcptsMemLimit
|
||||||
where
|
where
|
||||||
canSend :: GroupMember -> m () -> m ()
|
|
||||||
canSend mem a
|
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
|
| otherwise = a
|
||||||
RCVD msgMeta msgRcpt ->
|
RCVD msgMeta msgRcpt ->
|
||||||
withAckMessage' agentConnId conn msgMeta $
|
withAckMessage' agentConnId conn msgMeta $
|
||||||
|
@ -4520,7 +4511,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||||
withStore' $ \db -> saveMemberInvitation db toMember introInv
|
withStore' $ \db -> saveMemberInvitation db toMember introInv
|
||||||
subMode <- chatReadVar subscriptionMode
|
subMode <- chatReadVar subscriptionMode
|
||||||
-- [incognito] send membership incognito profile, create direct connection as incognito
|
-- [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
|
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
|
||||||
groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode
|
groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode
|
||||||
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr 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 :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> MsgMeta -> m ()
|
||||||
xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg msgMeta
|
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}}
|
let gInfo' = gInfo {membership = membership {memberRole = memRole}}
|
||||||
in changeMemberRole gInfo' membership $ RGEUserRole memRole
|
in changeMemberRole gInfo' membership $ RGEUserRole memRole
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
|
@ -4554,7 +4545,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||||
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m ()
|
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m ()
|
||||||
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg msgMeta = do
|
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg msgMeta = do
|
||||||
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
||||||
if membership.memberId == memId
|
if memberId (membership :: GroupMember) == memId
|
||||||
then checkRole membership $ do
|
then checkRole membership $ do
|
||||||
deleteGroupLinkIfExists user gInfo
|
deleteGroupLinkIfExists user gInfo
|
||||||
-- member records are not deleted to keep history
|
-- member records are not deleted to keep history
|
||||||
|
@ -4796,7 +4787,7 @@ parseFileChunk :: ChatMonad m => ByteString -> m FileChunk
|
||||||
parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode
|
parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode
|
||||||
|
|
||||||
appendFileChunk :: forall m. ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> Bool -> m ()
|
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
|
case fileStatus of
|
||||||
RFSConnected RcvFileInfo {filePath} -> append_ filePath
|
RFSConnected RcvFileInfo {filePath} -> append_ filePath
|
||||||
-- sometimes update of file transfer status to FSConnected
|
-- sometimes update of file transfer status to FSConnected
|
||||||
|
@ -4814,7 +4805,7 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs} chunkNo chun
|
||||||
when final $ do
|
when final $ do
|
||||||
closeFileHandle fileId rcvFiles
|
closeFileHandle fileId rcvFiles
|
||||||
forM_ cryptoArgs $ \cfArgs -> do
|
forM_ cryptoArgs $ \cfArgs -> do
|
||||||
tmpFile <- getChatTempDirectory >>= (`uniqueCombine` ft.fileInvitation.fileName)
|
tmpFile <- getChatTempDirectory >>= (`uniqueCombine` fileName (fileInvitation :: FileInvitation))
|
||||||
tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
|
tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
|
||||||
Right () -> do
|
Right () -> do
|
||||||
removeFile fsFilePath `catchChatError` \_ -> pure ()
|
removeFile fsFilePath `catchChatError` \_ -> pure ()
|
||||||
|
@ -5153,7 +5144,7 @@ createSndFeatureItems :: forall m. ChatMonad m => User -> Contact -> Contact ->
|
||||||
createSndFeatureItems user ct ct' =
|
createSndFeatureItems user ct ct' =
|
||||||
createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref
|
createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref
|
||||||
where
|
where
|
||||||
getPref u = (userPreference u).preference
|
getPref = (preference :: ContactUserPref (FeaturePreference f) -> FeaturePreference f) . userPreference
|
||||||
|
|
||||||
type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d
|
type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d
|
||||||
|
|
||||||
|
@ -5238,7 +5229,7 @@ getCreateActiveUser st testView = do
|
||||||
Right user -> pure user
|
Right user -> pure user
|
||||||
selectUser :: [User] -> IO User
|
selectUser :: [User] -> IO User
|
||||||
selectUser [user] = do
|
selectUser [user] = do
|
||||||
withTransaction st (`setActiveUser` user.userId)
|
withTransaction st (`setActiveUser` userId (user :: User))
|
||||||
pure user
|
pure user
|
||||||
selectUser users = do
|
selectUser users = do
|
||||||
putStrLn "Select user profile:"
|
putStrLn "Select user profile:"
|
||||||
|
@ -5253,7 +5244,7 @@ getCreateActiveUser st testView = do
|
||||||
| n <= 0 || n > length users -> putStrLn "invalid user number" >> loop
|
| n <= 0 || n > length users -> putStrLn "invalid user number" >> loop
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
let user = users !! (n - 1)
|
let user = users !! (n - 1)
|
||||||
withTransaction st (`setActiveUser` user.userId)
|
withTransaction st (`setActiveUser` userId (user :: User))
|
||||||
pure user
|
pure user
|
||||||
userStr :: User -> String
|
userStr :: User -> String
|
||||||
userStr User {localDisplayName, profile = LocalProfile {fullName}} =
|
userStr User {localDisplayName, profile = LocalProfile {fullName}} =
|
||||||
|
|
|
@ -13,7 +13,6 @@ module Simplex.Chat.Archive
|
||||||
where
|
where
|
||||||
|
|
||||||
import qualified Codec.Archive.Zip as Z
|
import qualified Codec.Archive.Zip as Z
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Functor (($>))
|
import Data.Functor (($>))
|
||||||
|
|
|
@ -8,7 +8,7 @@ module Simplex.Chat.Bot where
|
||||||
|
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Monad
|
import Control.Monad.Reader
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Simplex.Chat.Controller
|
import Simplex.Chat.Controller
|
||||||
|
|
|
@ -6,14 +6,11 @@
|
||||||
{-# LANGUAGE KindSignatures #-}
|
{-# LANGUAGE KindSignatures #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Messages where
|
module Simplex.Chat.Messages where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
|
@ -376,7 +373,7 @@ contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessag
|
||||||
| forUser enabled && forContact enabled = Just ttl
|
| forUser enabled && forContact enabled = Just ttl
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where
|
where
|
||||||
TimedMessagesPreference {ttl} = userPreference.preference
|
TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference)
|
||||||
|
|
||||||
groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
|
groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
|
||||||
groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
|
groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
|
||||||
|
|
|
@ -16,9 +16,7 @@ module Simplex.Chat.Mobile.File
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Data.Aeson (ToJSON)
|
import Data.Aeson (ToJSON)
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
|
|
|
@ -16,12 +16,12 @@ type JSONByteString = LB.ByteString
|
||||||
getByteString :: Ptr Word8 -> CInt -> IO ByteString
|
getByteString :: Ptr Word8 -> CInt -> IO ByteString
|
||||||
getByteString ptr len = do
|
getByteString ptr len = do
|
||||||
fp <- newForeignPtr_ ptr
|
fp <- newForeignPtr_ ptr
|
||||||
pure $ BS fp $ fromIntegral len
|
pure $ PS fp 0 $ fromIntegral len
|
||||||
{-# INLINE getByteString #-}
|
{-# INLINE getByteString #-}
|
||||||
|
|
||||||
putByteString :: Ptr Word8 -> ByteString -> IO ()
|
putByteString :: Ptr Word8 -> ByteString -> IO ()
|
||||||
putByteString ptr (BS fp len) =
|
putByteString ptr (PS fp offset len) =
|
||||||
withForeignPtr fp $ \p -> memcpy ptr p len
|
withForeignPtr fp $ \p -> memcpy ptr (p `plusPtr` offset) len
|
||||||
{-# INLINE putByteString #-}
|
{-# INLINE putByteString #-}
|
||||||
|
|
||||||
putLazyByteString :: Ptr Word8 -> LB.ByteString -> IO ()
|
putLazyByteString :: Ptr Word8 -> LB.ByteString -> IO ()
|
||||||
|
|
|
@ -8,9 +8,7 @@ module Simplex.Chat.Mobile.WebRTC (
|
||||||
reservedSize,
|
reservedSize,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import qualified Crypto.Cipher.Types as AES
|
import qualified Crypto.Cipher.Types as AES
|
||||||
import Data.Bifunctor (bimap)
|
import Data.Bifunctor (bimap)
|
||||||
import qualified Data.ByteArray as BA
|
import qualified Data.ByteArray as BA
|
||||||
|
|
|
@ -13,8 +13,6 @@
|
||||||
{-# LANGUAGE StrictData #-}
|
{-# LANGUAGE StrictData #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Protocol where
|
module Simplex.Chat.Protocol where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
|
|
|
@ -5,8 +5,6 @@
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Store.Connections
|
module Simplex.Chat.Store.Connections
|
||||||
( getConnectionEntity,
|
( getConnectionEntity,
|
||||||
getConnectionsToSubscribe,
|
getConnectionsToSubscribe,
|
||||||
|
@ -15,7 +13,6 @@ module Simplex.Chat.Store.Connections
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
import Data.Maybe (catMaybes, fromMaybe)
|
import Data.Maybe (catMaybes, fromMaybe)
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
@ -8,8 +7,6 @@
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Store.Direct
|
module Simplex.Chat.Store.Direct
|
||||||
( updateContact_,
|
( updateContact_,
|
||||||
updateContactProfile_,
|
updateContactProfile_,
|
||||||
|
@ -64,9 +61,7 @@ module Simplex.Chat.Store.Direct
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Data.Either (rights)
|
import Data.Either (rights)
|
||||||
import Data.Functor (($>))
|
import Data.Functor (($>))
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
|
@ -461,7 +456,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||||
ExceptT $
|
ExceptT $
|
||||||
maybeM getContactRequestByXContactId xContactId_ >>= \case
|
maybeM getContactRequestByXContactId xContactId_ >>= \case
|
||||||
Nothing -> createContactRequest
|
Nothing -> createContactRequest
|
||||||
Just cr -> updateContactRequest cr $> Right cr.contactRequestId
|
Just cr -> updateContactRequest cr $> Right (contactRequestId (cr :: UserContactRequest))
|
||||||
getContactRequest db user cReqId
|
getContactRequest db user cReqId
|
||||||
createContactRequest :: IO (Either StoreError Int64)
|
createContactRequest :: IO (Either StoreError Int64)
|
||||||
createContactRequest = do
|
createContactRequest = do
|
||||||
|
|
|
@ -76,9 +76,7 @@ module Simplex.Chat.Store.Files
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Data.Either (rights)
|
import Data.Either (rights)
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
import Data.Maybe (fromMaybe, isJust, listToMaybe)
|
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
|
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
|
||||||
currentTs <- liftIO getCurrentTime
|
currentTs <- liftIO getCurrentTime
|
||||||
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
|
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
|
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
|
||||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
||||||
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
|
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
|
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
|
||||||
currentTs <- liftIO getCurrentTime
|
currentTs <- liftIO getCurrentTime
|
||||||
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
|
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
|
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
|
||||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
||||||
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
|
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
|
||||||
|
|
|
@ -8,9 +8,6 @@
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Store.Groups
|
module Simplex.Chat.Store.Groups
|
||||||
( -- * Util methods
|
( -- * Util methods
|
||||||
|
@ -98,9 +95,7 @@ module Simplex.Chat.Store.Groups
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Crypto.Random (ChaChaDRG)
|
import Crypto.Random (ChaChaDRG)
|
||||||
import Data.Either (rights)
|
import Data.Either (rights)
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
|
@ -890,7 +885,7 @@ saveIntroInvitation db reMember toMember introInv = do
|
||||||
WHERE group_member_intro_id = :intro_id
|
WHERE group_member_intro_id = :intro_id
|
||||||
|]
|
|]
|
||||||
[ ":intro_status" := GMIntroInvReceived,
|
[ ":intro_status" := GMIntroInvReceived,
|
||||||
":group_queue_info" := introInv.groupConnReq,
|
":group_queue_info" := groupConnReq (introInv :: IntroInvitation),
|
||||||
":direct_queue_info" := directConnReq introInv,
|
":direct_queue_info" := directConnReq introInv,
|
||||||
":updated_at" := currentTs,
|
":updated_at" := currentTs,
|
||||||
":intro_id" := introId intro
|
":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.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
|
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
|
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
|
currentTs <- liftIO getCurrentTime
|
||||||
newMember <- case directConnIds of
|
newMember <- case directConnIds of
|
||||||
Just (directCmdId, directAgentConnId) -> do
|
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.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
|
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
|
currentTs <- getCurrentTime
|
||||||
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode
|
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode
|
||||||
setCommandConnId db user groupCmdId groupConnId
|
setCommandConnId db user groupCmdId groupConnId
|
||||||
|
|
|
@ -10,8 +10,6 @@
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Store.Messages
|
module Simplex.Chat.Store.Messages
|
||||||
( getContactConnIds_,
|
( getContactConnIds_,
|
||||||
getDirectChatReactions_,
|
getDirectChatReactions_,
|
||||||
|
@ -98,9 +96,7 @@ module Simplex.Chat.Store.Messages
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Crypto.Random (ChaChaDRG)
|
import Crypto.Random (ChaChaDRG)
|
||||||
import Data.Bifunctor (first)
|
import Data.Bifunctor (first)
|
||||||
import Data.ByteString.Char8 (ByteString)
|
import Data.ByteString.Char8 (ByteString)
|
||||||
|
|
|
@ -7,8 +7,6 @@
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.Store.Profiles
|
module Simplex.Chat.Store.Profiles
|
||||||
( AutoAccept (..),
|
( AutoAccept (..),
|
||||||
UserMsgReceiptSettings (..),
|
UserMsgReceiptSettings (..),
|
||||||
|
@ -56,9 +54,7 @@ module Simplex.Chat.Store.Profiles
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Data.Aeson (ToJSON)
|
import Data.Aeson (ToJSON)
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
import Data.Functor (($>))
|
import Data.Functor (($>))
|
||||||
|
@ -294,7 +290,7 @@ getUserContactProfiles db User {userId} =
|
||||||
|]
|
|]
|
||||||
(Only userId)
|
(Only userId)
|
||||||
where
|
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}
|
toContactProfile (displayName, fullName, image, contactLink, preferences) = Profile {displayName, fullName, image, contactLink, preferences}
|
||||||
|
|
||||||
createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> SubscriptionMode -> ExceptT StoreError IO ()
|
createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||||
|
|
|
@ -10,11 +10,10 @@
|
||||||
|
|
||||||
module Simplex.Chat.Store.Shared where
|
module Simplex.Chat.Store.Shared where
|
||||||
|
|
||||||
|
import Control.Concurrent.STM (stateTVar)
|
||||||
import Control.Exception (Exception)
|
import Control.Exception (Exception)
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Crypto.Random (ChaChaDRG, randomBytesGenerate)
|
import Crypto.Random (ChaChaDRG, randomBytesGenerate)
|
||||||
import Data.Aeson (ToJSON)
|
import Data.Aeson (ToJSON)
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
module Simplex.Chat.Terminal where
|
module Simplex.Chat.Terminal where
|
||||||
|
|
||||||
import Control.Exception (handle, throwIO)
|
import Control.Exception (handle, throwIO)
|
||||||
import Control.Monad
|
import Control.Monad.Except
|
||||||
import qualified Data.List.NonEmpty as L
|
import qualified Data.List.NonEmpty as L
|
||||||
import Database.SQLite.Simple (SQLError (..))
|
import Database.SQLite.Simple (SQLError (..))
|
||||||
import qualified Database.SQLite.Simple as DB
|
import qualified Database.SQLite.Simple as DB
|
||||||
|
|
|
@ -12,7 +12,6 @@ module Simplex.Chat.Terminal.Input where
|
||||||
|
|
||||||
import Control.Applicative (optional, (<|>))
|
import Control.Applicative (optional, (<|>))
|
||||||
import Control.Concurrent (forkFinally, forkIO, killThread, mkWeakThreadId, threadDelay)
|
import Control.Concurrent (forkFinally, forkIO, killThread, mkWeakThreadId, threadDelay)
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||||
|
|
|
@ -9,7 +9,6 @@
|
||||||
module Simplex.Chat.Terminal.Output where
|
module Simplex.Chat.Terminal.Output where
|
||||||
|
|
||||||
import Control.Concurrent (ThreadId)
|
import Control.Concurrent (ThreadId)
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Catch (MonadMask)
|
import Control.Monad.Catch (MonadMask)
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
|
|
@ -16,8 +16,6 @@
|
||||||
{-# LANGUAGE StrictData #-}
|
{-# LANGUAGE StrictData #-}
|
||||||
{-# LANGUAGE TypeFamilyDependencies #-}
|
{-# LANGUAGE TypeFamilyDependencies #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
|
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
{-# HLINT ignore "Use newtype instead of data" #-}
|
{-# HLINT ignore "Use newtype instead of data" #-}
|
||||||
|
@ -58,21 +56,21 @@ class IsContact a where
|
||||||
preferences' :: a -> Maybe Preferences
|
preferences' :: a -> Maybe Preferences
|
||||||
|
|
||||||
instance IsContact User where
|
instance IsContact User where
|
||||||
contactId' u = u.userContactId
|
contactId' = userContactId
|
||||||
{-# INLINE contactId' #-}
|
{-# INLINE contactId' #-}
|
||||||
profile' u = u.profile
|
profile' = profile
|
||||||
{-# INLINE profile' #-}
|
{-# INLINE profile' #-}
|
||||||
localDisplayName' u = u.localDisplayName
|
localDisplayName' = localDisplayName
|
||||||
{-# INLINE localDisplayName' #-}
|
{-# INLINE localDisplayName' #-}
|
||||||
preferences' User {profile = LocalProfile {preferences}} = preferences
|
preferences' User {profile = LocalProfile {preferences}} = preferences
|
||||||
{-# INLINE preferences' #-}
|
{-# INLINE preferences' #-}
|
||||||
|
|
||||||
instance IsContact Contact where
|
instance IsContact Contact where
|
||||||
contactId' c = c.contactId
|
contactId' = contactId
|
||||||
{-# INLINE contactId' #-}
|
{-# INLINE contactId' #-}
|
||||||
profile' c = c.profile
|
profile' = profile
|
||||||
{-# INLINE profile' #-}
|
{-# INLINE profile' #-}
|
||||||
localDisplayName' c = c.localDisplayName
|
localDisplayName' = localDisplayName
|
||||||
{-# INLINE localDisplayName' #-}
|
{-# INLINE localDisplayName' #-}
|
||||||
preferences' Contact {profile = LocalProfile {preferences}} = preferences
|
preferences' Contact {profile = LocalProfile {preferences}} = preferences
|
||||||
{-# INLINE preferences' #-}
|
{-# INLINE preferences' #-}
|
||||||
|
@ -185,7 +183,7 @@ instance ToJSON Contact where
|
||||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
contactConn :: Contact -> Connection
|
contactConn :: Contact -> Connection
|
||||||
contactConn Contact{activeConn} = activeConn
|
contactConn = activeConn
|
||||||
|
|
||||||
contactConnId :: Contact -> ConnId
|
contactConnId :: Contact -> ConnId
|
||||||
contactConnId = aConnId . contactConn
|
contactConnId = aConnId . contactConn
|
||||||
|
@ -468,7 +466,7 @@ instance ToJSON LocalProfile where
|
||||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||||
|
|
||||||
localProfileId :: LocalProfile -> ProfileId
|
localProfileId :: LocalProfile -> ProfileId
|
||||||
localProfileId LocalProfile{profileId} = profileId
|
localProfileId = profileId
|
||||||
|
|
||||||
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
|
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
|
||||||
toLocalProfile profileId Profile {displayName, fullName, image, contactLink, preferences} localAlias =
|
toLocalProfile profileId Profile {displayName, fullName, image, contactLink, preferences} localAlias =
|
||||||
|
@ -629,7 +627,7 @@ groupMemberRef GroupMember {groupMemberId, memberProfile = p} =
|
||||||
GroupMemberRef {groupMemberId, profile = fromLocalProfile p}
|
GroupMemberRef {groupMemberId, profile = fromLocalProfile p}
|
||||||
|
|
||||||
memberConn :: GroupMember -> Maybe Connection
|
memberConn :: GroupMember -> Maybe Connection
|
||||||
memberConn GroupMember{activeConn} = activeConn
|
memberConn = activeConn
|
||||||
|
|
||||||
memberConnId :: GroupMember -> Maybe ConnId
|
memberConnId :: GroupMember -> Maybe ConnId
|
||||||
memberConnId GroupMember {activeConn} = aConnId <$> activeConn
|
memberConnId GroupMember {activeConn} = aConnId <$> activeConn
|
||||||
|
|
|
@ -8,15 +8,12 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilyDependencies #-}
|
{-# LANGUAGE TypeFamilyDependencies #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
{-# HLINT ignore "Use newtype instead of data" #-}
|
{-# HLINT ignore "Use newtype instead of data" #-}
|
||||||
|
|
||||||
|
@ -88,12 +85,12 @@ allChatFeatures =
|
||||||
]
|
]
|
||||||
|
|
||||||
chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
|
chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
|
||||||
chatPrefSel f ps = case f of
|
chatPrefSel = \case
|
||||||
SCFTimedMessages -> ps.timedMessages
|
SCFTimedMessages -> timedMessages
|
||||||
SCFFullDelete -> ps.fullDelete
|
SCFFullDelete -> fullDelete
|
||||||
SCFReactions -> ps.reactions
|
SCFReactions -> reactions
|
||||||
SCFVoice -> ps.voice
|
SCFVoice -> voice
|
||||||
SCFCalls -> ps.calls
|
SCFCalls -> calls
|
||||||
|
|
||||||
chatFeature :: SChatFeature f -> ChatFeature
|
chatFeature :: SChatFeature f -> ChatFeature
|
||||||
chatFeature = \case
|
chatFeature = \case
|
||||||
|
@ -113,12 +110,12 @@ instance PreferenceI (Maybe Preferences) where
|
||||||
getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs)
|
getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs)
|
||||||
|
|
||||||
instance PreferenceI FullPreferences where
|
instance PreferenceI FullPreferences where
|
||||||
getPreference f ps = case f of
|
getPreference = \case
|
||||||
SCFTimedMessages -> ps.timedMessages
|
SCFTimedMessages -> timedMessages
|
||||||
SCFFullDelete -> ps.fullDelete
|
SCFFullDelete -> fullDelete
|
||||||
SCFReactions -> ps.reactions
|
SCFReactions -> reactions
|
||||||
SCFVoice -> ps.voice
|
SCFVoice -> voice
|
||||||
SCFCalls -> ps.calls
|
SCFCalls -> calls
|
||||||
{-# INLINE getPreference #-}
|
{-# INLINE getPreference #-}
|
||||||
|
|
||||||
setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
|
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 :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
|
||||||
groupPrefSel f ps = case f of
|
groupPrefSel = \case
|
||||||
SGFTimedMessages -> ps.timedMessages
|
SGFTimedMessages -> timedMessages
|
||||||
SGFDirectMessages -> ps.directMessages
|
SGFDirectMessages -> directMessages
|
||||||
SGFFullDelete -> ps.fullDelete
|
SGFFullDelete -> fullDelete
|
||||||
SGFReactions -> ps.reactions
|
SGFReactions -> reactions
|
||||||
SGFVoice -> ps.voice
|
SGFVoice -> voice
|
||||||
SGFFiles -> ps.files
|
SGFFiles -> files
|
||||||
|
|
||||||
toGroupFeature :: SGroupFeature f -> GroupFeature
|
toGroupFeature :: SGroupFeature f -> GroupFeature
|
||||||
toGroupFeature = \case
|
toGroupFeature = \case
|
||||||
|
@ -245,13 +242,13 @@ instance GroupPreferenceI (Maybe GroupPreferences) where
|
||||||
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
|
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
|
||||||
|
|
||||||
instance GroupPreferenceI FullGroupPreferences where
|
instance GroupPreferenceI FullGroupPreferences where
|
||||||
getGroupPreference f ps = case f of
|
getGroupPreference = \case
|
||||||
SGFTimedMessages -> ps.timedMessages
|
SGFTimedMessages -> timedMessages
|
||||||
SGFDirectMessages -> ps.directMessages
|
SGFDirectMessages -> directMessages
|
||||||
SGFFullDelete -> ps.fullDelete
|
SGFFullDelete -> fullDelete
|
||||||
SGFReactions -> ps.reactions
|
SGFReactions -> reactions
|
||||||
SGFVoice -> ps.voice
|
SGFVoice -> voice
|
||||||
SGFFiles -> ps.files
|
SGFFiles -> files
|
||||||
{-# INLINE getGroupPreference #-}
|
{-# INLINE getGroupPreference #-}
|
||||||
|
|
||||||
-- collection of optional group preferences
|
-- collection of optional group preferences
|
||||||
|
@ -431,19 +428,19 @@ class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureA
|
||||||
prefParam :: FeaturePreference f -> Maybe Int
|
prefParam :: FeaturePreference f -> Maybe Int
|
||||||
|
|
||||||
instance HasField "allow" TimedMessagesPreference FeatureAllowed where
|
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
|
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
|
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
|
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
|
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
|
instance FeatureI 'CFTimedMessages where
|
||||||
type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
|
type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
|
||||||
|
@ -520,25 +517,25 @@ class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference
|
||||||
groupPrefParam :: GroupFeaturePreference f -> Maybe Int
|
groupPrefParam :: GroupFeaturePreference f -> Maybe Int
|
||||||
|
|
||||||
instance HasField "enable" GroupPreference GroupFeatureEnabled where
|
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
|
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
|
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
|
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
|
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
|
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
|
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
|
instance GroupFeatureI 'GFTimedMessages where
|
||||||
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
|
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
|
||||||
|
@ -773,9 +770,9 @@ preferenceState pref =
|
||||||
in (allow, param)
|
in (allow, param)
|
||||||
|
|
||||||
getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f)
|
getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f)
|
||||||
getContactUserPreference f ps = case f of
|
getContactUserPreference = \case
|
||||||
SCFTimedMessages -> ps.timedMessages
|
SCFTimedMessages -> timedMessages
|
||||||
SCFFullDelete -> ps.fullDelete
|
SCFFullDelete -> fullDelete
|
||||||
SCFReactions -> ps.reactions
|
SCFReactions -> reactions
|
||||||
SCFVoice -> ps.voice
|
SCFVoice -> voice
|
||||||
SCFCalls -> ps.calls
|
SCFCalls -> calls
|
||||||
|
|
|
@ -7,7 +7,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
|
|
||||||
module Simplex.Chat.View where
|
module Simplex.Chat.View where
|
||||||
|
|
||||||
|
@ -192,7 +191,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||||
CRContactConnecting u _ -> ttyUser u []
|
CRContactConnecting u _ -> ttyUser u []
|
||||||
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
|
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
|
||||||
CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"]
|
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 <> ")"]
|
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||||
CRContactsSubscribed srv cs -> [plain $ "server connected " <> 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]
|
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 :: [Contact] -> [StyledString]
|
||||||
viewContactsList =
|
viewContactsList =
|
||||||
let getLDN :: Contact -> ContactName
|
let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
|
||||||
getLDN Contact{localDisplayName} = localDisplayName
|
|
||||||
ldn = T.toLower . getLDN
|
|
||||||
in map (\ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn
|
in map (\ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn
|
||||||
where
|
where
|
||||||
muted' Contact {chatSettings, localDisplayName = ldn}
|
muted' Contact {chatSettings, localDisplayName = ldn}
|
||||||
|
@ -827,8 +824,7 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
|
||||||
where
|
where
|
||||||
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
|
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
|
||||||
groupMember m = memIncognito m <> ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
|
groupMember m = memIncognito m <> ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
|
||||||
role :: GroupMember -> StyledString
|
role m = plain . strEncode $ memberRole (m :: GroupMember)
|
||||||
role m = plain . strEncode $ m.memberRole
|
|
||||||
category m = case memberCategory m of
|
category m = case memberCategory m of
|
||||||
GCUserMember -> "you, "
|
GCUserMember -> "you, "
|
||||||
GCInviteeMember -> "invited, "
|
GCInviteeMember -> "invited, "
|
||||||
|
@ -860,10 +856,9 @@ viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView
|
||||||
|
|
||||||
viewGroupsList :: [(GroupInfo, GroupSummary)] -> [StyledString]
|
viewGroupsList :: [(GroupInfo, GroupSummary)] -> [StyledString]
|
||||||
viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
|
viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
|
||||||
viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs
|
viewGroupsList gs = map groupSS $ sortOn ldn_ gs
|
||||||
where
|
where
|
||||||
ldn_ :: GroupInfo -> Text
|
ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) . fst
|
||||||
ldn_ g = T.toLower g.localDisplayName
|
|
||||||
groupSS (g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings}, GroupSummary {currentMembers}) =
|
groupSS (g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings}, GroupSummary {currentMembers}) =
|
||||||
case memberStatus membership of
|
case memberStatus membership of
|
||||||
GSMemInvited -> groupInvitation' g
|
GSMemInvited -> groupInvitation' g
|
||||||
|
@ -1411,8 +1406,7 @@ viewFileTransferStatus (FTSnd FileTransferMeta {cancelled} fts@(ft : _), chunksN
|
||||||
case concatMap recipientsTransferStatus $ groupBy ((==) `on` fs) $ sortOn fs fts of
|
case concatMap recipientsTransferStatus $ groupBy ((==) `on` fs) $ sortOn fs fts of
|
||||||
[recipientsStatus] -> ["sending " <> sndFile ft <> " " <> recipientsStatus]
|
[recipientsStatus] -> ["sending " <> sndFile ft <> " " <> recipientsStatus]
|
||||||
recipientsStatuses -> ("sending " <> sndFile ft <> ": ") : map (" " <>) recipientsStatuses
|
recipientsStatuses -> ("sending " <> sndFile ft <> ": ") : map (" " <>) recipientsStatuses
|
||||||
fs :: SndFileTransfer -> FileStatus
|
fs = fileStatus :: SndFileTransfer -> FileStatus
|
||||||
fs SndFileTransfer{fileStatus} = fileStatus
|
|
||||||
recipientsTransferStatus [] = []
|
recipientsTransferStatus [] = []
|
||||||
recipientsTransferStatus ts@(SndFileTransfer {fileStatus, fileSize, chunkSize} : _) = [sndStatus <> ": " <> listRecipients ts]
|
recipientsTransferStatus ts@(SndFileTransfer {fileStatus, fileSize, chunkSize} : _) = [sndStatus <> ": " <> listRecipients ts]
|
||||||
where
|
where
|
||||||
|
@ -1675,8 +1669,7 @@ viewChatError logLevel = \case
|
||||||
Just entity@(UserContactConnection conn UserContact {userContactLinkId}) ->
|
Just entity@(UserContactConnection conn UserContact {userContactLinkId}) ->
|
||||||
"[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] "
|
"[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] "
|
||||||
Nothing -> ""
|
Nothing -> ""
|
||||||
cId :: Connection -> StyledString
|
cId conn = sShow (connId (conn :: Connection))
|
||||||
cId conn = sShow conn.connId
|
|
||||||
where
|
where
|
||||||
fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
|
fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
|
||||||
sqliteError' = \case
|
sqliteError' = \case
|
||||||
|
|
12
stack.yaml
12
stack.yaml
|
@ -49,24 +49,20 @@ extra-deps:
|
||||||
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
|
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
|
||||||
# - ../simplexmq
|
# - ../simplexmq
|
||||||
- github: simplex-chat/simplexmq
|
- github: simplex-chat/simplexmq
|
||||||
commit: 8d47f690838371bc848e4b31a4b09ef6bf67ccc5
|
commit: 53c793d5590d3c781aa3fbf72993eee262c7aa83
|
||||||
- github: kazu-yamamoto/http2
|
- github: kazu-yamamoto/http2
|
||||||
commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
|
commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
|
||||||
# - ../direct-sqlcipher
|
# - ../direct-sqlcipher
|
||||||
- github: simplex-chat/direct-sqlcipher
|
- github: simplex-chat/direct-sqlcipher
|
||||||
commit: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
|
commit: 34309410eb2069b029b8fc1872deb1e0db123294
|
||||||
# - ../sqlcipher-simple
|
# - ../sqlcipher-simple
|
||||||
- github: simplex-chat/sqlcipher-simple
|
- github: simplex-chat/sqlcipher-simple
|
||||||
commit: a46bd361a19376c5211f1058908fc0ae6bf42446
|
commit: 5e154a2aeccc33ead6c243ec07195ab673137221
|
||||||
# - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
|
# - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
|
||||||
- github: simplex-chat/aeson
|
- github: simplex-chat/aeson
|
||||||
commit: 68330dce8208173c6acf5f62b23acb500ab5d873
|
commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7
|
||||||
- github: simplex-chat/haskell-terminal
|
- github: simplex-chat/haskell-terminal
|
||||||
commit: f708b00009b54890172068f168bf98508ffcd495
|
commit: f708b00009b54890172068f168bf98508ffcd495
|
||||||
- github: simplex-chat/android-support
|
|
||||||
commit: 9aa09f148089d6752ce563b14c2df1895718d806
|
|
||||||
- github: simplex-chat/network-transport
|
|
||||||
commit: 0013798272a683e35ca38d2fdaf480942311fba8
|
|
||||||
#
|
#
|
||||||
# extra-deps: []
|
# extra-deps: []
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Bots.BroadcastTests where
|
module Bots.BroadcastTests where
|
||||||
|
@ -34,7 +33,7 @@ broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadc
|
||||||
mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts
|
mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts
|
||||||
mkBotOpts tmp publishers =
|
mkBotOpts tmp publishers =
|
||||||
BroadcastBotOpts
|
BroadcastBotOpts
|
||||||
{ coreOptions = testOpts.coreOptions {dbFilePrefix = tmp </> botDbPrefix},
|
{ coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp </> botDbPrefix},
|
||||||
publishers,
|
publishers,
|
||||||
welcomeMessage = defaultWelcomeMessage publishers,
|
welcomeMessage = defaultWelcomeMessage publishers,
|
||||||
prohibitedMessage = defaultWelcomeMessage publishers
|
prohibitedMessage = defaultWelcomeMessage publishers
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PostfixOperators #-}
|
{-# LANGUAGE PostfixOperators #-}
|
||||||
|
|
||||||
|
@ -61,7 +60,7 @@ directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", im
|
||||||
mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts
|
mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts
|
||||||
mkDirectoryOpts tmp superUsers =
|
mkDirectoryOpts tmp superUsers =
|
||||||
DirectoryOpts
|
DirectoryOpts
|
||||||
{ coreOptions = testOpts.coreOptions {dbFilePrefix = tmp </> serviceDbPrefix},
|
{ coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp </> serviceDbPrefix},
|
||||||
superUsers,
|
superUsers,
|
||||||
directoryLog = Just $ tmp </> "directory_service.log",
|
directoryLog = Just $ tmp </> "directory_service.log",
|
||||||
serviceName = "SimpleX-Directory",
|
serviceName = "SimpleX-Directory",
|
||||||
|
|
|
@ -6,15 +6,12 @@
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module ChatClient where
|
module ChatClient where
|
||||||
|
|
||||||
import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)
|
import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Exception (bracket, bracket_)
|
import Control.Exception (bracket, bracket_)
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Data.Functor (($>))
|
import Data.Functor (($>))
|
||||||
import Data.List (dropWhileEnd, find)
|
import Data.List (dropWhileEnd, find)
|
||||||
|
|
|
@ -2,8 +2,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PostfixOperators #-}
|
{-# LANGUAGE PostfixOperators #-}
|
||||||
|
|
||||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
||||||
|
|
||||||
module ChatTests.Files where
|
module ChatTests.Files where
|
||||||
|
|
||||||
import ChatClient
|
import ChatClient
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue