Compare commits

...

131 commits

Author SHA1 Message Date
Evgeny Poberezkin
545f110fb8 nix: fix direct-sqlcipher content hash 2023-12-13 20:29:36 +00:00
Evgeny Poberezkin
4c6387c854 nix: fix script 2023-12-13 20:28:32 +00:00
Evgeny Poberezkin
b3544cfbc3 Merge branch 'stable' into stable-android 2023-12-12 10:12:42 +00:00
Evgeny Poberezkin
bfa8717ed4 Merge branch 'master-android' into stable-android 2023-12-09 20:43:21 +00:00
Evgeny Poberezkin
cdb3b6aafd Merge branch 'master-ghc8107' into master-android 2023-12-07 15:12:49 +00:00
Evgeny Poberezkin
9f3d3e8ba4 Merge branch 'master' into master-ghc8107 2023-12-07 15:00:23 +00:00
Evgeny Poberezkin
047aad592e Merge branch 'master-ghc8107' into master-android 2023-12-04 12:32:05 +00:00
Evgeny Poberezkin
087acd9180
changes to support GHC 8.10.7 (#3512)
* Revert "raise lower bound on mtl to a real version (#3499)"

This reverts commit f94c0311c1.

* Revert "core: expand ranges to fit ghc 8.10 & 9.6 (#3496)"

This reverts commit 9a1c7f41f7.

* update simplexmq

* remove netword-transport fork

* compatibility with GHC 8.10.7

* simplexmq

* fix test

* simplexmq, deps

* update sqlcipher deps in sha256nix

* fix index-state in cabal.project

* index-state

* remove import

* add cabal.project.freeze

* simplexmq

* remove freeze

* simplexmq

* bytestring,simplexmq

* template-haskell, simplexmq

* simplexmq

* simplexmq

* simplexmq

* mtl

* simplexmq

* remove duplicate index-state
2023-12-04 12:29:49 +00:00
Evgeny Poberezkin
0b822e4a5c Merge branch 'master' into master-ghc8107 2023-12-04 10:07:16 +00:00
Evgeny Poberezkin
f8a469488e Merge branch 'master' into master-ghc8107 2023-12-02 12:30:36 +00:00
Evgeny Poberezkin
3b5e806418 Merge branch 'master' into master-ghc8107 2023-12-01 17:46:12 +00:00
spaced4ndy
79e208193a Merge branch 'master-ghc8107' into master-android 2023-11-30 21:11:25 +04:00
spaced4ndy
ef5c13b1c1 Merge branch 'master' into master-ghc8107 2023-11-30 21:10:51 +04:00
spaced4ndy
38533213d2 Merge branch 'master' into master-ghc8107 2023-11-30 20:56:51 +04:00
spaced4ndy
5f1aa6fa9d Merge branch 'master-ghc8107' into master-android 2023-11-27 19:18:22 +04:00
spaced4ndy
b0002fe07d Merge branch 'master' into master-ghc8107 2023-11-27 19:17:39 +04:00
Evgeny Poberezkin
ef21fd1d26 Merge branch 'master-ghc8107' into master-android 2023-11-26 19:59:46 +00:00
Evgeny Poberezkin
4a311b9578 fix for ghc 8.10.7 2023-11-26 19:34:39 +00:00
Evgeny Poberezkin
b8da5e225b Merge branch 'master' into master-ghc8107 2023-11-26 18:53:40 +00:00
Evgeny Poberezkin
8b3300e197 Merge branch 'master-android' into stable-android 2023-11-26 13:14:27 +00:00
Evgeny Poberezkin
f27de052cf Merge branch 'master' into master-android 2023-11-26 11:51:16 +00:00
Evgeny Poberezkin
5cc537f14c Merge branch 'master' into master-ghc8107 2023-11-26 11:50:50 +00:00
Evgeny Poberezkin
dc8ca4cf89 Merge tag 'v5.4.0' into master-android 2023-11-25 11:23:23 +00:00
Evgeny Poberezkin
b62dd801f1 Merge branch 'master-ghc8107' into master-android 2023-11-24 20:02:05 +00:00
Evgeny Poberezkin
0c096e2c89 Merge branch 'master' into master-ghc8107 2023-11-24 19:00:30 +00:00
Evgeny Poberezkin
cc127e56fe Merge branch 'master' into master-android 2023-11-23 16:23:02 +00:00
Evgeny Poberezkin
1781495ee3 Merge branch 'master' into master-ghc8107 2023-11-23 16:22:46 +00:00
Evgeny Poberezkin
831231d8e6 Merge branch 'master-ghc8107' into master-android 2023-11-21 21:16:04 +00:00
Evgeny Poberezkin
45102442f4 Merge branch 'master' into master-ghc8107 2023-11-21 21:15:10 +00:00
spaced4ndy
f323c8e112 Merge branch 'master-ghc8107' into master-android 2023-11-21 19:42:28 +04:00
spaced4ndy
3bdc6b5e28 Merge branch 'master' into master-ghc8107 2023-11-21 19:41:06 +04:00
Evgeny Poberezkin
d8373262bc Merge branch 'master-ghc8107' into master-android 2023-11-21 00:01:20 +00:00
Evgeny Poberezkin
3597d34716 Merge branch 'master' into master-ghc8107 2023-11-21 00:00:59 +00:00
Evgeny Poberezkin
bd4259e89e update hpack 2023-11-20 14:43:20 +00:00
Evgeny Poberezkin
55ead740cc update hpack 2023-11-20 14:43:05 +00:00
Evgeny Poberezkin
5ef0eda2d7 Merge branch 'master-ghc8107' into master-android 2023-11-20 14:30:27 +00:00
Evgeny Poberezkin
49a9b0e7d6 update hpack version 2023-11-20 14:30:10 +00:00
Evgeny Poberezkin
45ada450a2 Merge branch 'master-ghc8107' into master-android 2023-11-20 13:24:07 +00:00
Evgeny Poberezkin
307a1b3c5e fix for ghc 8.10.7 2023-11-20 13:23:45 +00:00
Evgeny Poberezkin
ed6b3bbead Merge branch 'master' into master-ghc8107 2023-11-20 13:01:22 +00:00
spaced4ndy
901610eec5 Merge branch 'master-ghc8107' into master-android 2023-11-20 14:08:10 +04:00
spaced4ndy
7d4127c51d Merge branch 'master' into master-ghc8107 2023-11-20 14:07:08 +04:00
Evgeny Poberezkin
13215d91d7 Merge branch 'master-ghc8107' into master-android 2023-11-20 00:07:12 +00:00
Evgeny Poberezkin
e1a8099474 fix for GHC 8.10.7 2023-11-20 00:06:45 +00:00
Evgeny Poberezkin
daa8d9bb21 Merge branch 'master' into master-ghc8107 2023-11-19 23:42:13 +00:00
Evgeny Poberezkin
5fcbade1bc Merge branch 'master-ghc8107' into master-android 2023-11-17 11:49:35 +00:00
Evgeny Poberezkin
3937ffa9a6 Merge branch 'master' into master-ghc8107 2023-11-17 11:47:52 +00:00
Evgeny Poberezkin
80ddb50e1c Merge branch 'master-ghc8107' into master-android 2023-11-16 18:55:17 +00:00
Evgeny Poberezkin
f6e66f1c53 Merge branch 'master' into master-ghc8107 2023-11-16 18:13:02 +00:00
Evgeny Poberezkin
0c23ff9ae3 Merge branch 'master-ghc8107' into master-android 2023-11-11 13:57:32 +00:00
Evgeny Poberezkin
1570bc2b99 Merge branch 'master' into master-ghc8107 2023-11-11 13:56:53 +00:00
Evgeny Poberezkin
1e2104cabf Merge branch 'master-ghc8107' into master-android 2023-11-11 09:52:07 +00:00
Evgeny Poberezkin
f3014f258d Merge branch 'master' into master-ghc8107 2023-11-11 09:51:42 +00:00
Evgeny Poberezkin
f0991cc0ba Merge branch 'master-ghc8107' into master-android 2023-11-10 21:22:19 +00:00
Evgeny Poberezkin
74b78a8d7b Merge branch 'master' into master-ghc8107 2023-11-10 21:11:08 +00:00
Evgeny Poberezkin
82cd70a75c Merge branch 'master-ghc8107' into master-android 2023-11-10 21:08:11 +00:00
Evgeny Poberezkin
fe4eb7b5af Merge branch 'master' into master-ghc8107 without changes, to skip update for ghc 9.6.3 2023-11-10 21:04:20 +00:00
Evgeny Poberezkin
c459e71d02 Merge branch 'master-ghc8107' into master-android 2023-11-06 11:26:40 +00:00
Evgeny Poberezkin
2516d5a393 Merge branch 'master' into master-ghc8107 2023-11-06 11:26:22 +00:00
spaced4ndy
477d98d75a Merge branch 'master-ghc8107' into master-android 2023-11-06 11:42:39 +04:00
spaced4ndy
4253cd7fb9 Merge branch 'master' into master-ghc8107 2023-11-06 11:41:55 +04:00
Evgeny Poberezkin
ca78958667 Merge branch 'master-ghc8107' into master-android 2023-11-04 13:39:35 +00:00
Evgeny Poberezkin
1f5b80d560 fix for ghc8107 2023-11-04 13:37:25 +00:00
Evgeny Poberezkin
2de111e76c Merge branch 'master' into master-ghc8107 2023-11-04 13:02:08 +00:00
spaced4ndy
8343285d93 Merge branch 'master-ghc8107' into master-android 2023-10-30 21:01:16 +04:00
spaced4ndy
5dbe2b2745 Merge branch 'master' into master-ghc8107 2023-10-30 21:00:11 +04:00
Evgeny Poberezkin
fb9485190d Merge branch 'master-ghc8107' into master-android 2023-10-29 18:27:00 +00:00
Evgeny Poberezkin
6881600e06 Merge branch 'master' into master-ghc8107 2023-10-29 18:24:13 +00:00
spaced4ndy
9ed723bafa Merge branch 'master-ghc8107' into master-android 2023-10-25 10:48:37 +04:00
spaced4ndy
9ded1c9821 Merge branch 'master' into master-ghc8107 2023-10-25 10:47:35 +04:00
spaced4ndy
bb374c68b1 Merge branch 'master-ghc8107' into master-android 2023-10-24 18:14:22 +04:00
spaced4ndy
c3e82a6a4e Merge branch 'master' into master-ghc8107 2023-10-24 18:13:56 +04:00
spaced4ndy
7c12e82042 Merge branch 'master-ghc8107' into master-android 2023-10-24 17:41:19 +04:00
spaced4ndy
e7e66ff873 Merge branch 'master' into master-ghc8107 2023-10-24 17:40:55 +04:00
Evgeny Poberezkin
c4d7e5307c Merge branch 'master-ghc8107' into master-android 2023-10-22 15:35:55 +01:00
Evgeny Poberezkin
d6b9a45a39 Merge branch 'master' into master-ghc8107 2023-10-22 15:10:33 +01:00
Evgeny Poberezkin
7fd3b4d6ba Merge branch 'master-ghc8107' into master-android 2023-10-18 22:45:11 +01:00
Evgeny Poberezkin
4004aafbc5 Merge branch 'master' into master-ghc8107 2023-10-18 22:44:27 +01:00
spaced4ndy
95008eeeaf Merge branch 'master-ghc8107' into master-android 2023-10-16 20:05:49 +04:00
spaced4ndy
c7a8992043 core: fix compilation for ghc 8.10.7 2023-10-16 20:05:13 +04:00
spaced4ndy
ea2b5f2ccf Merge branch 'master-ghc8107' into master-android 2023-10-16 19:28:48 +04:00
spaced4ndy
ed9f277421 Merge branch 'master' into master-ghc8107 2023-10-16 19:28:06 +04:00
Evgeny Poberezkin
5c14c3b349 Merge branch 'master-ghc8107' into master-android 2023-10-15 18:54:16 +01:00
Evgeny Poberezkin
d8fb31f167 Merge branch 'master' into master-ghc8107 2023-10-15 18:53:23 +01:00
Evgeny Poberezkin
02db38ffd3 Merge branch 'master-ghc8107' into master-android 2023-10-11 21:58:16 +01:00
Evgeny Poberezkin
7692195bfa core: fix for ghc 8.10.7 2023-10-11 21:57:53 +01:00
Evgeny Poberezkin
c435cbdc7b Merge branch 'master-ghc8107' into master-android 2023-10-11 21:28:43 +01:00
Evgeny Poberezkin
effc281271 Merge branch 'master' into master-ghc8107 2023-10-11 21:27:21 +01:00
spaced4ndy
41eb2e5689 Merge branch 'master-ghc8107' into master-android 2023-10-11 13:22:30 +04:00
spaced4ndy
67d74a0a27 Merge branch 'master' into master-ghc8107 2023-10-11 13:21:46 +04:00
Evgeny Poberezkin
c60af078d7 Merge branch 'stable' into stable-android 2023-10-09 19:55:51 +01:00
Evgeny Poberezkin
f66405e79b Merge branch 'master-ghc8107' into master-android 2023-10-09 17:31:56 +01:00
Evgeny Poberezkin
74d186af16 Merge branch 'master' into master-ghc8107 2023-10-09 17:31:27 +01:00
Evgeny Poberezkin
e4fbe66d95 Merge branch 'stable' into stable-android 2023-10-09 14:36:03 +01:00
Evgeny Poberezkin
187fef0c5a Merge branch 'master-ghc8107' into master-android 2023-10-09 14:05:21 +01:00
Evgeny Poberezkin
4782cab507 Merge branch 'master' into master-ghc8107 2023-10-09 14:05:04 +01:00
Evgeny Poberezkin
cb52d75ff0 Merge branch 'stable' into stable-android 2023-10-08 17:31:23 +01:00
Evgeny Poberezkin
bcbee67709 Merge branch 'master-ghc8107' into master-android 2023-10-08 08:38:40 +01:00
Evgeny Poberezkin
2501cbe55d Merge branch 'master' into master-ghc8107 2023-10-08 08:38:02 +01:00
Evgeny Poberezkin
2bd049db87 Merge branch 'master-ghc8107' into master-android 2023-10-07 21:10:22 +01:00
Evgeny Poberezkin
6b8b9ab4fd Merge branch 'master' into master-ghc8107 2023-10-07 19:06:38 +01:00
Evgeny Poberezkin
30db24265e Merge branch 'master-ghc8107' into master-android 2023-10-02 23:04:44 +01:00
Evgeny Poberezkin
316d605899 Merge branch 'master' into master-ghc8107 2023-10-02 23:04:13 +01:00
Evgeny Poberezkin
b4257f7767 Merge branch 'master-ghc8107' into master-android 2023-10-01 13:21:50 +01:00
Evgeny Poberezkin
a3f2d5c919 Merge branch 'master' into master-ghc8107 2023-10-01 13:20:06 +01:00
Evgeny Poberezkin
cf46469cd5 Merge branch 'master-ghc8107' into master-android 2023-10-01 11:19:50 +01:00
Evgeny Poberezkin
0312fde818 Merge branch 'master' into master-ghc8107 2023-10-01 11:19:27 +01:00
Evgeny Poberezkin
9defa44f0c Merge branch 'master-ghc8107' into master-android 2023-09-29 13:15:23 +01:00
Evgeny Poberezkin
915b53054c Merge branch 'master' into master-ghc8107 2023-09-29 13:14:57 +01:00
Evgeny Poberezkin
f81557b4fd Merge branch 'master-ghc8107' into master-android 2023-09-27 22:10:06 +01:00
Evgeny Poberezkin
e273bd1239 Merge branch 'master' into master-ghc8107 2023-09-27 22:04:00 +01:00
spaced4ndy
a63caf4640 Merge branch 'master-ghc8107' into master-android 2023-09-27 20:38:36 +04:00
spaced4ndy
e7f0234134 Merge branch 'master' into master-ghc8107 2023-09-27 20:11:39 +04:00
Evgeny Poberezkin
340552321e Merge branch 'master-ghc8107' into master-android 2023-09-27 16:07:24 +01:00
Evgeny Poberezkin
98a3fc214d Merge branch 'master' into master-ghc8107 2023-09-27 16:04:25 +01:00
Evgeny Poberezkin
6a578cfe3c Merge branch 'master-ghc8107' into master-android 2023-09-25 16:53:04 +01:00
Evgeny Poberezkin
dacc075fe8 Merge branch 'master' into master-ghc8107 2023-09-25 16:52:33 +01:00
spaced4ndy
55418e2bc0 Merge branch 'master-ghc8107' into master-android 2023-09-25 17:43:59 +04:00
spaced4ndy
f2b5c0f3a8 Merge branch 'master' into master-ghc8107 2023-09-25 17:43:37 +04:00
spaced4ndy
5ebdf5dba9 Merge branch 'master-ghc8107' into master-android 2023-09-25 17:07:14 +04:00
spaced4ndy
8e045764df Merge branch 'master' into master-ghc8107 2023-09-25 16:40:08 +04:00
Evgeny Poberezkin
503d3d77e6 Merge branch 'master' into master-ghc8107 2023-09-23 08:47:28 +01:00
Evgeny Poberezkin
81bd7d97c5 Merge branch 'master' into master-ghc8107 2023-09-22 17:21:54 +01:00
Evgeny Poberezkin
8f57925067 compatibility with GHC 8.10.7 2023-09-22 14:01:25 +01:00
Evgeny Poberezkin
9bf99db82e Merge branch 'master' into master-ghc8107 2023-09-22 13:46:50 +01:00
Evgeny Poberezkin
5615cdbf1a Merge branch 'master' into master-android 2023-09-21 17:04:47 +01:00
Evgeny Poberezkin
d802ae0058 Merge branch 'master' into master-android 2023-09-21 12:06:10 +01:00
Evgeny Poberezkin
8f2278198c Merge branch 'master' into master-android 2023-09-20 14:55:25 +01:00
spaced4ndy
10937a5a4e Merge branch 'master' into master-android 2023-09-20 17:36:53 +04:00
Evgeny Poberezkin
6aff6e9804 Merge branch 'master-ghc9' into master-ghc8107 2023-09-18 21:56:35 +01:00
Evgeny Poberezkin
95477cae7e core: use commit from simplexmq branch master-ghc8107 2023-09-18 21:45:50 +01:00
28 changed files with 861 additions and 1158 deletions

View file

@ -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.3" 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,7 +259,9 @@ 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: 'Setup MSYS2' - name: 'Setup MSYS2'
if: matrix.os == 'windows-latest' if: matrix.os == 'windows-latest'

View file

@ -165,6 +165,11 @@
64466DC829FC2B3B00E3D48D /* CreateSimpleXAddress.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */; }; 64466DC829FC2B3B00E3D48D /* CreateSimpleXAddress.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */; };
64466DCC29FFE3E800E3D48D /* MailView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DCB29FFE3E800E3D48D /* MailView.swift */; }; 64466DCC29FFE3E800E3D48D /* MailView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DCB29FFE3E800E3D48D /* MailView.swift */; };
6448BBB628FA9D56000D2AB9 /* GroupLinkView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */; }; 6448BBB628FA9D56000D2AB9 /* GroupLinkView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */; };
6449333A2AF8E51000AC506E /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933352AF8E51000AC506E /* libgmpxx.a */; };
6449333B2AF8E51000AC506E /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933362AF8E51000AC506E /* libgmp.a */; };
6449333C2AF8E51000AC506E /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933372AF8E51000AC506E /* libffi.a */; };
6449333D2AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933382AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */; };
6449333E2AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933392AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */; };
644EFFDE292BCD9D00525D5B /* ComposeVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */; }; 644EFFDE292BCD9D00525D5B /* ComposeVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */; };
644EFFE0292CFD7F00525D5B /* CIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */; }; 644EFFE0292CFD7F00525D5B /* CIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */; };
644EFFE2292D089800525D5B /* FramedCIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */; }; 644EFFE2292D089800525D5B /* FramedCIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */; };
@ -448,6 +453,11 @@
64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CreateSimpleXAddress.swift; sourceTree = "<group>"; }; 64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CreateSimpleXAddress.swift; sourceTree = "<group>"; };
64466DCB29FFE3E800E3D48D /* MailView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MailView.swift; sourceTree = "<group>"; }; 64466DCB29FFE3E800E3D48D /* MailView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MailView.swift; sourceTree = "<group>"; };
6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = GroupLinkView.swift; sourceTree = "<group>"; }; 6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = GroupLinkView.swift; sourceTree = "<group>"; };
644933352AF8E51000AC506E /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
644933362AF8E51000AC506E /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
644933372AF8E51000AC506E /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
644933382AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a"; sourceTree = "<group>"; };
644933392AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a"; sourceTree = "<group>"; };
644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeVoiceView.swift; sourceTree = "<group>"; }; 644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeVoiceView.swift; sourceTree = "<group>"; };
644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIVoiceView.swift; sourceTree = "<group>"; }; 644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIVoiceView.swift; sourceTree = "<group>"; };
644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = FramedCIVoiceView.swift; sourceTree = "<group>"; }; 644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = FramedCIVoiceView.swift; sourceTree = "<group>"; };

View file

@ -71,7 +71,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}/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)

View file

@ -2,9 +2,9 @@ packages: .
-- packages: . ../simplexmq -- packages: . ../simplexmq
-- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple -- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple
with-compiler: ghc-9.6.3 with-compiler: ghc-8.10.7
index-state: 2023-10-20T00:00:00Z index-state: 2023-10-06T00:00:00Z
constraints: zip +disable-bzip2 +disable-zstd constraints: zip +disable-bzip2 +disable-zstd

687
flake.lock generated
View file

@ -16,6 +16,21 @@
"type": "github" "type": "github"
} }
}, },
"blank": {
"locked": {
"lastModified": 1625557891,
"narHash": "sha256-O8/MWsPBGhhyPoPLHZAuoZiiHo9q6FLlEeIDEXuj6T4=",
"owner": "divnix",
"repo": "blank",
"rev": "5a5d2684073d9f563072ed07c871d577a6c614a8",
"type": "github"
},
"original": {
"owner": "divnix",
"repo": "blank",
"type": "github"
}
},
"cabal-32": { "cabal-32": {
"flake": false, "flake": false,
"locked": { "locked": {
@ -83,6 +98,64 @@
"type": "github" "type": "github"
} }
}, },
"devshell": {
"inputs": {
"flake-utils": [
"haskellNix",
"tullia",
"std",
"flake-utils"
],
"nixpkgs": [
"haskellNix",
"tullia",
"std",
"nixpkgs"
]
},
"locked": {
"lastModified": 1663445644,
"narHash": "sha256-+xVlcK60x7VY1vRJbNUEAHi17ZuoQxAIH4S4iUFUGBA=",
"owner": "numtide",
"repo": "devshell",
"rev": "e3dc3e21594fe07bdb24bdf1c8657acaa4cb8f66",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "devshell",
"type": "github"
}
},
"dmerge": {
"inputs": {
"nixlib": [
"haskellNix",
"tullia",
"std",
"nixpkgs"
],
"yants": [
"haskellNix",
"tullia",
"std",
"yants"
]
},
"locked": {
"lastModified": 1659548052,
"narHash": "sha256-fzI2gp1skGA8mQo/FBFrUAtY0GQkAIAaV/V127TJPyY=",
"owner": "divnix",
"repo": "data-merge",
"rev": "d160d18ce7b1a45b88344aa3f13ed1163954b497",
"type": "github"
},
"original": {
"owner": "divnix",
"repo": "data-merge",
"type": "github"
}
},
"flake-compat": { "flake-compat": {
"flake": false, "flake": false,
"locked": { "locked": {
@ -100,21 +173,19 @@
"type": "github" "type": "github"
} }
}, },
"flake-parts": { "flake-compat_2": {
"inputs": { "flake": false,
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": { "locked": {
"lastModified": 1698579227, "lastModified": 1650374568,
"narHash": "sha256-KVWjFZky+gRuWennKsbo6cWyo7c/z/VgCte5pR9pEKg=", "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=",
"owner": "hercules-ci", "owner": "edolstra",
"repo": "flake-parts", "repo": "flake-compat",
"rev": "f76e870d64779109e41370848074ac4eaa1606ec", "rev": "b4a34015c698c7793d592d66adbab377907a2be8",
"type": "github" "type": "github"
}, },
"original": { "original": {
"owner": "hercules-ci", "owner": "edolstra",
"repo": "flake-parts", "repo": "flake-compat",
"type": "github" "type": "github"
} }
}, },
@ -133,6 +204,51 @@
"type": "github" "type": "github"
} }
}, },
"flake-utils_2": {
"locked": {
"lastModified": 1667395993,
"narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"flake-utils_3": {
"locked": {
"lastModified": 1653893745,
"narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"flake-utils_4": {
"locked": {
"lastModified": 1659877975,
"narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "c0e246b9b83f637f4681389ecabcb2681b4f3af0",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"ghc-8.6.5-iohk": { "ghc-8.6.5-iohk": {
"flake": false, "flake": false,
"locked": { "locked": {
@ -150,51 +266,33 @@
"type": "github" "type": "github"
} }
}, },
"ghc98X": { "gomod2nix": {
"flake": false, "inputs": {
"nixpkgs": "nixpkgs_2",
"utils": "utils"
},
"locked": { "locked": {
"lastModified": 1696643148, "lastModified": 1655245309,
"narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", "narHash": "sha256-d/YPoQ/vFn1+GTmSdvbSBSTOai61FONxB4+Lt6w/IVI=",
"ref": "ghc-9.8", "owner": "tweag",
"rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", "repo": "gomod2nix",
"revCount": 61642, "rev": "40d32f82fc60d66402eb0972e6e368aeab3faf58",
"submodules": true, "type": "github"
"type": "git",
"url": "https://gitlab.haskell.org/ghc/ghc"
}, },
"original": { "original": {
"ref": "ghc-9.8", "owner": "tweag",
"submodules": true, "repo": "gomod2nix",
"type": "git", "type": "github"
"url": "https://gitlab.haskell.org/ghc/ghc"
}
},
"ghc99": {
"flake": false,
"locked": {
"lastModified": 1697054644,
"narHash": "sha256-kKarOuXUaAH3QWv7ASx+gGFMHaHKe0pK5Zu37ky2AL4=",
"ref": "refs/heads/master",
"rev": "f383a242c76f90bcca8a4d7ee001dcb49c172a9a",
"revCount": 62040,
"submodules": true,
"type": "git",
"url": "https://gitlab.haskell.org/ghc/ghc"
},
"original": {
"submodules": true,
"type": "git",
"url": "https://gitlab.haskell.org/ghc/ghc"
} }
}, },
"hackage": { "hackage": {
"flake": false, "flake": false,
"locked": { "locked": {
"lastModified": 1699834964, "lastModified": 1696724662,
"narHash": "sha256-733KT+G0c1euCeb60/u1qbX22Kvu9lNnIDfAmk6Jxq0=", "narHash": "sha256-jV2ugSjZE0FjMYR2YIx0p2cDBqd+xxhZrRxp5BmieYk=",
"owner": "input-output-hk", "owner": "input-output-hk",
"repo": "hackage.nix", "repo": "hackage.nix",
"rev": "2e891e530400187ea1083ffef15adf259061be41", "rev": "df603bff8606d8653a0876ae0c3fd1f9014882f2",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -211,40 +309,33 @@
"cabal-36": "cabal-36", "cabal-36": "cabal-36",
"cardano-shell": "cardano-shell", "cardano-shell": "cardano-shell",
"flake-compat": "flake-compat", "flake-compat": "flake-compat",
"flake-utils": "flake-utils_2",
"ghc-8.6.5-iohk": "ghc-8.6.5-iohk", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk",
"ghc98X": "ghc98X",
"ghc99": "ghc99",
"hackage": [ "hackage": [
"hackage" "hackage"
], ],
"hls-1.10": "hls-1.10",
"hls-2.0": "hls-2.0",
"hls-2.2": "hls-2.2",
"hls-2.3": "hls-2.3",
"hls-2.4": "hls-2.4",
"hpc-coveralls": "hpc-coveralls", "hpc-coveralls": "hpc-coveralls",
"hydra": "hydra", "hydra": "hydra",
"iserv-proxy": "iserv-proxy", "iserv-proxy": "iserv-proxy",
"nixpkgs": [ "nixpkgs": [
"haskellNix", "nixpkgs"
"nixpkgs-unstable"
], ],
"nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2003": "nixpkgs-2003",
"nixpkgs-2105": "nixpkgs-2105", "nixpkgs-2105": "nixpkgs-2105",
"nixpkgs-2111": "nixpkgs-2111", "nixpkgs-2111": "nixpkgs-2111",
"nixpkgs-2205": "nixpkgs-2205", "nixpkgs-2205": "nixpkgs-2205",
"nixpkgs-2211": "nixpkgs-2211", "nixpkgs-2211": "nixpkgs-2211",
"nixpkgs-2305": "nixpkgs-2305",
"nixpkgs-unstable": "nixpkgs-unstable", "nixpkgs-unstable": "nixpkgs-unstable",
"old-ghc-nix": "old-ghc-nix", "old-ghc-nix": "old-ghc-nix",
"stackage": "stackage" "stackage": "stackage",
"tullia": "tullia"
}, },
"locked": { "locked": {
"lastModified": 1700119633, "lastModified": 1677975916,
"narHash": "sha256-nZY2eIo8TkRbXgJXEWMm9zor330GuUtcNzvUN9tN64U=", "narHash": "sha256-dbe8lEEPyfzjdRwpePClv7J9p9lQg7BwbBqAMCw4RLw=",
"owner": "input-output-hk", "owner": "input-output-hk",
"repo": "haskell.nix", "repo": "haskell.nix",
"rev": "1fe47a3d52e1ecd6247c8ab83811a21de2e2f074", "rev": "ab5efd87ce3fd8ade38a01d97693d29a4f1ae7e4",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -254,91 +345,6 @@
"type": "github" "type": "github"
} }
}, },
"hls-1.10": {
"flake": false,
"locked": {
"lastModified": 1680000865,
"narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "1.10.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.0": {
"flake": false,
"locked": {
"lastModified": 1687698105,
"narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "783905f211ac63edf982dd1889c671653327e441",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.0.0.1",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.2": {
"flake": false,
"locked": {
"lastModified": 1693064058,
"narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.2.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.3": {
"flake": false,
"locked": {
"lastModified": 1695910642,
"narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.3.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.4": {
"flake": false,
"locked": {
"lastModified": 1696939266,
"narHash": "sha256-VOMf5+kyOeOmfXTHlv4LNFJuDGa7G3pDnOxtzYR40IU=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "362fdd1293efb4b82410b676ab1273479f6d17ee",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.4.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hpc-coveralls": { "hpc-coveralls": {
"flake": false, "flake": false,
"locked": { "locked": {
@ -378,14 +384,37 @@
"type": "indirect" "type": "indirect"
} }
}, },
"incl": {
"inputs": {
"nixlib": [
"haskellNix",
"tullia",
"std",
"nixpkgs"
]
},
"locked": {
"lastModified": 1669263024,
"narHash": "sha256-E/+23NKtxAqYG/0ydYgxlgarKnxmDbg6rCMWnOBqn9Q=",
"owner": "divnix",
"repo": "incl",
"rev": "ce7bebaee048e4cd7ebdb4cee7885e00c4e2abca",
"type": "github"
},
"original": {
"owner": "divnix",
"repo": "incl",
"type": "github"
}
},
"iserv-proxy": { "iserv-proxy": {
"flake": false, "flake": false,
"locked": { "locked": {
"lastModified": 1691634696, "lastModified": 1670983692,
"narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", "narHash": "sha256-avLo34JnI9HNyOuauK5R69usJm+GfW3MlyGlYxZhTgY=",
"ref": "hkm/remote-iserv", "ref": "hkm/remote-iserv",
"rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", "rev": "50d0abb3317ac439a4e7495b185a64af9b7b9300",
"revCount": 14, "revCount": 10,
"type": "git", "type": "git",
"url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git"
}, },
@ -411,22 +440,32 @@
"type": "github" "type": "github"
} }
}, },
"mac2ios": { "n2c": {
"inputs": { "inputs": {
"flake-parts": "flake-parts", "flake-utils": [
"nixpkgs": "nixpkgs_2" "haskellNix",
"tullia",
"std",
"flake-utils"
],
"nixpkgs": [
"haskellNix",
"tullia",
"std",
"nixpkgs"
]
}, },
"locked": { "locked": {
"lastModified": 1699767871, "lastModified": 1665039323,
"narHash": "sha256-kxeCUfwC/Vgh2FvVMlBUq0eVx1JvfHyN+5MPKUik9mE=", "narHash": "sha256-SAh3ZjFGsaCI8FRzXQyp56qcGdAqgKEfJWPCQ0Sr7tQ=",
"owner": "zw3rk", "owner": "nlewo",
"repo": "mobile-core-tools", "repo": "nix2container",
"rev": "4dcb77d5ea896d749381806dfab5358851b08951", "rev": "b008fe329ffb59b67bf9e7b08ede6ee792f2741a",
"type": "github" "type": "github"
}, },
"original": { "original": {
"owner": "zw3rk", "owner": "nlewo",
"repo": "mobile-core-tools", "repo": "nix2container",
"type": "github" "type": "github"
} }
}, },
@ -451,6 +490,95 @@
"type": "github" "type": "github"
} }
}, },
"nix-nomad": {
"inputs": {
"flake-compat": "flake-compat_2",
"flake-utils": [
"haskellNix",
"tullia",
"nix2container",
"flake-utils"
],
"gomod2nix": "gomod2nix",
"nixpkgs": [
"haskellNix",
"tullia",
"nixpkgs"
],
"nixpkgs-lib": [
"haskellNix",
"tullia",
"nixpkgs"
]
},
"locked": {
"lastModified": 1658277770,
"narHash": "sha256-T/PgG3wUn8Z2rnzfxf2VqlR1CBjInPE0l1yVzXxPnt0=",
"owner": "tristanpemble",
"repo": "nix-nomad",
"rev": "054adcbdd0a836ae1c20951b67ed549131fd2d70",
"type": "github"
},
"original": {
"owner": "tristanpemble",
"repo": "nix-nomad",
"type": "github"
}
},
"nix2container": {
"inputs": {
"flake-utils": "flake-utils_3",
"nixpkgs": "nixpkgs_3"
},
"locked": {
"lastModified": 1658567952,
"narHash": "sha256-XZ4ETYAMU7XcpEeAFP3NOl9yDXNuZAen/aIJ84G+VgA=",
"owner": "nlewo",
"repo": "nix2container",
"rev": "60bb43d405991c1378baf15a40b5811a53e32ffa",
"type": "github"
},
"original": {
"owner": "nlewo",
"repo": "nix2container",
"type": "github"
}
},
"nixago": {
"inputs": {
"flake-utils": [
"haskellNix",
"tullia",
"std",
"flake-utils"
],
"nixago-exts": [
"haskellNix",
"tullia",
"std",
"blank"
],
"nixpkgs": [
"haskellNix",
"tullia",
"std",
"nixpkgs"
]
},
"locked": {
"lastModified": 1661824785,
"narHash": "sha256-/PnwdWoO/JugJZHtDUioQp3uRiWeXHUdgvoyNbXesz8=",
"owner": "nix-community",
"repo": "nixago",
"rev": "8c1f9e5f1578d4b2ea989f618588d62a335083c3",
"type": "github"
},
"original": {
"owner": "nix-community",
"repo": "nixago",
"type": "github"
}
},
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1657693803, "lastModified": 1657693803,
@ -517,11 +645,11 @@
}, },
"nixpkgs-2205": { "nixpkgs-2205": {
"locked": { "locked": {
"lastModified": 1685573264, "lastModified": 1672580127,
"narHash": "sha256-Zffu01pONhs/pqH07cjlF10NnMDLok8ix5Uk4rhOnZQ=", "narHash": "sha256-3lW3xZslREhJogoOkjeZtlBtvFMyxHku7I/9IVehhT8=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "380be19fbd2d9079f677978361792cb25e8a3635", "rev": "0874168639713f547c05947c76124f78441ea46c",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -533,11 +661,11 @@
}, },
"nixpkgs-2211": { "nixpkgs-2211": {
"locked": { "locked": {
"lastModified": 1688392541, "lastModified": 1675730325,
"narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=", "narHash": "sha256-uNvD7fzO5hNlltNQUAFBPlcEjNG5Gkbhl/ROiX+GZU4=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b", "rev": "b7ce17b1ebf600a72178f6302c77b6382d09323f",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -547,40 +675,6 @@
"type": "github" "type": "github"
} }
}, },
"nixpkgs-2305": {
"locked": {
"lastModified": 1695416179,
"narHash": "sha256-610o1+pwbSu+QuF3GE0NU5xQdTHM3t9wyYhB9l94Cd8=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "715d72e967ec1dd5ecc71290ee072bcaf5181ed6",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-23.05-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-lib": {
"locked": {
"dir": "lib",
"lastModified": 1696019113,
"narHash": "sha256-X3+DKYWJm93DRSdC5M6K5hLqzSya9BjibtBsuARoPco=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "f5892ddac112a1e9b3612c39af1b72987ee5783a",
"type": "github"
},
"original": {
"dir": "lib",
"owner": "NixOS",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-regression": { "nixpkgs-regression": {
"locked": { "locked": {
"lastModified": 1643052045, "lastModified": 1643052045,
@ -599,11 +693,11 @@
}, },
"nixpkgs-unstable": { "nixpkgs-unstable": {
"locked": { "locked": {
"lastModified": 1695318763, "lastModified": 1675758091,
"narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", "narHash": "sha256-7gFSQbSVAFUHtGCNHPF7mPc5CcqDk9M2+inlVPZSneg=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "e12483116b3b51a185a33a272bf351e357ba9a99", "rev": "747927516efcb5e31ba03b7ff32f61f6d47e7d87",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -615,20 +709,82 @@
}, },
"nixpkgs_2": { "nixpkgs_2": {
"locked": { "locked": {
"lastModified": 1698434055, "lastModified": 1653581809,
"narHash": "sha256-Phxi5mUKSoL7A0IYUiYtkI9e8NcGaaV5PJEaJApU1Ko=", "narHash": "sha256-Uvka0V5MTGbeOfWte25+tfRL3moECDh1VwokWSZUdoY=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "1a3c95e3b23b3cdb26750621c08cc2f1560cb883", "rev": "83658b28fe638a170a19b8933aa008b30640fbd1",
"type": "github" "type": "github"
}, },
"original": { "original": {
"owner": "NixOS", "owner": "NixOS",
"ref": "nixos-23.05", "ref": "nixos-unstable",
"repo": "nixpkgs", "repo": "nixpkgs",
"type": "github" "type": "github"
} }
}, },
"nixpkgs_3": {
"locked": {
"lastModified": 1654807842,
"narHash": "sha256-ADymZpr6LuTEBXcy6RtFHcUZdjKTBRTMYwu19WOx17E=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "fc909087cc3386955f21b4665731dbdaceefb1d8",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs_4": {
"locked": {
"lastModified": 1665087388,
"narHash": "sha256-FZFPuW9NWHJteATOf79rZfwfRn5fE0wi9kRzvGfDHPA=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "95fda953f6db2e9496d2682c4fc7b82f959878f7",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs_5": {
"locked": {
"lastModified": 1676726892,
"narHash": "sha256-M7OYVR6dKmzmlebIjybFf3l18S2uur8lMyWWnHQooLY=",
"owner": "angerman",
"repo": "nixpkgs",
"rev": "729469087592bdea58b360de59dadf6d58714c42",
"type": "github"
},
"original": {
"owner": "angerman",
"ref": "release-22.11",
"repo": "nixpkgs",
"type": "github"
}
},
"nosys": {
"locked": {
"lastModified": 1667881534,
"narHash": "sha256-FhwJ15uPLRsvaxtt/bNuqE/ykMpNAPF0upozFKhTtXM=",
"owner": "divnix",
"repo": "nosys",
"rev": "2d0d5207f6a230e9d0f660903f8db9807b54814f",
"type": "github"
},
"original": {
"owner": "divnix",
"repo": "nosys",
"type": "github"
}
},
"old-ghc-nix": { "old-ghc-nix": {
"flake": false, "flake": false,
"locked": { "locked": {
@ -651,21 +807,17 @@
"flake-utils": "flake-utils", "flake-utils": "flake-utils",
"hackage": "hackage", "hackage": "hackage",
"haskellNix": "haskellNix", "haskellNix": "haskellNix",
"mac2ios": "mac2ios", "nixpkgs": "nixpkgs_5"
"nixpkgs": [
"haskellNix",
"nixpkgs-2305"
]
} }
}, },
"stackage": { "stackage": {
"flake": false, "flake": false,
"locked": { "locked": {
"lastModified": 1699834215, "lastModified": 1677888571,
"narHash": "sha256-g/JKy0BCvJaxPuYDl3QVc4OY8cFEomgG+hW/eEV470M=", "narHash": "sha256-YkhRNOaN6QVagZo1cfykYV8KqkI8/q6r2F5+jypOma4=",
"owner": "input-output-hk", "owner": "input-output-hk",
"repo": "stackage.nix", "repo": "stackage.nix",
"rev": "47aacd04abcce6bad57f43cbbbd133538380248e", "rev": "cb50e6fabdfb2d7e655059039012ad0623f06a27",
"type": "github" "type": "github"
}, },
"original": { "original": {
@ -673,6 +825,113 @@
"repo": "stackage.nix", "repo": "stackage.nix",
"type": "github" "type": "github"
} }
},
"std": {
"inputs": {
"arion": [
"haskellNix",
"tullia",
"std",
"blank"
],
"blank": "blank",
"devshell": "devshell",
"dmerge": "dmerge",
"flake-utils": "flake-utils_4",
"incl": "incl",
"makes": [
"haskellNix",
"tullia",
"std",
"blank"
],
"microvm": [
"haskellNix",
"tullia",
"std",
"blank"
],
"n2c": "n2c",
"nixago": "nixago",
"nixpkgs": "nixpkgs_4",
"nosys": "nosys",
"yants": "yants"
},
"locked": {
"lastModified": 1674526466,
"narHash": "sha256-tMTaS0bqLx6VJ+K+ZT6xqsXNpzvSXJTmogkraBGzymg=",
"owner": "divnix",
"repo": "std",
"rev": "516387e3d8d059b50e742a2ff1909ed3c8f82826",
"type": "github"
},
"original": {
"owner": "divnix",
"repo": "std",
"type": "github"
}
},
"tullia": {
"inputs": {
"nix-nomad": "nix-nomad",
"nix2container": "nix2container",
"nixpkgs": [
"haskellNix",
"nixpkgs"
],
"std": "std"
},
"locked": {
"lastModified": 1675695930,
"narHash": "sha256-B7rEZ/DBUMlK1AcJ9ajnAPPxqXY6zW2SBX+51bZV0Ac=",
"owner": "input-output-hk",
"repo": "tullia",
"rev": "621365f2c725608f381b3ad5b57afef389fd4c31",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "tullia",
"type": "github"
}
},
"utils": {
"locked": {
"lastModified": 1653893745,
"narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"yants": {
"inputs": {
"nixpkgs": [
"haskellNix",
"tullia",
"std",
"nixpkgs"
]
},
"locked": {
"lastModified": 1667096281,
"narHash": "sha256-wRRec6ze0gJHmGn6m57/zhz/Kdvp9HS4Nl5fkQ+uIuA=",
"owner": "divnix",
"repo": "yants",
"rev": "d18f356ec25cb94dc9c275870c3a7927a10f8c3c",
"type": "github"
},
"original": {
"owner": "divnix",
"repo": "yants",
"type": "github"
}
} }
}, },
"root": "root", "root": "root",

288
flake.nix
View file

@ -1,15 +1,15 @@
{ {
description = "nix flake for simplex-chat"; description = "nix flake for simplex-chat";
inputs.nixpkgs.url = "github:angerman/nixpkgs/release-22.11";
inputs.haskellNix.url = "github:input-output-hk/haskell.nix/armv7a"; inputs.haskellNix.url = "github:input-output-hk/haskell.nix/armv7a";
inputs.nixpkgs.follows = "haskellNix/nixpkgs-2305"; inputs.haskellNix.inputs.nixpkgs.follows = "nixpkgs";
inputs.mac2ios.url = "github:zw3rk/mobile-core-tools";
inputs.hackage = { inputs.hackage = {
url = "github:input-output-hk/hackage.nix"; url = "github:input-output-hk/hackage.nix";
flake = false; flake = false;
}; };
inputs.haskellNix.inputs.hackage.follows = "hackage"; inputs.haskellNix.inputs.hackage.follows = "hackage";
inputs.flake-utils.url = "github:numtide/flake-utils"; inputs.flake-utils.url = "github:numtide/flake-utils";
outputs = { self, haskellNix, nixpkgs, flake-utils, mac2ios, ... }: outputs = { self, haskellNix, nixpkgs, flake-utils, ... }:
let systems = [ "x86_64-linux" "x86_64-darwin" "aarch64-linux" "aarch64-darwin" ]; in let systems = [ "x86_64-linux" "x86_64-darwin" "aarch64-linux" "aarch64-darwin" ]; in
flake-utils.lib.eachSystem systems (system: flake-utils.lib.eachSystem systems (system:
# this android26 overlay makes the pkgsCross.{aarch64-android,armv7a-android-prebuilt} to set stdVer to 26 (Android 8). # this android26 overlay makes the pkgsCross.{aarch64-android,armv7a-android-prebuilt} to set stdVer to 26 (Android 8).
@ -30,8 +30,8 @@
# `appendOverlays` with a singleton is identical to `extend`. # `appendOverlays` with a singleton is identical to `extend`.
let pkgs = haskellNix.legacyPackages.${system}.appendOverlays [android26]; in let pkgs = haskellNix.legacyPackages.${system}.appendOverlays [android26]; in
let drv' = { extra-modules, pkgs', ... }: pkgs'.haskell-nix.project { let drv' = { extra-modules, pkgs', ... }: pkgs'.haskell-nix.project {
compiler-nix-name = "ghc963"; compiler-nix-name = "ghc8107";
index-state = "2023-10-20T00:00:00Z"; index-state = "2023-10-06T00:00:00Z";
# We need this, to specify we want the cabal project. # We need this, to specify we want the cabal project.
# If the stack.yaml was dropped, this would not be necessary. # If the stack.yaml was dropped, this would not be necessary.
projectFileName = "cabal.project"; projectFileName = "cabal.project";
@ -40,12 +40,9 @@
src = ./.; src = ./.;
}; };
sha256map = import ./scripts/nix/sha256map.nix; sha256map = import ./scripts/nix/sha256map.nix;
modules = [ modules = [{
({ pkgs, lib, ...}: lib.mkIf (!pkgs.stdenv.hostPlatform.isWindows) {
# This patch adds `dl` as an extra-library to direct-sqlciper, which is needed
# on pretty much all unix platforms, but then blows up on windows m(
packages.direct-sqlcipher.patches = [ ./scripts/nix/direct-sqlcipher-2.3.27.patch ]; packages.direct-sqlcipher.patches = [ ./scripts/nix/direct-sqlcipher-2.3.27.patch ];
}) }
({ pkgs,lib, ... }: lib.mkIf (pkgs.stdenv.hostPlatform.isAndroid) { ({ pkgs,lib, ... }: lib.mkIf (pkgs.stdenv.hostPlatform.isAndroid) {
packages.simplex-chat.components.library.ghcOptions = [ "-pie" ]; packages.simplex-chat.components.library.ghcOptions = [ "-pie" ];
})] ++ extra-modules; })] ++ extra-modules;
@ -77,11 +74,6 @@
find ${pkgs.gmp6.override { withStatic = true; }}/lib -name "*.a" -exec cp {} $out/_pkg \; find ${pkgs.gmp6.override { withStatic = true; }}/lib -name "*.a" -exec cp {} $out/_pkg \;
# There is no static libc # There is no static libc
${pkgs.tree}/bin/tree $out/_pkg ${pkgs.tree}/bin/tree $out/_pkg
for pkg in $out/_pkg/*.a; do
chmod +w $pkg
${mac2ios.packages.${system}.mac2ios}/bin/mac2ios $pkg
chmod -w $pkg
done
(cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/${bundleName}.zip *) (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/${bundleName}.zip *)
rm -fR $out/_pkg rm -fR $out/_pkg
mkdir -p $out/nix-support mkdir -p $out/nix-support
@ -127,149 +119,13 @@
hardeningDisable = [ "fortify" ]; hardeningDisable = [ "fortify" ];
} }
);in { );in {
# STATIC x86_64-linux
"${pkgs.pkgsCross.musl64.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.musl64).simplex-chat.components.exes.simplex-chat; "${pkgs.pkgsCross.musl64.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.musl64).simplex-chat.components.exes.simplex-chat;
# STATIC i686-linux "${pkgs.pkgsCross.musl32.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.musl32).simplex-chat.components.exes.simplex-chat;
"${pkgs.pkgsCross.musl32.hostPlatform.system}-static:exe:simplex-chat" = (drv' {
pkgs' = pkgs.pkgsCross.musl32;
extra-modules = [{
# 32 bit patches
packages.basement.patches = [
./scripts/nix/basement-pr-573.patch
];
packages.memory.patches = [
./scripts/nix/memory-pr-99.patch
];
}];
}).simplex-chat.components.exes.simplex-chat;
# WINDOWS x86_64-mingwW64
"${pkgs.pkgsCross.mingwW64.hostPlatform.system}:exe:simplex-chat" = (drv' {
pkgs' = pkgs.pkgsCross.mingwW64;
extra-modules = [{
packages.direct-sqlcipher.flags.openssl = true;
packages.bitvec.flags.simd = false;
packages.direct-sqlcipher.patches = [
./scripts/nix/direct-sqlcipher-2.3.27-win.patch
];
packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
(pkgs.pkgsCross.mingwW64.openssl) #.override) # { static = true; enableKTLS = false; })
];
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
(pkgs.pkgsCross.mingwW64.openssl) #.override) # { static = true; enableKTLS = false; })
];
packages.unix-time.postPatch = ''
sed -i 's/mingwex//g' unix-time.cabal
'';
}];
}).simplex-chat.components.exes.simplex-chat.override {
postInstall = ''
set -x
${pkgs.tree}/bin/tree $out
mkdir -p $out/_pkg
cp $out/bin/* $out/_pkg
${pkgs.tree}/bin/tree $out/_pkg
(cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/${pkgs.pkgsCross.mingwW64.hostPlatform.system}-simplex-chat.zip *)
rm -fR $out/_pkg
mkdir -p $out/nix-support
echo "file binary-dist \"$(echo $out/*.zip)\"" \
> $out/nix-support/hydra-build-products
'';
};
"${pkgs.pkgsCross.mingwW64.hostPlatform.system}:lib:simplex-chat" = (drv' rec {
pkgs' = pkgs.pkgsCross.mingwW64;
extra-modules = [{
packages.direct-sqlcipher.flags.openssl = true;
# simd will try to read __cpu_model, which we don't expose
# from the rts (yet!).
packages.bitvec.flags.simd = false;
packages.direct-sqlcipher.patches = [
./scripts/nix/direct-sqlcipher-2.3.27-win.patch
];
packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
pkgs.pkgsCross.mingwW64.openssl
];
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
pkgs.pkgsCross.mingwW64.openssl
];
packages.unix-time.postPatch = ''
sed -i 's/mingwex//g' unix-time.cabal
'';
}];
}).simplex-chat.components.library
.override (p: {
# enableShared = false;
setupBuildFlags = p.component.setupBuildFlags ++ map (x: "--ghc-option=${x}") [
"-shared"
"-threaded"
"-o" "libsimplex.dll"
# "-optl-lHSrts_thr"
"-optl-lffi"
# "-optl-static-libgcc"
# We can't do -optl-static-libstdc++ with gcc. g++ might
# but then we are chaning the compiler altogether.
"${./libsimplex.dll.def}"
];
postInstall = ''
set -x
function deps() {
${pkgs.binutils}/bin/strings "$1" | grep '.\.dll'|grep -v -E 'Winsock|ADVAPI32|dbghelp|KERNEL32|msvcrt|ntdll|ole32|RPCRT4|SHELL32|USER32|WINMM|WS2_32|kernel32|GDI32'|grep -v "$1"
}
${pkgs.tree}/bin/tree $out
mkdir -p $out/_pkg
cp libsimplex.dll $out/_pkg
cp libsimplex.dll.a $out/_pkg
mkdir $out/libs
find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.openssl} -name "*.dll" -exec cp {} $out/libs \;
find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.libffi} -name "*.dll" -exec cp {} $out/libs \;
find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.gmp} -name "*.dll" -exec cp {} $out/libs \;
find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.stdenv.cc.cc} -name "*.dll" -exec cp {} $out/libs \;
find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.windows.mcfgthreads} -name "*.dll" -exec cp {} $out/libs \;
pushd $out/_pkg
function copyDeps() {
for dep in $(deps "$1"); do
if [ ! -f "$dep" ]; then
if [ ! -f ../libs/"$dep" ]; then
echo "WARN: $1 -> $dep not found!"
else
cp ../libs/"$dep" .
copyDeps "$dep"
fi
fi
done
}
copyDeps libsimplex.dll
popd
${pkgs.tree}/bin/tree $out/_pkg
(cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/pkg-${pkgs.pkgsCross.mingwW64.hostPlatform.system}-libsimplex.zip *)
rm -fR $out/_pkg
mkdir -p $out/nix-support
echo "file binary-dist \"$(echo $out/*.zip)\"" \
> $out/nix-support/hydra-build-products
'';
});
# "${pkgs.pkgsCross.muslpi.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.muslpi).simplex-chat.components.exes.simplex-chat; # "${pkgs.pkgsCross.muslpi.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.muslpi).simplex-chat.components.exes.simplex-chat;
# STATIC aarch64-linux
"${pkgs.pkgsCross.aarch64-multiplatform-musl.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.aarch64-multiplatform-musl).simplex-chat.components.exes.simplex-chat; "${pkgs.pkgsCross.aarch64-multiplatform-musl.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.aarch64-multiplatform-musl).simplex-chat.components.exes.simplex-chat;
"armv7a-android:lib:support" = (drv android32Pkgs).android-support.components.library.override (p: { "armv7a-android:lib:support" = (drv android32Pkgs).android-support.components.library.override {
smallAddressSpace = true; smallAddressSpace = true; enableShared = false;
# we won't want -dyamic (see aarch64-android:lib:simplex-chat) setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ];
enableShared = false;
# we also do not want to have any dependencies listed (especially no rts!)
enableStatic = false;
# This used to work with 8.10.7...
# setupBuildFlags = p.component.setupBuildFlags ++ map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ];
# ... but now with 9.6+
# we have to do the -shared thing by hand.
postBuild = ''
armv7a-unknown-linux-androideabi-ghc -shared -o libsupport.so \
-optl-Wl,-u,setLineBuffering \
-optl-Wl,-u,pipe_std_to_socket \
dist/build/*.a
'';
postInstall = '' postInstall = ''
mkdir -p $out/_pkg mkdir -p $out/_pkg
@ -282,29 +138,14 @@
echo "file binary-dist \"$(echo $out/*.zip)\"" \ echo "file binary-dist \"$(echo $out/*.zip)\"" \
> $out/nix-support/hydra-build-products > $out/nix-support/hydra-build-products
''; '';
}); };
# The android-support package is at "aarch64-android:lib:support" = (drv androidPkgs).android-support.components.library.override {
# https://github.com/simplex-chat/android-support smallAddressSpace = true; enableShared = false;
"aarch64-android:lib:support" = (drv androidPkgs).android-support.components.library.override (p: { setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ];
smallAddressSpace = true;
# no -dynamic
enableShared = false;
# but also no -staticlib
enableStatic = false;
# we have to do the -shared thing by hand.
postBuild = ''
aarch64-unknown-linux-android-ghc -shared -o libsupport.so \
-optl-Wl,-u,setLineBuffering \
-optl-Wl,-u,pipe_std_to_socket \
dist/build/*.a
'';
postInstall = '' postInstall = ''
mkdir -p $out/_pkg mkdir -p $out/_pkg
cp libsupport.so $out/_pkg cp libsupport.so $out/_pkg
ls -lah $out/_pkg/*
${pkgs.patchelf}/bin/patchelf --remove-needed libunwind.so.1 $out/_pkg/libsupport.so ${pkgs.patchelf}/bin/patchelf --remove-needed libunwind.so.1 $out/_pkg/libsupport.so
(cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/pkg-aarch64-android-libsupport.zip *) (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/pkg-aarch64-android-libsupport.zip *)
rm -fR $out/_pkg rm -fR $out/_pkg
@ -313,11 +154,10 @@
echo "file binary-dist \"$(echo $out/*.zip)\"" \ echo "file binary-dist \"$(echo $out/*.zip)\"" \
> $out/nix-support/hydra-build-products > $out/nix-support/hydra-build-products
''; '';
}); };
"armv7a-android:lib:simplex-chat" = (drv' { "armv7a-android:lib:simplex-chat" = (drv' {
pkgs' = android32Pkgs; pkgs' = android32Pkgs;
extra-modules = [{ extra-modules = [{
packages.text.flags.simdutf = false;
packages.direct-sqlcipher.flags.openssl = true; packages.direct-sqlcipher.flags.openssl = true;
packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [ packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
(android32Pkgs.openssl.override { static = true; enableKTLS = false; }) (android32Pkgs.openssl.override { static = true; enableKTLS = false; })
@ -328,55 +168,13 @@
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [ packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
(android32Pkgs.openssl.override { static = true; enableKTLS = false; }) (android32Pkgs.openssl.override { static = true; enableKTLS = false; })
]; ];
# 32 bit patches
packages.basement.patches = [
./scripts/nix/basement-pr-573.patch
];
packages.memory.patches = [
./scripts/nix/memory-pr-99.patch
];
}]; }];
}).simplex-chat.components.library.override (p: { }).simplex-chat.components.library.override {
smallAddressSpace = true; smallAddressSpace = true; enableShared = false;
# we want -shared, but not -dyanmic, hence `enableShared = false`.
enableShared = false;
# we _do_ want rts, and other libs. Hence `enableStatic = true`.
enableStatic = true;
# for android we build a shared library, passing these arguments is a bit tricky, as # for android we build a shared library, passing these arguments is a bit tricky, as
# we want only the threaded rts (HSrts_thr) and ffi to be linked, but not fed into iserv for # we want only the threaded rts (HSrts_thr) and ffi to be linked, but not fed into iserv for
# template haskell cross compilation. Thus we just pass them as linker options (-optl). # template haskell cross compilation. Thus we just pass them as linker options (-optl).
setupBuildFlags = p.component.setupBuildFlags setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsimplex.so" "-optl-lHSrts_thr" "-optl-lffi"];
# flags to tell GHC we want to produce a -shared object, and we want to also link
# - the ffi library (ffi)
++ map (x: "--ghc-option=${x}") [
"-shared" "-o" "libsimplex.so"
"-threaded"
# "-debug"
"-optl-lffi"
]
# This is fairly idiotic. LLD will strip out foreign exported
# symbols (a GHC bug? Codegen bug?). So we need to pass `-u <sym>`
# to ensure they stay in the produced library. Having them
# _undefined_ and _lazy_ (lld will tell with -y <sym> that the
# symbol is lazy), makes them _defined_. m(
++ map (sym: "--ghc-option=-optl-Wl,-u,${sym}") [
"chat_close_store"
"chat_decrypt_file"
"chat_decrypt_media"
"chat_encrypt_file"
"chat_encrypt_media"
"chat_migrate_init"
"chat_parse_markdown"
"chat_parse_server"
"chat_password_hash"
"chat_read_file"
"chat_recv_msg"
"chat_recv_msg_wait"
"chat_send_cmd"
"chat_send_remote_cmd"
"chat_valid_name"
"chat_write_file"
];
postInstall = '' postInstall = ''
set -x set -x
${pkgs.tree}/bin/tree $out ${pkgs.tree}/bin/tree $out
@ -420,11 +218,10 @@
echo "file binary-dist \"$(echo $out/*.zip)\"" \ echo "file binary-dist \"$(echo $out/*.zip)\"" \
> $out/nix-support/hydra-build-products > $out/nix-support/hydra-build-products
''; '';
}); };
"aarch64-android:lib:simplex-chat" = (drv' { "aarch64-android:lib:simplex-chat" = (drv' {
pkgs' = androidPkgs; pkgs' = androidPkgs;
extra-modules = [{ extra-modules = [{
packages.text.flags.simdutf = false;
packages.direct-sqlcipher.flags.openssl = true; packages.direct-sqlcipher.flags.openssl = true;
packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [ packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
(androidPkgs.openssl.override { static = true; }) (androidPkgs.openssl.override { static = true; })
@ -436,49 +233,12 @@
(androidPkgs.openssl.override { static = true; }) (androidPkgs.openssl.override { static = true; })
]; ];
}]; }];
}).simplex-chat.components.library.override (p: { }).simplex-chat.components.library.override {
smallAddressSpace = true; smallAddressSpace = true; enableShared = false;
# we do not want a dynamically linked object, even though we _do_
# want to produce a _shared_ object. But `shared` implied -dyanmic
# with cabal, so we disable and pass `-shared` explicitly.
enableShared = false;
# we do want static (e.g. pass all dependencies in, so we get -staticlib)
enableStatic = true;
# for android we build a shared library, passing these arguments is a bit tricky, as # for android we build a shared library, passing these arguments is a bit tricky, as
# we want only the threaded rts (HSrts_thr) and ffi to be linked, but not fed into iserv for # we want only the threaded rts (HSrts_thr) and ffi to be linked, but not fed into iserv for
# template haskell cross compilation. Thus we just pass them as linker options (-optl). # template haskell cross compilation. Thus we just pass them as linker options (-optl).
setupBuildFlags = p.component.setupBuildFlags setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsimplex.so" "-optl-lHSrts_thr" "-optl-lffi"];
# flags to tell GHC we want to produce a -shared object, and we want to also link
# - the ffi library (ffi)
++ map (x: "--ghc-option=${x}") [
"-shared" "-o" "libsimplex.so"
"-threaded"
# "-debug"
"-optl-lffi"
]
# This is fairly idiotic. LLD will strip out foreign exported
# symbols (a GHC bug? Codegen bug?). So we need to pass `-u <sym>`
# to ensure they stay in the produced library. Having them
# _undefined_ and _lazy_ (lld will tell with -y <sym> that the
# symbol is lazy), makes them _defined_. m(
++ map (sym: "--ghc-option=-optl-Wl,-u,${sym}") [
"chat_close_store"
"chat_decrypt_file"
"chat_decrypt_media"
"chat_encrypt_file"
"chat_encrypt_media"
"chat_migrate_init"
"chat_parse_markdown"
"chat_parse_server"
"chat_password_hash"
"chat_read_file"
"chat_recv_msg"
"chat_recv_msg_wait"
"chat_send_cmd"
"chat_send_remote_cmd"
"chat_valid_name"
"chat_write_file"
];
postInstall = '' postInstall = ''
set -x set -x
${pkgs.tree}/bin/tree $out ${pkgs.tree}/bin/tree $out
@ -522,7 +282,7 @@
echo "file binary-dist \"$(echo $out/*.zip)\"" \ echo "file binary-dist \"$(echo $out/*.zip)\"" \
> $out/nix-support/hydra-build-products > $out/nix-support/hydra-build-products
''; '';
}); };
}; };
# builds for iOS and iOS simulator # builds for iOS and iOS simulator

View file

@ -131,7 +131,7 @@ tests:
- async == 2.2.* - async == 2.2.*
- deepseq == 1.4.* - deepseq == 1.4.*
- generic-random == 1.5.* - generic-random == 1.5.*
- hspec == 2.11.* - hspec == 2.7.*
- network == 3.1.* - network == 3.1.*
- silently == 1.2.* - silently == 1.2.*
- stm == 2.5.* - stm == 2.5.*

View file

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

View file

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

View file

@ -8,7 +8,7 @@ function readlink() {
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.3 GHC_VERSION=8.10.7
if [ "$ARCH" == "aarch64" ]; then if [ "$ARCH" == "aarch64" ]; then
COMPOSE_ARCH=arm64 COMPOSE_ARCH=arm64
@ -21,7 +21,7 @@ cd $root_dir
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

View file

@ -5,14 +5,13 @@ set -e
OS=mac OS=mac
ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}" ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}"
COMPOSE_ARCH=$ARCH COMPOSE_ARCH=$ARCH
GHC_VERSION=9.6.3 GHC_VERSION=8.10.7
if [ "$ARCH" == "arm64" ]; then if [ "$ARCH" == "arm64" ]; then
ARCH=aarch64 ARCH=aarch64
else else
COMPOSE_ARCH=x64 COMPOSE_ARCH=x64
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)
@ -20,26 +19,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 || true mkdir deps 2> /dev/null || true
# 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`
@ -80,8 +66,6 @@ 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`
cd - cd -

View file

@ -1,242 +0,0 @@
From 38be2c93acb6f459d24ed6c626981c35ccf44095 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Thu, 16 Feb 2023 15:40:45 +0100
Subject: [PATCH] Fix build on 32-bit architectures
---
Basement/Bits.hs | 4 ++++
Basement/From.hs | 24 -----------------------
Basement/Numerical/Additive.hs | 4 ++++
Basement/Numerical/Conversion.hs | 20 +++++++++++++++++++
Basement/PrimType.hs | 6 +++++-
Basement/Types/OffsetSize.hs | 22 +++++++++++++++++++--
6 files changed, 53 insertions(+), 27 deletions(-)
diff --git a/Basement/Bits.hs b/Basement/Bits.hs
index 7eeea0f5..24520ed7 100644
--- a/Basement/Bits.hs
+++ b/Basement/Bits.hs
@@ -54,8 +54,12 @@ import GHC.Int
import Basement.Compat.Primitive
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+import GHC.Exts
+#else
import GHC.IntWord64
#endif
+#endif
-- | operation over finite bits
class FiniteBitsOps bits where
diff --git a/Basement/From.hs b/Basement/From.hs
index 7bbe141c..80014b3e 100644
--- a/Basement/From.hs
+++ b/Basement/From.hs
@@ -272,23 +272,11 @@ instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)
tryFrom = BlockN.toBlockN . UArray.toBlock . BoxArray.mapToUnboxed id
instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where
-#if __GLASGOW_HASKELL__ >= 904
- from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# (GHC.Prim.word64ToWord# w)))
-#else
from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w))
-#endif
instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where
-#if __GLASGOW_HASKELL__ >= 904
- from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# (GHC.Prim.word64ToWord# w)))
-#else
from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w))
-#endif
instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where
-#if __GLASGOW_HASKELL__ >= 904
- from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# (GHC.Prim.word64ToWord# w)))
-#else
from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w))
-#endif
instance From (Zn64 n) Word64 where
from = unZn64
instance From (Zn64 n) Word128 where
@@ -297,23 +285,11 @@ instance From (Zn64 n) Word256 where
from = from . unZn64
instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where
-#if __GLASGOW_HASKELL__ >= 904
- from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# (GHC.Prim.word64ToWord# w)))
-#else
from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w))
-#endif
instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where
-#if __GLASGOW_HASKELL__ >= 904
- from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# (GHC.Prim.word64ToWord# w)))
-#else
from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w))
-#endif
instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where
-#if __GLASGOW_HASKELL__ >= 904
- from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# (GHC.Prim.word64ToWord# w)))
-#else
from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w))
-#endif
instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) Word64 where
from = naturalToWord64 . unZn
instance (KnownNat n, NatWithinBound Word128 n) => From (Zn n) Word128 where
diff --git a/Basement/Numerical/Additive.hs b/Basement/Numerical/Additive.hs
index d0dfb973..8ab65aa0 100644
--- a/Basement/Numerical/Additive.hs
+++ b/Basement/Numerical/Additive.hs
@@ -30,8 +30,12 @@ import qualified Basement.Types.Word128 as Word128
import qualified Basement.Types.Word256 as Word256
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+import GHC.Exts
+#else
import GHC.IntWord64
#endif
+#endif
-- | Represent class of things that can be added together,
-- contains a neutral element and is commutative.
diff --git a/Basement/Numerical/Conversion.hs b/Basement/Numerical/Conversion.hs
index db502c07..fddc8232 100644
--- a/Basement/Numerical/Conversion.hs
+++ b/Basement/Numerical/Conversion.hs
@@ -26,8 +26,12 @@ import GHC.Word
import Basement.Compat.Primitive
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+import GHC.Exts
+#else
import GHC.IntWord64
#endif
+#endif
intToInt64 :: Int -> Int64
#if WORD_SIZE_IN_BITS == 64
@@ -96,11 +100,22 @@ int64ToWord64 (I64# i) = W64# (int64ToWord64# i)
#endif
#if WORD_SIZE_IN_BITS == 64
+#if __GLASGOW_HASKELL__ >= 904
+word64ToWord# :: Word64# -> Word#
+word64ToWord# i = word64ToWord# i
+#else
word64ToWord# :: Word# -> Word#
word64ToWord# i = i
+#endif
{-# INLINE word64ToWord# #-}
#endif
+#if WORD_SIZE_IN_BITS < 64
+word64ToWord32# :: Word64# -> Word32#
+word64ToWord32# i = wordToWord32# (word64ToWord# i)
+{-# INLINE word64ToWord32# #-}
+#endif
+
-- | 2 Word32s
data Word32x2 = Word32x2 {-# UNPACK #-} !Word32
{-# UNPACK #-} !Word32
@@ -113,9 +128,14 @@ word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# (G
word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# w64 32#))) (W32# (wordToWord32# w64))
#endif
#else
+#if __GLASGOW_HASKELL__ >= 904
+word64ToWord32s :: Word64 -> Word32x2
+word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord32# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord32# w64))
+#else
word64ToWord32s :: Word64 -> Word32x2
word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64))
#endif
+#endif
wordToChar :: Word -> Char
wordToChar (W# word) = C# (chr# (word2Int# word))
diff --git a/Basement/PrimType.hs b/Basement/PrimType.hs
index f8ca2926..a888ec91 100644
--- a/Basement/PrimType.hs
+++ b/Basement/PrimType.hs
@@ -54,7 +54,11 @@ import Basement.Nat
import qualified Prelude (quot)
#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
+#if __GLASGOW_HASKELL__ >= 904
+import GHC.Exts
+#else
+import GHC.IntWord64
+#endif
#endif
#ifdef FOUNDATION_BOUNDS_CHECK
diff --git a/Basement/Types/OffsetSize.hs b/Basement/Types/OffsetSize.hs
index cd944927..1ea80dad 100644
--- a/Basement/Types/OffsetSize.hs
+++ b/Basement/Types/OffsetSize.hs
@@ -70,8 +70,12 @@ import Data.List (foldl')
import qualified Prelude
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+import GHC.Exts
+#else
import GHC.IntWord64
#endif
+#endif
-- | File size in bytes
newtype FileSize = FileSize Word64
@@ -225,20 +229,26 @@ countOfRoundUp alignment (CountOf n) = CountOf ((n + (alignment-1)) .&. compleme
csizeOfSize :: CountOf Word8 -> CSize
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+csizeOfSize (CountOf (I# sz)) = CSize (W32# (wordToWord32# (int2Word# sz)))
+#else
csizeOfSize (CountOf (I# sz)) = CSize (W32# (int2Word# sz))
+#endif
#else
#if __GLASGOW_HASKELL__ >= 904
csizeOfSize (CountOf (I# sz)) = CSize (W64# (wordToWord64# (int2Word# sz)))
-
#else
csizeOfSize (CountOf (I# sz)) = CSize (W64# (int2Word# sz))
-
#endif
#endif
csizeOfOffset :: Offset8 -> CSize
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+csizeOfOffset (Offset (I# sz)) = CSize (W32# (wordToWord32# (int2Word# sz)))
+#else
csizeOfOffset (Offset (I# sz)) = CSize (W32# (int2Word# sz))
+#endif
#else
#if __GLASGOW_HASKELL__ >= 904
csizeOfOffset (Offset (I# sz)) = CSize (W64# (wordToWord64# (int2Word# sz)))
@@ -250,7 +260,11 @@ csizeOfOffset (Offset (I# sz)) = CSize (W64# (int2Word# sz))
sizeOfCSSize :: CSsize -> CountOf Word8
sizeOfCSSize (CSsize (-1)) = error "invalid size: CSSize is -1"
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# (int32ToInt# sz))
+#else
sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# sz)
+#endif
#else
#if __GLASGOW_HASKELL__ >= 904
sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# (int64ToInt# sz))
@@ -261,7 +275,11 @@ sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# sz)
sizeOfCSize :: CSize -> CountOf Word8
#if WORD_SIZE_IN_BITS < 64
+#if __GLASGOW_HASKELL__ >= 904
+sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# (word32ToWord# sz)))
+#else
sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# sz))
+#endif
#else
#if __GLASGOW_HASKELL__ >= 904
sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# (word64ToWord# sz)))

View file

@ -1,12 +0,0 @@
diff --git a/direct-sqlcipher.cabal b/direct-sqlcipher.cabal
index 728ba3e..c63745e 100644
--- a/direct-sqlcipher.cabal
+++ b/direct-sqlcipher.cabal
@@ -84,6 +84,8 @@ library
cc-options: -DSQLITE_TEMP_STORE=2
-DSQLITE_HAS_CODEC
+ extra-libraries: ws2_32
+
if !os(windows) && !os(android)
extra-libraries: pthread

View file

@ -1,36 +0,0 @@
From 2738929ce15b4c8704bbbac24a08539b5d4bf30e Mon Sep 17 00:00:00 2001
From: sternenseemann <sternenseemann@systemli.org>
Date: Mon, 14 Aug 2023 10:51:30 +0200
Subject: [PATCH] Data.Memory.Internal.CompatPrim64: fix 32 bit with GHC >= 9.4
Since 9.4, GHC.Prim exports Word64# operations like timesWord64# even on
i686 whereas GHC.IntWord64 no longer exists. Therefore, we can just use
the ready made solution.
Closes #98, as it should be the better solution.
---
Data/Memory/Internal/CompatPrim64.hs | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/Data/Memory/Internal/CompatPrim64.hs b/Data/Memory/Internal/CompatPrim64.hs
index b9eef8a..a134c88 100644
--- a/Data/Memory/Internal/CompatPrim64.hs
+++ b/Data/Memory/Internal/CompatPrim64.hs
@@ -150,6 +150,7 @@ w64# :: Word# -> Word# -> Word# -> Word64#
w64# w _ _ = w
#elif WORD_SIZE_IN_BITS == 32
+#if __GLASGOW_HASKELL__ < 904
import GHC.IntWord64
import GHC.Prim (Word#)
@@ -158,6 +159,9 @@ timesWord64# a b =
let !ai = word64ToInt64# a
!bi = word64ToInt64# b
in int64ToWord64# (timesInt64# ai bi)
+#else
+import GHC.Prim
+#endif
w64# :: Word# -> Word# -> Word# -> Word64#
w64# _ hw lw =

View file

@ -578,7 +578,7 @@ test-suite simplex-chat-test
, exceptions ==0.10.* , exceptions ==0.10.*
, filepath ==1.4.* , filepath ==1.4.*
, generic-random ==1.5.* , generic-random ==1.5.*
, hspec ==2.11.* , hspec ==2.7.*
, http-types ==0.12.* , http-types ==0.12.*
, http2 >=4.2.2 && <4.3 , http2 >=4.2.2 && <4.3
, memory ==0.18.* , memory ==0.18.*

View file

@ -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 #-}
@ -273,8 +272,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
@ -301,9 +300,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
@ -457,15 +456,15 @@ processChatCommand = \case
chooseServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> m (NonEmpty (ProtoServerWithAuth p), [ServerCfg p]) chooseServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> m (NonEmpty (ProtoServerWithAuth p), [ServerCfg p])
chooseServers protocol chooseServers protocol
| sameServers = | sameServers =
asks currentUser >>= readTVarIO >>= \case asks currentUser >>= readTVarIO >>= \case
Nothing -> throwChatError CENoActiveUser Nothing -> throwChatError CENoActiveUser
Just user -> do Just user -> do
servers <- withStore' (`getProtocolServers` user) servers <- withStore' (`getProtocolServers` user)
cfg <- asks config cfg <- asks config
pure (activeAgentServers cfg protocol servers, servers) pure (activeAgentServers cfg protocol servers, servers)
| otherwise = do | otherwise = do
defServers <- asks $ defaultServers . config defServers <- asks $ defaultServers . config
pure (cfgServers protocol defServers, []) pure (cfgServers protocol defServers, [])
storeServers user servers = storeServers user servers =
unless (null servers) . withStore $ unless (null servers) . withStore $
\db -> overwriteProtocolServers db user servers \db -> overwriteProtocolServers db user servers
@ -695,18 +694,18 @@ processChatCommand = \case
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice | isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles | not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
| otherwise = do | otherwise = do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms) (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer) (msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
withStore' $ \db -> withStore' $ \db ->
forM_ sentToMembers $ \GroupMember {groupMemberId} -> forM_ sentToMembers $ \GroupMember {groupMemberId} ->
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
mapM_ (sendGroupFileInline ms sharedMsgId) ft_ mapM_ (sendGroupFileInline ms sharedMsgId) ft_
forM_ (timed_ >>= timedDeleteAt') $ forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f)) notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
@ -761,11 +760,11 @@ processChatCommand = \case
quoteContent qmc ciFile_ quoteContent qmc ciFile_
| replaceContent = MCText qTextOrFile | replaceContent = MCText qTextOrFile
| otherwise = case qmc of | otherwise = case qmc of
MCImage _ image -> MCImage qTextOrFile image MCImage _ image -> MCImage qTextOrFile image
MCFile _ -> MCFile qTextOrFile MCFile _ -> MCFile qTextOrFile
-- consider same for voice messages -- consider same for voice messages
-- MCVoice _ voice -> MCVoice qTextOrFile voice -- MCVoice _ voice -> MCVoice qTextOrFile voice
_ -> qmc _ -> qmc
where where
-- if the message we're quoting with is one of the "large" MsgContents -- if the message we're quoting with is one of the "large" MsgContents
-- we replace the quote's content with MCText -- we replace the quote's content with MCText
@ -994,7 +993,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
@ -1020,13 +1019,13 @@ processChatCommand = \case
delete ct delete ct
| directOrUsed ct = pure [] | directOrUsed ct = pure []
| otherwise = | otherwise =
withStore' (\db -> checkContactHasGroups db user ct) >>= \case withStore' (\db -> checkContactHasGroups db user ct) >>= \case
Just _ -> pure [] Just _ -> pure []
Nothing -> do Nothing -> do
conns <- withStore' $ \db -> getContactConnections db userId ct conns <- withStore' $ \db -> getContactConnections db userId ct
withStore' (\db -> setContactDeleted db user ct) withStore' (\db -> setContactDeleted db user ct)
`catchChatError` (toView . CRChatError (Just user)) `catchChatError` (toView . CRChatError (Just user))
pure $ map aConnId conns pure $ map aConnId conns
CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of
CTDirect -> do CTDirect -> do
@ -1255,9 +1254,10 @@ processChatCommand = \case
m <- withStore $ \db -> do m <- withStore $ \db -> do
liftIO $ updateGroupMemberSettings db user gId gMemberId settings liftIO $ updateGroupMemberSettings db user gId gMemberId settings
getGroupMember db user gId gMemberId getGroupMember db user gId gMemberId
when (memberActive m) $ forM_ (memberConnId m) $ \connId -> do when (memberActive m) $
let ntfOn = showMessages $ memberSettings m forM_ (memberConnId m) $ \connId -> do
withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user)) let ntfOn = showMessages $ memberSettings m
withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user))
ok user ok user
APIContactInfo contactId -> withUser $ \user@User {userId} -> do APIContactInfo contactId -> withUser $ \user@User {userId} -> do
-- [incognito] print user's incognito profile for this contact -- [incognito] print user's incognito profile for this contact
@ -1328,8 +1328,8 @@ processChatCommand = \case
Just SecurityCode {securityCode} Just SecurityCode {securityCode}
| sameVerificationCode code securityCode -> pure ct | sameVerificationCode code securityCode -> pure ct
| otherwise -> do | otherwise -> do
withStore' $ \db -> setConnectionVerified db user connId Nothing withStore' $ \db -> setConnectionVerified db user connId Nothing
pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}}
_ -> pure ct _ -> pure ct
pure $ CRContactCode user ct' code pure $ CRContactCode user ct' code
Nothing -> throwChatError $ CEContactNotActive ct Nothing -> throwChatError $ CEContactNotActive ct
@ -1342,8 +1342,8 @@ processChatCommand = \case
Just SecurityCode {securityCode} Just SecurityCode {securityCode}
| sameVerificationCode code securityCode -> pure m | sameVerificationCode code securityCode -> pure m
| otherwise -> do | otherwise -> do
withStore' $ \db -> setConnectionVerified db user connId Nothing withStore' $ \db -> setConnectionVerified db user connId Nothing
pure (m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} pure (m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}}
_ -> pure m _ -> pure m
pure $ CRGroupMemberCode user g m' code pure $ CRGroupMemberCode user g m' code
_ -> throwChatError CEGroupMemberNotActive _ -> throwChatError CEGroupMemberNotActive
@ -1622,12 +1622,12 @@ processChatCommand = \case
pure $ CRSentGroupInvitation user gInfo contact member pure $ CRSentGroupInvitation user gInfo contact member
Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole} Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole}
| memberStatus == GSMemInvited -> do | memberStatus == GSMemInvited -> do
unless (mRole == memRole) $ withStore' $ \db -> updateGroupMemberRole db user member memRole unless (mRole == memRole) $ withStore' $ \db -> updateGroupMemberRole db user member memRole
withStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case withStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case
Just cReq -> do Just cReq -> do
sendInvitation member {memberRole = memRole} cReq sendInvitation member {memberRole = memRole} cReq
pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole} pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole}
Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName
| otherwise -> throwChatError $ CEGroupDuplicateMember cName | otherwise -> throwChatError $ CEGroupDuplicateMember cName
APIJoinGroup groupId -> withUser $ \user@User {userId} -> do APIJoinGroup groupId -> withUser $ \user@User {userId} -> do
withChatLock "joinGroup" . procCmd $ do withChatLock "joinGroup" . procCmd $ do
@ -1639,7 +1639,7 @@ processChatCommand = \case
case activeConn of case activeConn of
Just Connection {peerChatVRange} -> do Just Connection {peerChatVRange} -> 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
@ -1796,7 +1796,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
@ -1884,21 +1884,21 @@ processChatCommand = \case
FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
| not (null fts) && all fileCancelledOrCompleteSMP fts -> | not (null fts) && all fileCancelledOrCompleteSMP fts ->
throwChatError $ CEFileCancel fileId "file transfer is complete" throwChatError $ CEFileCancel fileId "file transfer is complete"
| otherwise -> do | otherwise -> do
fileAgentConnIds <- cancelSndFile user ftm fts True fileAgentConnIds <- cancelSndFile user ftm fts True
deleteAgentConnectionsAsync user fileAgentConnIds deleteAgentConnectionsAsync user fileAgentConnIds
sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
withStore (\db -> getChatRefByFileId db user fileId) >>= \case withStore (\db -> getChatRefByFileId db user fileId) >>= \case
ChatRef CTDirect contactId -> do ChatRef CTDirect contactId -> do
contact <- withStore $ \db -> getContact db user contactId contact <- withStore $ \db -> getContact db user contactId
void . sendDirectContactMessage contact $ XFileCancel sharedMsgId void . sendDirectContactMessage contact $ XFileCancel sharedMsgId
ChatRef CTGroup groupId -> do ChatRef CTGroup groupId -> do
Group gInfo ms <- withStore $ \db -> getGroup db user groupId Group gInfo ms <- withStore $ \db -> getGroup db user groupId
void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId
_ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
ci <- withStore $ \db -> getChatItemByFileId db user fileId ci <- withStore $ \db -> getChatItemByFileId db user fileId
pure $ CRSndFileCancelled user ci ftm fts pure $ CRSndFileCancelled user ci ftm fts
where where
fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} = fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} =
s == FSCancelled || (s == FSComplete && isNothing xftpSndFile) s == FSCancelled || (s == FSComplete && isNothing xftpSndFile)
@ -1906,23 +1906,23 @@ processChatCommand = \case
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
| rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete" | rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete"
| otherwise -> case xftpRcvFile of | otherwise -> case xftpRcvFile of
Nothing -> do Nothing -> do
cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user)
ci <- withStore $ \db -> getChatItemByFileId db user fileId ci <- withStore $ \db -> getChatItemByFileId db user fileId
pure $ CRRcvFileCancelled user ci ftr pure $ CRRcvFileCancelled user ci ftr
Just XFTPRcvFile {agentRcvFileId} -> do Just XFTPRcvFile {agentRcvFileId} -> do
forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do
fsFilePath <- toFSFilePath filePath fsFilePath <- toFSFilePath filePath
liftIO $ removeFile fsFilePath `catchAll_` pure () liftIO $ removeFile fsFilePath `catchAll_` pure ()
forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) -> forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) ->
withAgent (`xftpDeleteRcvFile` aFileId) withAgent (`xftpDeleteRcvFile` aFileId)
ci <- withStore $ \db -> do ci <- withStore $ \db -> do
liftIO $ do liftIO $ do
updateCIFileStatus db user fileId CIFSRcvInvitation updateCIFileStatus db user fileId CIFSRcvInvitation
updateRcvFileStatus db fileId FSNew updateRcvFileStatus db fileId FSNew
updateRcvFileAgentId db fileId Nothing updateRcvFileAgentId db fileId Nothing
getChatItemByFileId db user fileId getChatItemByFileId db user fileId
pure $ CRRcvFileCancelled user ci ftr pure $ CRRcvFileCancelled user ci ftr
FileStatus fileId -> withUser $ \user -> do FileStatus fileId -> withUser $ \user -> do
ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db user fileId ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db user fileId
case file of case file of
@ -1987,8 +1987,7 @@ processChatCommand = \case
DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_ DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_
QuitChat -> liftIO exitSuccess QuitChat -> liftIO exitSuccess
ShowVersion -> do ShowVersion -> do
-- simplexmqCommitQ makes iOS builds crash m( let versionInfo = coreVersionInfo $(simplexmqCommitQ)
let versionInfo = coreVersionInfo ""
chatMigrations <- map upMigration <$> withStore' (Migrations.getCurrent . DB.conn) chatMigrations <- map upMigration <$> withStore' (Migrations.getCurrent . DB.conn)
agentMigrations <- withAgent getAgentMigrations agentMigrations <- withAgent getAgentMigrations
pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations} pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations}
@ -2134,7 +2133,7 @@ processChatCommand = \case
xftpCfg <- readTVarIO =<< asks userXFTPFileConfig xftpCfg <- readTVarIO =<< asks userXFTPFileConfig
fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs
when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f
let chunks = -((-fileSize) `div` fileChunkSize) let chunks = - ((- fileSize) `div` fileChunkSize)
fileInline = inlineFileMode mc inlineFiles chunks n fileInline = inlineFileMode mc inlineFiles chunks n
fileMode = case xftpCfg of fileMode = case xftpCfg of
Just cfg Just cfg
@ -2153,18 +2152,18 @@ processChatCommand = \case
updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser
| p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user
| otherwise = do | otherwise = do
when (n /= n') $ checkValidName n' when (n /= n') $ checkValidName n'
-- read contacts before user update to correctly merge preferences -- read contacts before user update to correctly merge preferences
-- [incognito] filter out contacts with whom user has incognito connections -- [incognito] filter out contacts with whom user has incognito connections
contacts <- contacts <-
filter (\ct -> contactReady ct && contactActive ct && not (contactConnIncognito ct)) filter (\ct -> contactReady ct && contactActive ct && not (contactConnIncognito ct))
<$> withStore' (`getUserContacts` user) <$> withStore' (`getUserContacts` user)
user' <- updateUser user' <- updateUser
asks currentUser >>= atomically . (`writeTVar` Just user') asks currentUser >>= atomically . (`writeTVar` Just user')
withChatLock "updateProfile" . procCmd $ do withChatLock "updateProfile" . procCmd $ do
ChatConfig {logLevel} <- asks config ChatConfig {logLevel} <- asks config
summary <- foldM (processAndCount user' logLevel) (UserProfileUpdateSummary 0 0 0 []) contacts summary <- foldM (processAndCount user' logLevel) (UserProfileUpdateSummary 0 0 0 []) contacts
pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary
where where
processAndCount user' ll s@UserProfileUpdateSummary {notChanged, updateSuccesses, updateFailures, changedContacts = cts} ct = do processAndCount user' ll s@UserProfileUpdateSummary {notChanged, updateSuccesses, updateFailures, changedContacts = cts} ct = do
let mergedProfile = userProfileToSend user Nothing $ Just ct let mergedProfile = userProfileToSend user Nothing $ Just ct
@ -2185,16 +2184,16 @@ processChatCommand = \case
updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
| contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct
| otherwise = do | otherwise = do
assertDirectAllowed user MDSnd ct XInfo_ assertDirectAllowed user MDSnd ct XInfo_
ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs' ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs'
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct)
mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct')
when (mergedProfile' /= mergedProfile) $ when (mergedProfile' /= mergedProfile) $
withChatLock "updateProfile" $ do withChatLock "updateProfile" $ do
void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user))
when (directOrUsed ct') $ createSndFeatureItems user ct ct' when (directOrUsed ct') $ createSndFeatureItems user ct ct'
pure $ CRContactPrefsUpdated user ct ct' pure $ CRContactPrefsUpdated user ct ct'
runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse
runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p@GroupProfile {displayName = n}} ms) p'@GroupProfile {displayName = n'} = do runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p@GroupProfile {displayName = n}} ms) p'@GroupProfile {displayName = n'} = do
assertUserGroupRole g GROwner assertUserGroupRole g GROwner
@ -2213,7 +2212,7 @@ processChatCommand = \case
when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName} when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName}
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
@ -2239,15 +2238,15 @@ processChatCommand = \case
Nothing -> throwChatError CENoCurrentCall Nothing -> throwChatError CENoCurrentCall
Just call@Call {contactId} Just call@Call {contactId}
| ctId == contactId -> do | ctId == contactId -> do
call_ <- action user ct call call_ <- action user ct call
case call_ of case call_ of
Just call' -> do Just call' -> do
unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId
atomically $ TM.insert ctId call' calls atomically $ TM.insert ctId call' calls
_ -> do _ -> do
withStore' $ \db -> deleteCalls db user ctId withStore' $ \db -> deleteCalls db user ctId
atomically $ TM.delete ctId calls atomically $ TM.delete ctId calls
ok user ok user
| otherwise -> throwChatError $ CECallContact contactId | otherwise -> throwChatError $ CECallContact contactId
withServerProtocol :: ProtocolTypeI p => SProtocolType p -> (UserProtocol p => m a) -> m a withServerProtocol :: ProtocolTypeI p => SProtocolType p -> (UserProtocol p => m a) -> m a
withServerProtocol p action = case userProtocol p of withServerProtocol p action = case userProtocol p of
@ -2257,7 +2256,7 @@ processChatCommand = \case
forwardFile chatName fileId sendCommand = withUser $ \user -> do forwardFile chatName fileId sendCommand = withUser $ \user -> do
withStore (\db -> getFileTransfer db user fileId) >>= \case withStore (\db -> getFileTransfer db user fileId) >>= \case
FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}, cryptoArgs} -> forward filePath cryptoArgs FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}, cryptoArgs} -> forward filePath cryptoArgs
FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \f -> f.cryptoArgs FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs
_ -> throwChatError CEFileNotReceived {fileId} _ -> throwChatError CEFileNotReceived {fileId}
where where
forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs
@ -2312,12 +2311,12 @@ processChatCommand = \case
setUserPrivacy :: User -> User -> m ChatResponse setUserPrivacy :: User -> User -> m ChatResponse
setUserPrivacy user@User {userId} user'@User {userId = userId'} setUserPrivacy user@User {userId} user'@User {userId = userId'}
| userId == userId' = do | userId == userId' = do
asks currentUser >>= atomically . (`writeTVar` Just user') asks currentUser >>= atomically . (`writeTVar` Just user')
withStore' (`updateUserPrivacy` user') withStore' (`updateUserPrivacy` user')
pure $ CRUserPrivacy {user = user', updatedUser = user'} pure $ CRUserPrivacy {user = user', updatedUser = user'}
| otherwise = do | otherwise = do
withStore' (`updateUserPrivacy` user') withStore' (`updateUserPrivacy` user')
pure $ CRUserPrivacy {user, updatedUser = user'} pure $ CRUserPrivacy {user, updatedUser = user'}
checkDeleteChatUser :: User -> m () checkDeleteChatUser :: User -> m ()
checkDeleteChatUser user@User {userId} = do checkDeleteChatUser user@User {userId} = do
when (activeUser user) $ throwChatError (CECantDeleteActiveUser userId) when (activeUser user) $ throwChatError (CECantDeleteActiveUser userId)
@ -2351,11 +2350,11 @@ processChatCommand = \case
Just (RcvDirectMsgConnection conn ct_) -> do Just (RcvDirectMsgConnection conn ct_) -> do
let Connection {connStatus, contactConnInitiated} = conn let Connection {connStatus, contactConnInitiated} = conn
if if
| connStatus == ConnNew && contactConnInitiated -> | connStatus == ConnNew && contactConnInitiated ->
pure $ CPInvitationLink ILPOwnLink pure $ CPInvitationLink ILPOwnLink
| not (connReady conn) -> | not (connReady conn) ->
pure $ CPInvitationLink (ILPConnecting ct_) pure $ CPInvitationLink (ILPConnecting ct_)
| otherwise -> case ct_ of | otherwise -> case ct_ of
Just ct -> pure $ CPInvitationLink (ILPKnown ct) Just ct -> pure $ CPInvitationLink (ILPKnown ct)
Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact" Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact"
Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
@ -2366,6 +2365,7 @@ processChatCommand = \case
( CRInvitationUri crData {crScheme = CRSSimplex} e2e, ( CRInvitationUri crData {crScheme = CRSSimplex} e2e,
CRInvitationUri crData {crScheme = simplexChat} e2e CRInvitationUri crData {crScheme = simplexChat} e2e
) )
_ -> (cReq, cReq) -- ghc8107
connectPlan user (ACR SCMContact cReq) = do connectPlan user (ACR SCMContact cReq) = do
let CRContactUri ConnReqUriData {crClientData} = cReq let CRContactUri ConnReqUriData {crClientData} = cReq
groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
@ -2402,7 +2402,7 @@ processChatCommand = \case
(Nothing, Just _) -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" (Nothing, Just _) -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
(Just gInfo@GroupInfo {membership}, _) (Just gInfo@GroupInfo {membership}, _)
| not (memberActive membership) && not (memberRemoved membership) -> | not (memberActive membership) && not (memberRemoved membership) ->
pure $ CPGroupLink (GLPConnectingProhibit gInfo_) pure $ CPGroupLink (GLPConnectingProhibit gInfo_)
| memberActive membership -> pure $ CPGroupLink (GLPKnown gInfo) | memberActive membership -> pure $ CPGroupLink (GLPKnown gInfo)
| otherwise -> pure $ CPGroupLink GLPOk | otherwise -> pure $ CPGroupLink GLPOk
where where
@ -2412,6 +2412,7 @@ processChatCommand = \case
( CRContactUri crData {crScheme = CRSSimplex}, ( CRContactUri crData {crScheme = CRSSimplex},
CRContactUri crData {crScheme = simplexChat} CRContactUri crData {crScheme = simplexChat}
) )
_ -> (cReq, cReq) -- ghc8107
cReqHashes :: (ConnReqUriHash, ConnReqUriHash) cReqHashes :: (ConnReqUriHash, ConnReqUriHash)
cReqHashes = bimap hash hash cReqSchemas cReqHashes = bimap hash hash cReqSchemas
hash = ConnReqUriHash . C.sha256Hash . strEncode hash = ConnReqUriHash . C.sha256Hash . strEncode
@ -2617,14 +2618,14 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
filePath <- getRcvFilePath fileId filePath_ fName True filePath <- getRcvFilePath fileId filePath_ fName True
inline <- receiveInline inline <- receiveInline
if if
| inline -> do | inline -> do
-- accepting inline -- accepting inline
ci <- withStoreCtx (Just "acceptFile, acceptRcvInlineFT") $ \db -> acceptRcvInlineFT db user fileId filePath ci <- withStoreCtx (Just "acceptFile, acceptRcvInlineFT") $ \db -> acceptRcvInlineFT db user fileId filePath
sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
send $ XFileAcptInv sharedMsgId Nothing fName send $ XFileAcptInv sharedMsgId Nothing fName
pure ci pure ci
| fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName
| otherwise -> do | otherwise -> do
-- accepting via a new connection -- accepting via a new connection
subMode <- chatReadVar subscriptionMode subMode <- chatReadVar subscriptionMode
connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode
@ -2901,9 +2902,9 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do
groupEvent groupEvent
| memberStatus membership == GSMemInvited = CRGroupInvitation user g | memberStatus membership == GSMemInvited = CRGroupInvitation user g
| all (\GroupMember {activeConn} -> isNothing activeConn) members = | all (\GroupMember {activeConn} -> isNothing activeConn) members =
if memberActive membership if memberActive membership
then CRGroupEmpty user g then CRGroupEmpty user g
else CRGroupRemoved user g else CRGroupRemoved user g
| otherwise = CRGroupSubscribed user g | otherwise = CRGroupSubscribed user g
sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> m () sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> m ()
sndFileSubsToView rs sfts = do sndFileSubsToView rs sfts = do
@ -2975,11 +2976,11 @@ cleanupManager = do
`catchChatError` (toView . CRChatError (Just user)) `catchChatError` (toView . CRChatError (Just user))
cleanupMessages = do cleanupMessages = do
ts <- liftIO getCurrentTime ts <- liftIO getCurrentTime
let cutoffTs = addUTCTime (-(30 * nominalDay)) ts let cutoffTs = addUTCTime (- (30 * nominalDay)) ts
withStoreCtx' (Just "cleanupManager, deleteOldMessages") (`deleteOldMessages` cutoffTs) withStoreCtx' (Just "cleanupManager, deleteOldMessages") (`deleteOldMessages` cutoffTs)
cleanupProbes = do cleanupProbes = do
ts <- liftIO getCurrentTime ts <- liftIO getCurrentTime
let cutoffTs = addUTCTime (-(14 * nominalDay)) ts let cutoffTs = addUTCTime (- (14 * nominalDay)) ts
withStore' (`deleteOldProbes` cutoffTs) withStore' (`deleteOldProbes` cutoffTs)
startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m () startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
@ -3157,13 +3158,13 @@ processAgentMsgSndFile _corrId aFileId msg =
_ -> pure () -- TODO error? _ -> pure () -- TODO error?
SFERR e SFERR e
| temporaryAgentError e -> | temporaryAgentError e ->
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
| otherwise -> do | otherwise -> do
ci <- withStore $ \db -> do ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId CIFSSndError liftIO $ updateFileCancelled db user fileId CIFSSndError
getChatItemByFileId db user fileId getChatItemByFileId db user fileId
withAgent (`xftpDeleteSndFileInternal` aFileId) withAgent (`xftpDeleteSndFileInternal` aFileId)
toView $ CRSndFileError user ci toView $ CRSndFileError user ci
where where
fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text
fileDescrText = safeDecodeUtf8 . strEncode fileDescrText = safeDecodeUtf8 . strEncode
@ -3218,13 +3219,13 @@ processAgentMsgRcvFile _corrId aFileId msg =
toView $ CRRcvFileComplete user ci toView $ CRRcvFileComplete user ci
RFERR e RFERR e
| temporaryAgentError e -> | temporaryAgentError e ->
throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e
| otherwise -> do | otherwise -> do
ci <- withStore $ \db -> do ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId CIFSRcvError liftIO $ updateFileCancelled db user fileId CIFSRcvError
getChatItemByFileId db user fileId getChatItemByFileId db user fileId
agentXFTPDeleteRcvFile aFileId fileId agentXFTPDeleteRcvFile aFileId fileId
toView $ CRRcvFileError user ci e toView $ CRRcvFileError user ci e
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
processAgentMessageConn user _ agentConnId END = processAgentMessageConn user _ agentConnId END =
@ -3502,18 +3503,18 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
case chatMsgEvent of case chatMsgEvent of
XGrpAcpt memId XGrpAcpt memId
| sameMemberId memId m -> do | sameMemberId memId m -> do
withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted
-- [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 XOk allowAgentConnectionAsync user conn' confId XOk
| otherwise -> messageError "x.grp.acpt: memberId is different from expected" | otherwise -> messageError "x.grp.acpt: memberId is different from expected"
_ -> messageError "CONF from invited member must have x.grp.acpt" _ -> messageError "CONF from invited member must have x.grp.acpt"
_ -> _ ->
case chatMsgEvent of case chatMsgEvent of
XGrpMemInfo memId _memProfile XGrpMemInfo memId _memProfile
| 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
@ -3522,8 +3523,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
case chatMsgEvent of case chatMsgEvent of
XGrpMemInfo memId _memProfile XGrpMemInfo memId _memProfile
| sameMemberId memId m -> do | sameMemberId memId m -> do
-- TODO update member profile -- TODO update member profile
pure () pure ()
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected" | otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
XInfo _ -> pure () -- sent when connecting via group link XInfo _ -> pure () -- sent when connecting via group link
XOk -> pure () XOk -> pure ()
@ -3584,19 +3585,19 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
forM_ (invitedByGroupMemberId membership) $ \hostId -> do forM_ (invitedByGroupMemberId membership) $ \hostId -> do
host <- withStore $ \db -> getGroupMember db user groupId hostId host <- withStore $ \db -> getGroupMember db user groupId hostId
forM_ (memberConn host) $ \hostConn -> forM_ (memberConn host) $ \hostConn ->
void $ sendDirectMessage hostConn (XGrpMemCon m.memberId) (GroupId groupId) void $ sendDirectMessage hostConn (XGrpMemCon $ memberId (m :: GroupMember)) (GroupId groupId)
GCPostMember -> GCPostMember ->
forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do
im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId
forM_ (memberConn im) $ \imConn -> forM_ (memberConn im) $ \imConn ->
void $ sendDirectMessage imConn (XGrpMemCon m.memberId) (GroupId groupId) void $ sendDirectMessage imConn (XGrpMemCon $ memberId (m :: GroupMember)) (GroupId groupId)
_ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected" _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
MSG msgMeta _msgFlags msgBody -> do MSG msgMeta _msgFlags msgBody -> do
cmdId <- createAckCmd conn cmdId <- createAckCmd conn
tryChatError (processChatMessage cmdId) >>= \case tryChatError (processChatMessage cmdId) >>= \case
Right (ACMsg _ chatMsg, withRcpt) -> do Right (ACMsg _ chatMsg, withRcpt) -> do
ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing
when (membership.memberRole >= GRAdmin) $ forwardMsg_ chatMsg when (memberRole (membership :: GroupMember) >= GRAdmin) $ forwardMsg_ chatMsg
Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e
where where
processChatMessage :: Int64 -> m (AChatMessage, Bool) processChatMessage :: Int64 -> m (AChatMessage, Bool)
@ -3675,7 +3676,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- invited members to which this member was introduced -- invited members to which this member was introduced
invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable
let ms = introducedMembers <> invitedMembers let ms = introducedMembers <> invitedMembers
msg = XGrpMsgForward m.memberId chatMsg' brokerTs msg = XGrpMsgForward (memberId (m :: GroupMember)) chatMsg' brokerTs
unless (null ms) . void $ unless (null ms) . void $
sendGroupMessage user gInfo ms msg sendGroupMessage user gInfo ms msg
RCVD msgMeta msgRcpt -> RCVD msgMeta msgRcpt ->
@ -3747,11 +3748,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
mdeUpdatedCI :: (MsgDecryptError, Word32) -> CChatItem c -> Maybe (ChatItem c 'MDRcv, CIContent 'MDRcv) mdeUpdatedCI :: (MsgDecryptError, Word32) -> CChatItem c -> Maybe (ChatItem c 'MDRcv, CIContent 'MDRcv)
mdeUpdatedCI (mde', n') (CChatItem _ ci@ChatItem {content = CIRcvDecryptionError mde n}) mdeUpdatedCI (mde', n') (CChatItem _ ci@ChatItem {content = CIRcvDecryptionError mde n})
| mde == mde' = case mde of | mde == mde' = case mde of
MDERatchetHeader -> r (n + n') MDERatchetHeader -> r (n + n')
MDETooManySkipped -> r n' -- the numbers are not added as sequential MDETooManySkipped will have it incremented by 1 MDETooManySkipped -> r n' -- the numbers are not added as sequential MDETooManySkipped will have it incremented by 1
MDERatchetEarlier -> r (n + n') MDERatchetEarlier -> r (n + n')
MDEOther -> r (n + n') MDEOther -> r (n + n')
MDERatchetSync -> r 0 MDERatchetSync -> r 0
| otherwise = Nothing | otherwise = Nothing
where where
r n'' = Just (ci, CIRcvDecryptionError mde n'') r n'' = Just (ci, CIRcvDecryptionError mde n'')
@ -3769,9 +3770,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- TODO save XFileAcpt message -- TODO save XFileAcpt message
XFileAcpt name XFileAcpt name
| name == fileName -> do | name == fileName -> do
withStore' $ \db -> updateSndFileStatus db ft FSAccepted withStore' $ \db -> updateSndFileStatus db ft FSAccepted
-- [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 XOk allowAgentConnectionAsync user conn' confId XOk
| otherwise -> messageError "x.file.acpt: fileName is different from expected" | otherwise -> messageError "x.file.acpt: fileName is different from expected"
_ -> messageError "CONF from file connection must have x.file.acpt" _ -> messageError "CONF from file connection must have x.file.acpt"
CON -> do CON -> do
@ -3937,8 +3938,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> pure () _ -> pure ()
memberCanSend :: GroupMember -> m () -> m () memberCanSend :: GroupMember -> m () -> m ()
memberCanSend mem a memberCanSend GroupMember {memberRole} a
| mem.memberRole <= GRObserver = messageError "member is not allowed to send messages" | memberRole <= GRObserver = messageError "member is not allowed to send messages"
| otherwise = a | otherwise = a
incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> m () incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> m ()
@ -3964,8 +3965,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
case cmdData_ of case cmdData_ of
Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction} Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction}
| connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == APCT SAEConn ERR_) -> do | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == APCT SAEConn ERR_) -> do
withStore' $ \db -> deleteCommand db user cmdId withStore' $ \db -> deleteCommand db user cmdId
action cmdData action cmdData
| otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId | otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId
Just CommandData {cmdId, cmdConnId = Nothing} -> err cmdId $ "no command connection id, corrId = " <> show corrId Just CommandData {cmdId, cmdConnId = Nothing} -> err cmdId $ "no command connection id, corrId = " <> show corrId
Nothing -> throwChatError . CEAgentCommandError $ "command not found, corrId = " <> show corrId Nothing -> throwChatError . CEAgentCommandError $ "command not found, corrId = " <> show corrId
@ -4275,29 +4276,29 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
| not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
| otherwise = do | otherwise = do
-- TODO integrity message check -- TODO integrity message check
-- check if message moderation event was received ahead of message -- check if message moderation event was received ahead of message
let timed_ = rcvGroupCITimed gInfo itemTTL let timed_ = rcvGroupCITimed gInfo itemTTL
live = fromMaybe False live_ live = fromMaybe False live_
withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
Just ciModeration -> do Just ciModeration -> do
applyModeration timed_ live ciModeration applyModeration timed_ live ciModeration
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_ withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
Nothing -> createItem timed_ live Nothing -> createItem timed_ live
where where
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt} applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
| moderatorRole < GRAdmin || moderatorRole < memberRole = | moderatorRole < GRAdmin || moderatorRole < memberRole =
createItem timed_ live createItem timed_ live
| groupFeatureAllowed SGFFullDelete gInfo = do | groupFeatureAllowed SGFFullDelete gInfo = do
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed_ False ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed_ False
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci' toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
| otherwise = do | otherwise = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed_ False ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed_ False
toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt
createItem timed_ live = do createItem timed_ live = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
@ -4366,7 +4367,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> messageError "x.msg.del: message of another member without memberId" _ -> messageError "x.msg.del: message of another member without memberId"
checkRole GroupMember {memberRole} a checkRole GroupMember {memberRole} a
| senderRole < GRAdmin || senderRole < memberRole = | senderRole < GRAdmin || senderRole < memberRole =
messageError "x.msg.del: message of another member with insufficient member permissions" messageError "x.msg.del: message of another member with insufficient member permissions"
| otherwise = a | otherwise = a
delete :: MsgDirectionI d => ChatItem 'CTGroup d -> Maybe GroupMember -> m ChatResponse delete :: MsgDirectionI d => ChatItem 'CTGroup d -> Maybe GroupMember -> m ChatResponse
delete ci byGroupMember delete ci byGroupMember
@ -4619,17 +4620,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact
processContactProfileUpdate c@Contact {profile = p} p' createItems processContactProfileUpdate c@Contact {profile = p} p' createItems
| fromLocalProfile p /= p' = do | fromLocalProfile p /= p' = do
c' <- withStore $ \db -> c' <- withStore $ \db ->
if userTTL == rcvTTL if userTTL == rcvTTL
then updateContactProfile db user c p' then updateContactProfile db user c p'
else do else do
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
updateContactProfile db user c' p' updateContactProfile db user c' p'
when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c' when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c'
toView $ CRContactUpdated user c c' toView $ CRContactUpdated user c c'
pure c' pure c'
| otherwise = | otherwise =
pure c pure c
where where
Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs
@ -4717,21 +4718,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
case cgm2 of case cgm2 of
COMContact c2@Contact {contactId = cId2, profile = p2} COMContact c2@Contact {contactId = cId2, profile = p2}
| cId1 /= cId2 && profilesMatch p1 p2 -> do | cId1 /= cId2 && profilesMatch p1 p2 -> do
void . sendDirectContactMessage c1 $ XInfoProbeOk probe void . sendDirectContactMessage c1 $ XInfoProbeOk probe
COMContact <$$> mergeContacts c1 c2 COMContact <$$> mergeContacts c1 c2
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing
COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId} COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId}
| isNothing memberContactId && profilesMatch p1 p2 -> do | isNothing memberContactId && profilesMatch p1 p2 -> do
void . sendDirectContactMessage c1 $ XInfoProbeOk probe void . sendDirectContactMessage c1 $ XInfoProbeOk probe
COMContact <$$> associateMemberAndContact c1 m2 COMContact <$$> associateMemberAndContact c1 m2
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing
COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing
COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} -> COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} ->
case cgm2 of case cgm2 of
COMContact c2@Contact {profile = p2} COMContact c2@Contact {profile = p2}
| memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do
void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId) void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
COMContact <$$> associateMemberAndContact c2 m1 COMContact <$$> associateMemberAndContact c2 m1
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing
COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing
@ -4847,16 +4848,16 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just call@Call {contactId, callId, chatItemId} Just call@Call {contactId, callId, chatItemId}
| contactId /= ctId' || callId /= callId' -> messageError $ eventName <> ": wrong contact or callId" | contactId /= ctId' || callId /= callId' -> messageError $ eventName <> ": wrong contact or callId"
| otherwise -> do | otherwise -> do
(call_, aciContent_) <- action call (call_, aciContent_) <- action call
case call_ of case call_ of
Just call' -> do Just call' -> do
unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId' unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId'
atomically $ TM.insert ctId' call' calls atomically $ TM.insert ctId' call' calls
_ -> do _ -> do
withStore' $ \db -> deleteCalls db user ctId' withStore' $ \db -> deleteCalls db user ctId'
atomically $ TM.delete ctId' calls atomically $ TM.delete ctId' calls
forM_ aciContent_ $ \aciContent -> forM_ aciContent_ $ \aciContent ->
updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId
msgCallStateError :: Text -> Call -> m () msgCallStateError :: Text -> Call -> m ()
msgCallStateError eventName Call {callState} = msgCallStateError eventName Call {callState} =
@ -4907,8 +4908,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
suffixOrd displayName localDisplayName suffixOrd displayName localDisplayName
| localDisplayName == displayName = Just 0 | localDisplayName == displayName = Just 0
| otherwise = case T.stripPrefix (displayName <> "_") localDisplayName of | otherwise = case T.stripPrefix (displayName <> "_") localDisplayName of
Just suffix -> readMaybe $ T.unpack suffix Just suffix -> readMaybe $ T.unpack suffix
Nothing -> Nothing Nothing -> Nothing
associateMemberWithContact :: Contact -> GroupMember -> m Contact associateMemberWithContact :: Contact -> GroupMember -> m Contact
associateMemberWithContact c1 m2@GroupMember {groupId} = do associateMemberWithContact c1 m2@GroupMember {groupId} = do
@ -5008,7 +5009,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 (chatHasNtfs chatSettings) groupConnReq dm subMode groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode
@ -5018,21 +5019,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> m () xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> m ()
xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs
| 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 = | otherwise =
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case
Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole
Left _ -> messageError "x.grp.mem.role with unknown member ID" Left _ -> messageError "x.grp.mem.role with unknown member ID"
where where
changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent
| senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions"
| otherwise = do | otherwise = do
withStore' $ \db -> updateGroupMemberRole db user member memRole withStore' $ \db -> updateGroupMemberRole db user member memRole
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
groupMsgToView gInfo ci groupMsgToView gInfo ci
toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
checkHostRole :: GroupMember -> GroupMemberRole -> m () checkHostRole :: GroupMember -> GroupMemberRole -> m ()
checkHostRole GroupMember {memberRole, localDisplayName} memRole = checkHostRole GroupMember {memberRole, localDisplayName} memRole =
@ -5079,7 +5080,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> m () xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> m ()
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do
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
@ -5102,7 +5103,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
where where
checkRole GroupMember {memberRole} a checkRole GroupMember {memberRole} a
| senderRole < GRAdmin || senderRole < memberRole = | senderRole < GRAdmin || senderRole < memberRole =
messageError "x.grp.mem.del with insufficient member permissions" messageError "x.grp.mem.del with insufficient member permissions"
| otherwise = a | otherwise = a
deleteMemberItem gEvent = do deleteMemberItem gEvent = do
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
@ -5134,13 +5135,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xGrpInfo g@GroupInfo {groupProfile = p} m@GroupMember {memberRole} p' msg brokerTs xGrpInfo g@GroupInfo {groupProfile = p} m@GroupMember {memberRole} p' msg brokerTs
| memberRole < GROwner = messageError "x.grp.info with insufficient member permissions" | memberRole < GROwner = messageError "x.grp.info with insufficient member permissions"
| otherwise = unless (p == p') $ do | otherwise = unless (p == p') $ do
g' <- withStore $ \db -> updateGroupProfile db user g p' g' <- withStore $ \db -> updateGroupProfile db user g p'
toView $ CRGroupUpdated user g g' (Just m) toView $ CRGroupUpdated user g g' (Just m)
let cd = CDGroupRcv g' m let cd = CDGroupRcv g' m
unless (sameGroupProfileInfo p p') $ do unless (sameGroupProfileInfo p p') $ do
ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p')
groupMsgToView g' ci groupMsgToView g' ci
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> m () xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> m ()
xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do
@ -5191,8 +5192,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> m () xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> m ()
xGrpMsgForward gInfo@GroupInfo {groupId} m memberId msg msgTs = do xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId msg msgTs = do
when (m.memberRole < GRAdmin) $ throwChatError (CEGroupContactRole m.localDisplayName) when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName)
author <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memberId author <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memberId
processForwardedMsg author msg processForwardedMsg author msg
where where
@ -5238,8 +5239,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}})
| itemStatus == newStatus -> pure () | itemStatus == newStatus -> pure ()
| otherwise -> do | otherwise -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user ct itemId newStatus chatItem <- withStore $ \db -> updateDirectChatItemStatus db user ct itemId newStatus
toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
_ -> pure () _ -> pure ()
updateGroupMemSndStatus :: ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> m Bool updateGroupMemSndStatus :: ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> m Bool
@ -5367,7 +5368,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
@ -5385,7 +5386,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 ()
@ -5542,21 +5543,21 @@ sendGroupMessage' user members chatMsgEvent groupId introId_ postDeliver = do
Just conn@Connection {connStatus} Just conn@Connection {connStatus}
| connDisabled conn || connStatus == ConnDeleted -> pure Nothing | connDisabled conn || connStatus == ConnDeleted -> pure Nothing
| connStatus == ConnSndReady || connStatus == ConnReady -> do | connStatus == ConnSndReady || connStatus == ConnReady -> do
let tag = toCMEventTag chatMsgEvent let tag = toCMEventTag chatMsgEvent
deliverMessage conn tag msgBody msgId >> postDeliver deliverMessage conn tag msgBody msgId >> postDeliver
pure $ Just m pure $ Just m
| otherwise -> pendingOrForwarded | otherwise -> pendingOrForwarded
where where
pendingOrForwarded pendingOrForwarded
| forwardSupported && isForwardedGroupMsg chatMsgEvent = pure Nothing | forwardSupported && isForwardedGroupMsg chatMsgEvent = pure Nothing
| isXGrpMsgForward chatMsgEvent = pure Nothing | isXGrpMsgForward chatMsgEvent = pure Nothing
| otherwise = do | otherwise = do
withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
pure $ Just m pure $ Just m
forwardSupported = do forwardSupported = do
let mcvr = memberChatVRange' m let mcvr = memberChatVRange' m
isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward
invitingMemberSupportsForward = case m.invitedByGroupMemberId of invitingMemberSupportsForward = case invitedByGroupMemberId m of
Just invMemberId -> Just invMemberId ->
-- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember
case find (\m' -> groupMemberId' m' == invMemberId) members of case find (\m' -> groupMemberId' m' == invMemberId) members of
@ -5610,14 +5611,14 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta
let agentMsgId = fst $ recipient agentMsgMeta let agentMsgId = fst $ recipient agentMsgMeta
newMsg = NewMessage {chatMsgEvent, msgBody} newMsg = NewMessage {chatMsgEvent, msgBody}
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
amId = Just am'.groupMemberId amId = Just $ groupMemberId' am'
msg <- msg <-
withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery amId) withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery amId)
`catchChatError` \e -> case e of `catchChatError` \e -> case e of
ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do
fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId
forM_ (memberConn fm) $ \fmConn -> forM_ (memberConn fm) $ \fmConn ->
void $ sendDirectMessage fmConn (XGrpMemCon am'.memberId) (GroupId groupId) void $ sendDirectMessage fmConn (XGrpMemCon $ memberId (am' :: GroupMember)) (GroupId groupId)
throwError e throwError e
_ -> throwError e _ -> throwError e
pure (am', conn', msg) pure (am', conn', msg)
@ -5631,9 +5632,9 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember msgBody ChatMes
`catchChatError` \e -> case e of `catchChatError` \e -> case e of
ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do
am <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId am <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId
if sameMemberId refAuthorMember.memberId am if sameMemberId (memberId (refAuthorMember :: GroupMember)) am
then forM_ (memberConn forwardingMember) $ \fmConn -> then forM_ (memberConn forwardingMember) $ \fmConn ->
void $ sendDirectMessage fmConn (XGrpMemCon am.memberId) (GroupId groupId) void $ sendDirectMessage fmConn (XGrpMemCon $ memberId (am :: GroupMember)) (GroupId groupId)
else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id" else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id"
throwError e throwError e
_ -> throwError e _ -> throwError e
@ -5779,7 +5780,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
@ -5863,7 +5864,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:"
@ -5877,9 +5878,9 @@ getCreateActiveUser st testView = do
Just n Just n
| 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}} =
T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")" T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")"
@ -5888,10 +5889,10 @@ getCreateActiveUser st testView = do
displayName <- getWithPrompt "display name" displayName <- getWithPrompt "display name"
let validName = mkValidName displayName let validName = mkValidName displayName
if if
| null displayName -> putStrLn "display name can't be empty" >> getContactName | null displayName -> putStrLn "display name can't be empty" >> getContactName
| null validName -> putStrLn "display name is invalid, please choose another" >> getContactName | null validName -> putStrLn "display name is invalid, please choose another" >> getContactName
| displayName /= validName -> putStrLn ("display name is invalid, you could use this one: " <> validName) >> getContactName | displayName /= validName -> putStrLn ("display name is invalid, you could use this one: " <> validName) >> getContactName
| otherwise -> pure $ T.pack displayName | otherwise -> pure $ T.pack displayName
getWithPrompt :: String -> IO String getWithPrompt :: String -> IO String
getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine

View file

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

View file

@ -5,7 +5,6 @@
{-# 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 #-}
@ -344,7 +343,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}}}

View file

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

View file

@ -2,7 +2,6 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -480,7 +479,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

View file

@ -2,7 +2,6 @@
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -491,7 +490,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
@ -512,7 +511,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
@ -907,7 +906,7 @@ getLocalCryptoFile db userId fileId sent =
_ -> do _ -> do
unless sent $ throwError $ SEFileNotFound fileId unless sent $ throwError $ SEFileNotFound fileId
FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs pure $ CryptoFile filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus db user fileId fileStatus = do updateDirectCIFileStatus db user fileId fileStatus = do

View file

@ -2,7 +2,6 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
@ -358,7 +357,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
"INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)" "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)"
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs) (profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
insertedRowId db insertedRowId db
let JVersionRange hostVRange = hostConn.peerChatVRange let JVersionRange hostVRange = peerChatVRange hostConn
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs supportedChatVRange membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs supportedChatVRange
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
@ -1055,7 +1054,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
@ -1163,7 +1162,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

View file

@ -296,7 +296,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 ()

View file

@ -9,7 +9,6 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -61,21 +60,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' #-}
@ -195,7 +194,7 @@ directOrUsed ct@Contact {contactUsed} =
contactDirect ct || contactUsed contactDirect ct || contactUsed
anyDirectOrUsed :: Contact -> Bool anyDirectOrUsed :: Contact -> Bool
anyDirectOrUsed Contact {contactUsed, activeConn} = ((\c -> c.connLevel) <$> activeConn) == Just 0 || contactUsed anyDirectOrUsed Contact {contactUsed, activeConn} = ((\Connection {connLevel} -> connLevel) <$> activeConn) == Just 0 || contactUsed
contactReady :: Contact -> Bool contactReady :: Contact -> Bool
contactReady Contact {activeConn} = maybe False connReady activeConn contactReady Contact {activeConn} = maybe False connReady activeConn

View file

@ -7,7 +7,6 @@
{-# 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 #-}
@ -15,7 +14,6 @@
{-# 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" #-}
@ -79,12 +77,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
@ -104,12 +102,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
@ -192,13 +190,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
@ -219,13 +217,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
@ -371,19 +369,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
@ -446,25 +444,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
@ -695,12 +693,12 @@ 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
$(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature) $(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature)

View file

@ -3,7 +3,6 @@
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -212,7 +211,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
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]
@ -490,7 +489,7 @@ viewGroupSubscribed :: GroupInfo -> [StyledString]
viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"] viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"]
showSMPServer :: SMPServer -> String showSMPServer :: SMPServer -> String
showSMPServer srv = B.unpack $ strEncode srv.host showSMPServer ProtocolServer {host} = B.unpack $ strEncode host
viewHostEvent :: AProtocolType -> TransportHost -> String viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h) viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
@ -949,7 +948,7 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
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 <> ": " <> plain (intercalate ", " $ [role m] <> category m <> status m <> muted m) groupMember m = memIncognito m <> ttyFullMember m <> ": " <> plain (intercalate ", " $ [role m] <> category m <> status m <> muted m)
role :: GroupMember -> String role :: GroupMember -> String
role m = B.unpack . strEncode $ m.memberRole role m = B.unpack . strEncode $ memberRole (m :: GroupMember)
category m = case memberCategory m of category m = case memberCategory m of
GCUserMember -> ["you"] GCUserMember -> ["you"]
GCInviteeMember -> ["invited"] GCInviteeMember -> ["invited"]
@ -987,7 +986,7 @@ viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <nam
viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs
where where
ldn_ :: GroupInfo -> Text ldn_ :: GroupInfo -> Text
ldn_ g = T.toLower g.localDisplayName ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName)
groupSS (g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}}, GroupSummary {currentMembers}) = groupSS (g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}}, GroupSummary {currentMembers}) =
case memberStatus membership of case memberStatus membership of
GSMemInvited -> groupInvitation' g GSMemInvited -> groupInvitation' g
@ -1902,7 +1901,7 @@ viewChatError logLevel testView = \case
"[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] " "[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] "
Nothing -> "" Nothing -> ""
cId :: Connection -> StyledString cId :: Connection -> StyledString
cId conn = sShow conn.connId cId conn = sShow (connId (conn :: Connection))
ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e] ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e]
ChatErrorRemoteHost RHNew e -> [plain $ "new remote host error: " <> show e] ChatErrorRemoteHost RHNew e -> [plain $ "new remote host error: " <> show e]
ChatErrorRemoteHost (RHId rhId) e -> [plain $ "remote host " <> show rhId <> " error: " <> show e] ChatErrorRemoteHost (RHId rhId) e -> [plain $ "remote host " <> show rhId <> " error: " <> show e]

View file

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

View file

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