diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 92a975bc90..c1a1d5d7db 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -80,10 +80,10 @@ jobs: uses: actions/checkout@v3 - name: Setup Haskell - uses: haskell-actions/setup@v2 + uses: haskell/actions/setup@v2 with: - ghc-version: "9.6.3" - cabal-version: "3.10.1.0" + ghc-version: "8.10.7" + cabal-version: "latest" - name: Cache dependencies uses: actions/cache@v3 @@ -189,7 +189,7 @@ jobs: APPLE_SIMPLEX_NOTARIZATION_APPLE_ID: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_APPLE_ID }} APPLE_SIMPLEX_NOTARIZATION_PASSWORD: ${{ secrets.APPLE_SIMPLEX_NOTARIZATION_PASSWORD }} run: | - scripts/ci/build-desktop-mac.sh + scripts/build-desktop-mac.sh path=$(echo $PWD/apps/multiplatform/release/main/dmg/SimpleX-*.dmg) echo "package_path=$path" >> $GITHUB_OUTPUT echo "package_hash=$(echo SHA2-512\(${{ matrix.desktop_asset_name }}\)= $(openssl sha512 $path | cut -d' ' -f 2))" >> $GITHUB_OUTPUT @@ -260,7 +260,9 @@ jobs: # Unix / # / Windows - # rm -rf dist-newstyle/src/direct-sq* is here because of the bug in cabal's dependency which prevents second build from finishing + + # * In powershell multiline commands do not fail if individual commands fail - https://github.community/t/multiline-commands-on-windows-do-not-fail-if-individual-commands-fail/16753 + # * And GitHub Actions does not support parameterizing shell in a matrix job - https://github.community/t/using-matrix-to-specify-shell-is-it-possible/17065 - name: 'Setup MSYS2' if: matrix.os == 'windows-latest' diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj index 5bd0e19f5e..c975d2fa1f 100644 --- a/apps/ios/SimpleX.xcodeproj/project.pbxproj +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -168,6 +168,11 @@ 64466DC829FC2B3B00E3D48D /* CreateSimpleXAddress.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */; }; 64466DCC29FFE3E800E3D48D /* MailView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DCB29FFE3E800E3D48D /* MailView.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 */; }; 644EFFE0292CFD7F00525D5B /* CIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */; }; 644EFFE2292D089800525D5B /* FramedCIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */; }; @@ -455,6 +460,11 @@ 64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CreateSimpleXAddress.swift; sourceTree = ""; }; 64466DCB29FFE3E800E3D48D /* MailView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MailView.swift; sourceTree = ""; }; 6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = GroupLinkView.swift; sourceTree = ""; }; + 644933352AF8E51000AC506E /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; + 644933362AF8E51000AC506E /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; + 644933372AF8E51000AC506E /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; + 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 = ""; }; + 644933392AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a"; sourceTree = ""; }; 644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeVoiceView.swift; sourceTree = ""; }; 644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIVoiceView.swift; sourceTree = ""; }; 644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = FramedCIVoiceView.swift; sourceTree = ""; }; diff --git a/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt b/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt index 059e5af426..b304800a3a 100644 --- a/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt +++ b/apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt @@ -71,7 +71,7 @@ if(NOT APPLE) else() # Without direct linking it can't find hs_init in linking step add_library( rts SHARED IMPORTED ) - FILE(GLOB RTSLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/libHSrts*_thr-*.${OS_LIB_EXT}) + FILE(GLOB RTSLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/deps/libHSrts*_thr-*.${OS_LIB_EXT}) set_target_properties( rts PROPERTIES IMPORTED_LOCATION ${RTSLIB}) target_link_libraries(app-lib rts simplex) diff --git a/cabal.project b/cabal.project index 9ff33c301e..afee4d3994 100644 --- a/cabal.project +++ b/cabal.project @@ -2,7 +2,7 @@ packages: . -- packages: . ../simplexmq -- packages: . ../simplexmq ../direct-sqlcipher ../sqlcipher-simple -with-compiler: ghc-9.6.3 +with-compiler: ghc-8.10.7 index-state: 2023-12-12T00:00:00Z diff --git a/flake.lock b/flake.lock index a11e01683e..355caaf57f 100644 --- a/flake.lock +++ b/flake.lock @@ -16,6 +16,21 @@ "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": { "flake": false, "locked": { @@ -83,6 +98,64 @@ "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": false, "locked": { @@ -100,34 +173,74 @@ "type": "github" } }, - "flake-parts": { - "inputs": { - "nixpkgs-lib": "nixpkgs-lib" - }, + "flake-compat_2": { + "flake": false, "locked": { - "lastModified": 1698579227, - "narHash": "sha256-KVWjFZky+gRuWennKsbo6cWyo7c/z/VgCte5pR9pEKg=", - "owner": "hercules-ci", - "repo": "flake-parts", - "rev": "f76e870d64779109e41370848074ac4eaa1606ec", + "lastModified": 1650374568, + "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b4a34015c698c7793d592d66adbab377907a2be8", "type": "github" }, "original": { - "owner": "hercules-ci", - "repo": "flake-parts", + "owner": "edolstra", + "repo": "flake-compat", "type": "github" } }, "flake-utils": { - "inputs": { - "systems": "systems" - }, "locked": { - "lastModified": 1701680307, - "narHash": "sha256-kAuep2h5ajznlPMD9rnQyffWG8EM/C73lejGofXvdM8=", + "lastModified": 1676283394, + "narHash": "sha256-XX2f9c3iySLCw54rJ/CZs+ZK6IQy7GXNY4nSOyu2QG4=", "owner": "numtide", "repo": "flake-utils", - "rev": "4022d587cbbfd70fe950c1e2083a02621806a725", + "rev": "3db36a8b464d0c4532ba1c7dda728f4576d6d073", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "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": { @@ -153,51 +266,33 @@ "type": "github" } }, - "ghc98X": { - "flake": false, + "gomod2nix": { + "inputs": { + "nixpkgs": "nixpkgs_2", + "utils": "utils" + }, "locked": { - "lastModified": 1696643148, - "narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=", - "ref": "ghc-9.8", - "rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6", - "revCount": 61642, - "submodules": true, - "type": "git", - "url": "https://gitlab.haskell.org/ghc/ghc" + "lastModified": 1655245309, + "narHash": "sha256-d/YPoQ/vFn1+GTmSdvbSBSTOai61FONxB4+Lt6w/IVI=", + "owner": "tweag", + "repo": "gomod2nix", + "rev": "40d32f82fc60d66402eb0972e6e368aeab3faf58", + "type": "github" }, "original": { - "ref": "ghc-9.8", - "submodules": true, - "type": "git", - "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" + "owner": "tweag", + "repo": "gomod2nix", + "type": "github" } }, "hackage": { "flake": false, "locked": { - "lastModified": 1702513363, - "narHash": "sha256-kloro9uEe8aYhPMoMjVNq2rfrXNgMOZhOPwVH5DH2K0=", + "lastModified": 1702340598, + "narHash": "sha256-CC0HI+6iKPtH+8r/ZfcpW5v/OYvL7zMwpr0xfkXV1zU=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "a9d931d0398da67846fa257922a924829233cb91", + "rev": "24617c569995e38bf3b83b48eec6628a50fdb4fb", "type": "github" }, "original": { @@ -214,40 +309,33 @@ "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-compat": "flake-compat", + "flake-utils": "flake-utils_2", "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", - "ghc98X": "ghc98X", - "ghc99": "ghc99", "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", "hydra": "hydra", "iserv-proxy": "iserv-proxy", "nixpkgs": [ - "haskellNix", - "nixpkgs-unstable" + "nixpkgs" ], "nixpkgs-2003": "nixpkgs-2003", "nixpkgs-2105": "nixpkgs-2105", "nixpkgs-2111": "nixpkgs-2111", "nixpkgs-2205": "nixpkgs-2205", "nixpkgs-2211": "nixpkgs-2211", - "nixpkgs-2305": "nixpkgs-2305", "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": "old-ghc-nix", - "stackage": "stackage" + "stackage": "stackage", + "tullia": "tullia" }, "locked": { - "lastModified": 1701163700, - "narHash": "sha256-sOrewUS3LnzV09nGr7+3R6Q6zsgU4smJc61QsHq+4DE=", + "lastModified": 1677975916, + "narHash": "sha256-dbe8lEEPyfzjdRwpePClv7J9p9lQg7BwbBqAMCw4RLw=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "2808bfe3e62e9eb4ee8974cd623a00e1611f302b", + "rev": "ab5efd87ce3fd8ade38a01d97693d29a4f1ae7e4", "type": "github" }, "original": { @@ -257,91 +345,6 @@ "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": { "flake": false, "locked": { @@ -381,14 +384,37 @@ "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": { "flake": false, "locked": { - "lastModified": 1691634696, - "narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=", + "lastModified": 1670983692, + "narHash": "sha256-avLo34JnI9HNyOuauK5R69usJm+GfW3MlyGlYxZhTgY=", "ref": "hkm/remote-iserv", - "rev": "43a979272d9addc29fbffc2e8542c5d96e993d73", - "revCount": 14, + "rev": "50d0abb3317ac439a4e7495b185a64af9b7b9300", + "revCount": 10, "type": "git", "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git" }, @@ -414,22 +440,32 @@ "type": "github" } }, - "mac2ios": { + "n2c": { "inputs": { - "flake-parts": "flake-parts", - "nixpkgs": "nixpkgs_2" + "flake-utils": [ + "haskellNix", + "tullia", + "std", + "flake-utils" + ], + "nixpkgs": [ + "haskellNix", + "tullia", + "std", + "nixpkgs" + ] }, "locked": { - "lastModified": 1699767871, - "narHash": "sha256-kxeCUfwC/Vgh2FvVMlBUq0eVx1JvfHyN+5MPKUik9mE=", - "owner": "zw3rk", - "repo": "mobile-core-tools", - "rev": "4dcb77d5ea896d749381806dfab5358851b08951", + "lastModified": 1665039323, + "narHash": "sha256-SAh3ZjFGsaCI8FRzXQyp56qcGdAqgKEfJWPCQ0Sr7tQ=", + "owner": "nlewo", + "repo": "nix2container", + "rev": "b008fe329ffb59b67bf9e7b08ede6ee792f2741a", "type": "github" }, "original": { - "owner": "zw3rk", - "repo": "mobile-core-tools", + "owner": "nlewo", + "repo": "nix2container", "type": "github" } }, @@ -454,6 +490,95 @@ "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": { "locked": { "lastModified": 1657693803, @@ -520,11 +645,11 @@ }, "nixpkgs-2205": { "locked": { - "lastModified": 1685573264, - "narHash": "sha256-Zffu01pONhs/pqH07cjlF10NnMDLok8ix5Uk4rhOnZQ=", + "lastModified": 1672580127, + "narHash": "sha256-3lW3xZslREhJogoOkjeZtlBtvFMyxHku7I/9IVehhT8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "380be19fbd2d9079f677978361792cb25e8a3635", + "rev": "0874168639713f547c05947c76124f78441ea46c", "type": "github" }, "original": { @@ -536,11 +661,11 @@ }, "nixpkgs-2211": { "locked": { - "lastModified": 1688392541, - "narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=", + "lastModified": 1675730325, + "narHash": "sha256-uNvD7fzO5hNlltNQUAFBPlcEjNG5Gkbhl/ROiX+GZU4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b", + "rev": "b7ce17b1ebf600a72178f6302c77b6382d09323f", "type": "github" }, "original": { @@ -550,40 +675,6 @@ "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": { "locked": { "lastModified": 1643052045, @@ -602,11 +693,11 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1695318763, - "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", + "lastModified": 1675758091, + "narHash": "sha256-7gFSQbSVAFUHtGCNHPF7mPc5CcqDk9M2+inlVPZSneg=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", + "rev": "747927516efcb5e31ba03b7ff32f61f6d47e7d87", "type": "github" }, "original": { @@ -618,20 +709,82 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1698434055, - "narHash": "sha256-Phxi5mUKSoL7A0IYUiYtkI9e8NcGaaV5PJEaJApU1Ko=", + "lastModified": 1653581809, + "narHash": "sha256-Uvka0V5MTGbeOfWte25+tfRL3moECDh1VwokWSZUdoY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "1a3c95e3b23b3cdb26750621c08cc2f1560cb883", + "rev": "83658b28fe638a170a19b8933aa008b30640fbd1", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixos-23.05", + "ref": "nixos-unstable", "repo": "nixpkgs", "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": { "flake": false, "locked": { @@ -654,21 +807,17 @@ "flake-utils": "flake-utils", "hackage": "hackage", "haskellNix": "haskellNix", - "mac2ios": "mac2ios", - "nixpkgs": [ - "haskellNix", - "nixpkgs-2305" - ] + "nixpkgs": "nixpkgs_5" } }, "stackage": { "flake": false, "locked": { - "lastModified": 1699834215, - "narHash": "sha256-g/JKy0BCvJaxPuYDl3QVc4OY8cFEomgG+hW/eEV470M=", + "lastModified": 1677888571, + "narHash": "sha256-YkhRNOaN6QVagZo1cfykYV8KqkI8/q6r2F5+jypOma4=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "47aacd04abcce6bad57f43cbbbd133538380248e", + "rev": "cb50e6fabdfb2d7e655059039012ad0623f06a27", "type": "github" }, "original": { @@ -677,18 +826,110 @@ "type": "github" } }, - "systems": { + "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": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "lastModified": 1674526466, + "narHash": "sha256-tMTaS0bqLx6VJ+K+ZT6xqsXNpzvSXJTmogkraBGzymg=", + "owner": "divnix", + "repo": "std", + "rev": "516387e3d8d059b50e742a2ff1909ed3c8f82826", "type": "github" }, "original": { - "owner": "nix-systems", - "repo": "default", + "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" } } diff --git a/flake.nix b/flake.nix index 6fabe7d657..24a5062be3 100644 --- a/flake.nix +++ b/flake.nix @@ -1,15 +1,15 @@ { 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.nixpkgs.follows = "haskellNix/nixpkgs-2305"; - inputs.mac2ios.url = "github:zw3rk/mobile-core-tools"; + inputs.haskellNix.inputs.nixpkgs.follows = "nixpkgs"; inputs.hackage = { url = "github:input-output-hk/hackage.nix"; flake = false; }; inputs.haskellNix.inputs.hackage.follows = "hackage"; 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 flake-utils.lib.eachSystem systems (system: # this android26 overlay makes the pkgsCross.{aarch64-android,armv7a-android-prebuilt} to set stdVer to 26 (Android 8). @@ -30,7 +30,7 @@ # `appendOverlays` with a singleton is identical to `extend`. let pkgs = haskellNix.legacyPackages.${system}.appendOverlays [android26]; in let drv' = { extra-modules, pkgs', ... }: pkgs'.haskell-nix.project { - compiler-nix-name = "ghc963"; + compiler-nix-name = "ghc8107"; index-state = "2023-12-12T00:00:00Z"; # We need this, to specify we want the cabal project. # If the stack.yaml was dropped, this would not be necessary. @@ -40,12 +40,9 @@ src = ./.; }; sha256map = import ./scripts/nix/sha256map.nix; - 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( + modules = [{ packages.direct-sqlcipher.patches = [ ./scripts/nix/direct-sqlcipher-2.3.27.patch ]; - }) + } ({ pkgs,lib, ... }: lib.mkIf (pkgs.stdenv.hostPlatform.isAndroid) { packages.simplex-chat.components.library.ghcOptions = [ "-pie" ]; })] ++ extra-modules; @@ -67,9 +64,6 @@ }); in let iosPostInstall = bundleName: '' ${pkgs.tree}/bin/tree $out - mkdir tmp - find ./dist -name "libHS*-ghc*.a" -exec cp {} tmp \; - (cd tmp; ${pkgs.tree}/bin/tree .; ar x libHS*.a; for o in *.o; do if /usr/bin/otool -xv $o|grep ldadd ; then echo $o; fi; done; cd ..; rm -fR tmp) mkdir -p $out/_pkg # copy over includes, we might want those, but maybe not. # cp -r $out/lib/*/*/include $out/_pkg/ @@ -80,18 +74,6 @@ find ${pkgs.gmp6.override { withStatic = true; }}/lib -name "*.a" -exec cp {} $out/_pkg \; # There is no static libc ${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 - - mkdir tmp - find $out/_pkg -name "libHS*-ghc*.a" -exec cp {} tmp \; - (cd tmp; ${pkgs.tree}/bin/tree .; ar x libHS*.a; for o in *.o; do if /usr/bin/otool -xv $o|grep ldadd ; then echo $o; fi; done; cd ..; rm -fR tmp) - - sha256sum $out/_pkg/*.a - (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/${bundleName}.zip *) rm -fR $out/_pkg mkdir -p $out/nix-support @@ -137,149 +119,13 @@ hardeningDisable = [ "fortify" ]; } );in { - # STATIC x86_64-linux "${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' = 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.musl32.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.musl32).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; - "armv7a-android:lib:support" = (drv android32Pkgs).android-support.components.library.override (p: { - smallAddressSpace = true; - # we won't want -dyamic (see aarch64-android:lib:simplex-chat) - 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 - ''; - + "armv7a-android:lib:support" = (drv android32Pkgs).android-support.components.library.override { + smallAddressSpace = true; enableShared = false; + setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ]; postInstall = '' mkdir -p $out/_pkg @@ -292,29 +138,14 @@ echo "file binary-dist \"$(echo $out/*.zip)\"" \ > $out/nix-support/hydra-build-products ''; - }); - # The android-support package is at - # https://github.com/simplex-chat/android-support - "aarch64-android:lib:support" = (drv androidPkgs).android-support.components.library.override (p: { - 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 - ''; - + }; + "aarch64-android:lib:support" = (drv androidPkgs).android-support.components.library.override { + smallAddressSpace = true; enableShared = false; + setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ]; postInstall = '' mkdir -p $out/_pkg cp libsupport.so $out/_pkg - ls -lah $out/_pkg/* ${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 *) rm -fR $out/_pkg @@ -323,11 +154,10 @@ echo "file binary-dist \"$(echo $out/*.zip)\"" \ > $out/nix-support/hydra-build-products ''; - }); + }; "armv7a-android:lib:simplex-chat" = (drv' { pkgs' = android32Pkgs; extra-modules = [{ - packages.text.flags.simdutf = false; packages.direct-sqlcipher.flags.openssl = true; packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [ (android32Pkgs.openssl.override { static = true; enableKTLS = false; }) @@ -338,55 +168,13 @@ packages.simplexmq.components.library.libs = pkgs.lib.mkForce [ (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: { - smallAddressSpace = true; - # we want -shared, but not -dyanmic, hence `enableShared = false`. - enableShared = false; - # we _do_ want rts, and other libs. Hence `enableStatic = true`. - enableStatic = true; + }).simplex-chat.components.library.override { + smallAddressSpace = true; enableShared = false; # 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 # template haskell cross compilation. Thus we just pass them as linker options (-optl). - setupBuildFlags = p.component.setupBuildFlags - # 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 ` - # to ensure they stay in the produced library. Having them - # _undefined_ and _lazy_ (lld will tell with -y 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" - ]; + setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsimplex.so" "-optl-lHSrts_thr" "-optl-lffi"]; postInstall = '' set -x ${pkgs.tree}/bin/tree $out @@ -430,11 +218,10 @@ echo "file binary-dist \"$(echo $out/*.zip)\"" \ > $out/nix-support/hydra-build-products ''; - }); + }; "aarch64-android:lib:simplex-chat" = (drv' { pkgs' = androidPkgs; extra-modules = [{ - packages.text.flags.simdutf = false; packages.direct-sqlcipher.flags.openssl = true; packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [ (androidPkgs.openssl.override { static = true; }) @@ -446,49 +233,12 @@ (androidPkgs.openssl.override { static = true; }) ]; }]; - }).simplex-chat.components.library.override (p: { - smallAddressSpace = true; - # 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; + }).simplex-chat.components.library.override { + smallAddressSpace = true; enableShared = false; # 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 # template haskell cross compilation. Thus we just pass them as linker options (-optl). - setupBuildFlags = p.component.setupBuildFlags - # 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 ` - # to ensure they stay in the produced library. Having them - # _undefined_ and _lazy_ (lld will tell with -y 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" - ]; + setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsimplex.so" "-optl-lHSrts_thr" "-optl-lffi"]; postInstall = '' set -x ${pkgs.tree}/bin/tree $out @@ -532,7 +282,7 @@ echo "file binary-dist \"$(echo $out/*.zip)\"" \ > $out/nix-support/hydra-build-products ''; - }); + }; }; # builds for iOS and iOS simulator @@ -546,8 +296,7 @@ packages.direct-sqlcipher.flags.commoncrypto = true; packages.entropy.flags.DoNotGetEntropy = true; packages.simplexmq.components.library.libs = pkgs.lib.mkForce [ - # TODO: have a cross override for iOS, that sets this. - ((pkgs.openssl.override { static = true; }).overrideDerivation (old: { CFLAGS = "-mcpu=apple-a7 -march=armv8-a+norcpc" ;})) + (pkgs.openssl.override { static = true; }) ]; }]; }).simplex-chat.components.library.override ( diff --git a/package.yaml b/package.yaml index 675e62eb48..e42a8d3c4c 100644 --- a/package.yaml +++ b/package.yaml @@ -36,7 +36,7 @@ dependencies: - network >= 3.1.2.7 && < 3.2 - network-transport == 0.5.6 - optparse-applicative >= 0.15 && < 0.17 - - process == 1.6.* + - process >= 1.6 && < 1.6.18 - random >= 1.1 && < 1.3 - record-hasfield == 1.0.* - simple-logger == 0.1.* @@ -131,7 +131,7 @@ tests: - async == 2.2.* - deepseq == 1.4.* - generic-random == 1.5.* - - hspec == 2.11.* + - hspec == 2.7.* - network == 3.1.* - silently == 1.2.* - stm == 2.5.* diff --git a/scripts/ci/prepare-keychain-mac.sh b/scripts/ci/prepare-keychain-mac.sh deleted file mode 100644 index 912e6285af..0000000000 --- a/scripts/ci/prepare-keychain-mac.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/bash - -security create-keychain -p "" simplex.keychain -security set-keychain-settings -u simplex.keychain -security add-certificates -k simplex.keychain "Developer ID Application: SimpleX Chat Ltd (5NN7GUYB6T).cer" -security add-certificates -k simplex.keychain "Developer ID Certification Authority.cer" -# Private key with access from any app -security import "SimpleX Chat.p12" -P "" -k simplex.keychain -A -# Public key -security import "SimpleX Chat.pem" -k simplex.keychain diff --git a/scripts/ci/build-desktop-mac.sh b/scripts/desktop/build-desktop-mac-ci.sh similarity index 63% rename from scripts/ci/build-desktop-mac.sh rename to scripts/desktop/build-desktop-mac-ci.sh index 259b946228..07a3db9c8e 100755 --- a/scripts/ci/build-desktop-mac.sh +++ b/scripts/desktop/build-desktop-mac-ci.sh @@ -2,7 +2,7 @@ set -e -trap "rm apps/multiplatform/local.properties 2> /dev/null || true; rm local.properties 2> /dev/null || true; rm /tmp/simplex.keychain" EXIT +trap "rm apps/multiplatform/local.properties || true; rm local.properties || true; rm /tmp/simplex.keychain || true" EXIT echo "desktop.mac.signing.identity=Developer ID Application: SimpleX Chat Ltd (5NN7GUYB6T)" >> apps/multiplatform/local.properties echo "desktop.mac.signing.keychain=/tmp/simplex.keychain" >> apps/multiplatform/local.properties echo "desktop.mac.notarization.apple_id=$APPLE_SIMPLEX_NOTARIZATION_APPLE_ID" >> apps/multiplatform/local.properties @@ -10,10 +10,6 @@ echo "desktop.mac.notarization.password=$APPLE_SIMPLEX_NOTARIZATION_PASSWORD" >> echo "desktop.mac.notarization.team_id=5NN7GUYB6T" >> apps/multiplatform/local.properties echo "$APPLE_SIMPLEX_SIGNING_KEYCHAIN" | base64 --decode - > /tmp/simplex.keychain -security unlock-keychain -p "" /tmp/simplex.keychain -# Adding keychain to the list of keychains. -# Otherwise, it can find cert but exits while signing with "error: The specified item could not be found in the keychain." -security list-keychains -s `security list-keychains | xargs` /tmp/simplex.keychain scripts/desktop/build-lib-mac.sh cd apps/multiplatform ./gradlew packageDmg diff --git a/scripts/desktop/build-lib-linux.sh b/scripts/desktop/build-lib-linux.sh index fa1f892a03..d40fb04621 100755 --- a/scripts/desktop/build-lib-linux.sh +++ b/scripts/desktop/build-lib-linux.sh @@ -8,7 +8,7 @@ function readlink() { OS=linux ARCH=${1:-`uname -a | rev | cut -d' ' -f2 | rev`} -GHC_VERSION=9.6.3 +GHC_VERSION=8.10.7 if [ "$ARCH" == "aarch64" ]; then COMPOSE_ARCH=arm64 @@ -21,7 +21,7 @@ cd $root_dir BUILD_DIR=dist-newstyle/build/$ARCH-$OS/ghc-${GHC_VERSION}/simplex-chat-* rm -rf $BUILD_DIR -cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN -flink-rts -threaded' +cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN' --ghc-options="-optl-L$(ghc --print-libdir)/rts -optl-Wl,--as-needed,-lHSrts_thr-ghc$GHC_VERSION" cd $BUILD_DIR/build #patchelf --add-needed libHSrts_thr-ghc${GHC_VERSION}.so libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so #patchelf --add-rpath '$ORIGIN' libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so diff --git a/scripts/desktop/build-lib-mac.sh b/scripts/desktop/build-lib-mac.sh index 55e5ca6f3a..f8c27d200c 100755 --- a/scripts/desktop/build-lib-mac.sh +++ b/scripts/desktop/build-lib-mac.sh @@ -5,14 +5,13 @@ set -e OS=mac ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}" COMPOSE_ARCH=$ARCH -GHC_VERSION=9.6.3 +GHC_VERSION=8.10.7 if [ "$ARCH" == "arm64" ]; then ARCH=aarch64 else COMPOSE_ARCH=x64 fi - LIB_EXT=dylib LIB=libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT 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-* rm -rf $BUILD_DIR -cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" +cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/rts -optl-lHSrts_thr-ghc8.10.7 -optl-lffi" cd $BUILD_DIR/build mkdir deps 2> /dev/null || true # It's not included by default for some reason. Compiled lib tries to find system one but it's not always available -#cp $GHC_LIBS_DIR/libffi.dylib ./deps -( - BUILD=$PWD - cp /tmp/libffi-3.4.4/*-apple-darwin*/.libs/libffi.dylib $BUILD/deps || \ - ( \ - cd /tmp && \ - curl --tlsv1.2 "https://gitlab.haskell.org/ghc/libffi-tarballs/-/raw/libffi-3.4.4/libffi-3.4.4.tar.gz?inline=false" -o libffi.tar.gz && \ - tar -xzvf libffi.tar.gz && \ - cd "libffi-3.4.4" && \ - ./configure && \ - make && \ - cp *-apple-darwin*/.libs/libffi.dylib $BUILD/deps \ - ) -) +cp $GHC_LIBS_DIR/rts/libffi.dylib ./deps DYLIBS=`otool -L $LIB | grep @rpath | tail -n +2 | cut -d' ' -f 1 | cut -d'/' -f2` RPATHS=`otool -l $LIB | grep "path "| cut -d' ' -f11` @@ -80,8 +66,6 @@ function copy_deps() { } copy_deps $LIB -# Special case -cp $(ghc --print-libdir)/$ARCH-osx-ghc-$GHC_VERSION/libHSghc-boot-th-$GHC_VERSION-ghc$GHC_VERSION.dylib deps rm deps/`basename $LIB` cd - diff --git a/scripts/nix/basement-pr-573.patch b/scripts/nix/basement-pr-573.patch deleted file mode 100644 index 554d98c3cf..0000000000 --- a/scripts/nix/basement-pr-573.patch +++ /dev/null @@ -1,242 +0,0 @@ -From 38be2c93acb6f459d24ed6c626981c35ccf44095 Mon Sep 17 00:00:00 2001 -From: Sylvain Henry -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))) diff --git a/scripts/nix/direct-sqlcipher-2.3.27-win.patch b/scripts/nix/direct-sqlcipher-2.3.27-win.patch deleted file mode 100644 index a204038b75..0000000000 --- a/scripts/nix/direct-sqlcipher-2.3.27-win.patch +++ /dev/null @@ -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 diff --git a/scripts/nix/memory-pr-99.patch b/scripts/nix/memory-pr-99.patch deleted file mode 100644 index 4a924b766e..0000000000 --- a/scripts/nix/memory-pr-99.patch +++ /dev/null @@ -1,36 +0,0 @@ -From 2738929ce15b4c8704bbbac24a08539b5d4bf30e Mon Sep 17 00:00:00 2001 -From: sternenseemann -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 = diff --git a/simplex-chat.cabal b/simplex-chat.cabal index ddac01df01..2667f700fa 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -192,7 +192,7 @@ library , network >=3.1.2.7 && <3.2 , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , simple-logger ==0.1.* @@ -251,7 +251,7 @@ executable simplex-bot , network >=3.1.2.7 && <3.2 , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , simple-logger ==0.1.* @@ -311,7 +311,7 @@ executable simplex-bot-advanced , network >=3.1.2.7 && <3.2 , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , simple-logger ==0.1.* @@ -373,7 +373,7 @@ executable simplex-broadcast-bot , network >=3.1.2.7 && <3.2 , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , simple-logger ==0.1.* @@ -434,7 +434,7 @@ executable simplex-chat , network ==3.1.* , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , simple-logger ==0.1.* @@ -500,7 +500,7 @@ executable simplex-directory-service , network >=3.1.2.7 && <3.2 , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , simple-logger ==0.1.* @@ -586,7 +586,7 @@ test-suite simplex-chat-test , exceptions ==0.10.* , filepath ==1.4.* , generic-random ==1.5.* - , hspec ==2.11.* + , hspec ==2.7.* , http-types ==0.12.* , http2 >=4.2.2 && <4.3 , memory ==0.18.* @@ -594,7 +594,7 @@ test-suite simplex-chat-test , network ==3.1.* , network-transport ==0.5.6 , optparse-applicative >=0.15 && <0.17 - , process ==1.6.* + , process >=1.6 && <1.6.18 , random >=1.1 && <1.3 , record-hasfield ==1.0.* , silently ==1.2.* diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 820b88fdaa..9e813b55bc 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -5,7 +5,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -280,8 +279,8 @@ newChatController where configServers :: DefaultAgentServers configServers = - let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers) - xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers) + let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers) + xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers) in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig} agentServers :: ChatConfig -> IO InitialAgentServers agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do @@ -308,9 +307,9 @@ activeAgentServers ChatConfig {defaultServers} p = . filter (\ServerCfg {enabled} -> enabled) cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p)) -cfgServers p s = case p of - SPSMP -> s.smp - SPXFTP -> s.xftp +cfgServers = \case + SPSMP -> smp + SPXFTP -> xftp startChatController :: forall m. ChatMonad' m => Bool -> m (Async ()) startChatController mainApp = do @@ -469,15 +468,15 @@ processChatCommand' vr = \case chooseServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> m (NonEmpty (ProtoServerWithAuth p), [ServerCfg p]) chooseServers protocol | sameServers = - asks currentUser >>= readTVarIO >>= \case - Nothing -> throwChatError CENoActiveUser - Just user -> do - servers <- withStore' (`getProtocolServers` user) - cfg <- asks config - pure (activeAgentServers cfg protocol servers, servers) + asks currentUser >>= readTVarIO >>= \case + Nothing -> throwChatError CENoActiveUser + Just user -> do + servers <- withStore' (`getProtocolServers` user) + cfg <- asks config + pure (activeAgentServers cfg protocol servers, servers) | otherwise = do - defServers <- asks $ defaultServers . config - pure (cfgServers protocol defServers, []) + defServers <- asks $ defaultServers . config + pure (cfgServers protocol defServers, []) storeServers user servers = unless (null servers) . withStore $ \db -> overwriteProtocolServers db user servers @@ -974,7 +973,7 @@ processChatCommand' vr = \case pure $ CRContactConnectionDeleted user conn CTGroup -> do Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user chatId - let isOwner = membership.memberRole == GROwner + let isOwner = memberRole (membership :: GroupMember) == GROwner canDelete = isOwner || not (memberCurrent membership) unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo @@ -1000,13 +999,13 @@ processChatCommand' vr = \case delete ct | directOrUsed ct = pure [] | otherwise = - withStore' (\db -> checkContactHasGroups db user ct) >>= \case - Just _ -> pure [] - Nothing -> do - conns <- withStore' $ \db -> getContactConnections db userId ct - withStore' (\db -> setContactDeleted db user ct) - `catchChatError` (toView . CRChatError (Just user)) - pure $ map aConnId conns + withStore' (\db -> checkContactHasGroups db user ct) >>= \case + Just _ -> pure [] + Nothing -> do + conns <- withStore' $ \db -> getContactConnections db userId ct + withStore' (\db -> setContactDeleted db user ct) + `catchChatError` (toView . CRChatError (Just user)) + pure $ map aConnId conns CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of CTDirect -> do @@ -1234,9 +1233,10 @@ processChatCommand' vr = \case m <- withStore $ \db -> do liftIO $ updateGroupMemberSettings db user gId gMemberId settings getGroupMember db user gId gMemberId - when (memberActive m) $ forM_ (memberConnId m) $ \connId -> do - let ntfOn = showMessages $ memberSettings m - withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user)) + when (memberActive m) $ + forM_ (memberConnId m) $ \connId -> do + let ntfOn = showMessages $ memberSettings m + withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user)) ok user APIContactInfo contactId -> withUser $ \user@User {userId} -> do -- [incognito] print user's incognito profile for this contact @@ -1307,8 +1307,8 @@ processChatCommand' vr = \case Just SecurityCode {securityCode} | sameVerificationCode code securityCode -> pure ct | otherwise -> do - withStore' $ \db -> setConnectionVerified db user connId Nothing - pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} + withStore' $ \db -> setConnectionVerified db user connId Nothing + pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} _ -> pure ct pure $ CRContactCode user ct' code Nothing -> throwChatError $ CEContactNotActive ct @@ -1321,8 +1321,8 @@ processChatCommand' vr = \case Just SecurityCode {securityCode} | sameVerificationCode code securityCode -> pure m | otherwise -> do - withStore' $ \db -> setConnectionVerified db user connId Nothing - pure (m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} + withStore' $ \db -> setConnectionVerified db user connId Nothing + pure (m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} _ -> pure m pure $ CRGroupMemberCode user g m' code _ -> throwChatError CEGroupMemberNotActive @@ -1601,12 +1601,12 @@ processChatCommand' vr = \case pure $ CRSentGroupInvitation user gInfo contact member Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole} | memberStatus == GSMemInvited -> do - unless (mRole == memRole) $ withStore' $ \db -> updateGroupMemberRole db user member memRole - withStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case - Just cReq -> do - sendInvitation member {memberRole = memRole} cReq - pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole} - Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName + unless (mRole == memRole) $ withStore' $ \db -> updateGroupMemberRole db user member memRole + withStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case + Just cReq -> do + sendInvitation member {memberRole = memRole} cReq + pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole} + Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName | otherwise -> throwChatError $ CEGroupDuplicateMember cName APIJoinGroup groupId -> withUser $ \user@User {userId} -> do withChatLock "joinGroup" . procCmd $ do @@ -1618,7 +1618,7 @@ processChatCommand' vr = \case case activeConn of Just Connection {peerChatVRange} -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membership.memberId + dm <- directMessage $ XGrpAcpt (memberId (membership :: GroupMember)) agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode withStore' $ \db -> do createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode @@ -1775,7 +1775,7 @@ processChatCommand' vr = \case case memberConn m of Just mConn -> do let msg = XGrpDirectInv cReq msgContent_ - (sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ g.groupId) + (sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ groupId (g :: GroupInfo)) withStore' $ \db -> setContactGrpInvSent db ct True let ct' = ct {contactGrpInvSent = True} forM_ msgContent_ $ \mc -> do @@ -1865,7 +1865,7 @@ processChatCommand' vr = \case FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" | not (null fts) && all fileCancelledOrCompleteSMP fts -> - throwChatError $ CEFileCancel fileId "file transfer is complete" + throwChatError $ CEFileCancel fileId "file transfer is complete" | otherwise -> do fileAgentConnIds <- cancelSndFile user ftm fts True deleteAgentConnectionsAsync user fileAgentConnIds @@ -1968,8 +1968,7 @@ processChatCommand' vr = \case DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_ QuitChat -> liftIO exitSuccess ShowVersion -> do - -- simplexmqCommitQ makes iOS builds crash m( - let versionInfo = coreVersionInfo "" + let versionInfo = coreVersionInfo "" -- $(simplexmqCommitQ) chatMigrations <- map upMigration <$> withStore' (Migrations.getCurrent . DB.conn) agentMigrations <- withAgent getAgentMigrations pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations} @@ -2115,7 +2114,7 @@ processChatCommand' vr = \case xftpCfg <- readTVarIO =<< asks userXFTPFileConfig fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f - let chunks = -((-fileSize) `div` fileChunkSize) + let chunks = - ((- fileSize) `div` fileChunkSize) fileInline = inlineFileMode mc inlineFiles chunks n fileMode = case xftpCfg of Just cfg @@ -2134,18 +2133,18 @@ processChatCommand' vr = \case updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | otherwise = do - when (n /= n') $ checkValidName n' - -- read contacts before user update to correctly merge preferences - -- [incognito] filter out contacts with whom user has incognito connections - contacts <- - filter (\ct -> contactReady ct && contactActive ct && not (contactConnIncognito ct)) - <$> withStore' (`getUserContacts` user) - user' <- updateUser - asks currentUser >>= atomically . (`writeTVar` Just user') - withChatLock "updateProfile" . procCmd $ do - ChatConfig {logLevel} <- asks config - summary <- foldM (processAndCount user' logLevel) (UserProfileUpdateSummary 0 0 0 []) contacts - pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary + when (n /= n') $ checkValidName n' + -- read contacts before user update to correctly merge preferences + -- [incognito] filter out contacts with whom user has incognito connections + contacts <- + filter (\ct -> contactReady ct && contactActive ct && not (contactConnIncognito ct)) + <$> withStore' (`getUserContacts` user) + user' <- updateUser + asks currentUser >>= atomically . (`writeTVar` Just user') + withChatLock "updateProfile" . procCmd $ do + ChatConfig {logLevel} <- asks config + summary <- foldM (processAndCount user' logLevel) (UserProfileUpdateSummary 0 0 0 []) contacts + pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary where processAndCount user' ll s@UserProfileUpdateSummary {notChanged, updateSuccesses, updateFailures, changedContacts = cts} ct = do let mergedProfile = userProfileToSend user Nothing $ Just ct @@ -2166,16 +2165,16 @@ processChatCommand' vr = \case updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct | otherwise = do - assertDirectAllowed user MDSnd ct XInfo_ - ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs' - incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId - let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) - mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') - when (mergedProfile' /= mergedProfile) $ - withChatLock "updateProfile" $ do - void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) - when (directOrUsed ct') $ createSndFeatureItems user ct ct' - pure $ CRContactPrefsUpdated user ct ct' + assertDirectAllowed user MDSnd ct XInfo_ + ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs' + incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId + let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) + mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') + when (mergedProfile' /= mergedProfile) $ + withChatLock "updateProfile" $ do + void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) + when (directOrUsed ct') $ createSndFeatureItems user ct ct' + pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p@GroupProfile {displayName = n}} ms) p'@GroupProfile {displayName = n'} = do assertUserGroupRole g GROwner @@ -2194,7 +2193,7 @@ processChatCommand' vr = \case when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName} assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m () assertUserGroupRole g@GroupInfo {membership} requiredRole = do - when (membership.memberRole < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole + when (memberRole (membership :: GroupMember) < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved unless (memberActive membership) $ throwChatError CEGroupMemberNotActive @@ -2220,15 +2219,15 @@ processChatCommand' vr = \case Nothing -> throwChatError CENoCurrentCall Just call@Call {contactId} | ctId == contactId -> do - call_ <- action user ct call - case call_ of - Just call' -> do - unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId - atomically $ TM.insert ctId call' calls - _ -> do - withStore' $ \db -> deleteCalls db user ctId - atomically $ TM.delete ctId calls - ok user + call_ <- action user ct call + case call_ of + Just call' -> do + unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId + atomically $ TM.insert ctId call' calls + _ -> do + withStore' $ \db -> deleteCalls db user ctId + atomically $ TM.delete ctId calls + ok user | otherwise -> throwChatError $ CECallContact contactId withServerProtocol :: ProtocolTypeI p => SProtocolType p -> (UserProtocol p => m a) -> m a withServerProtocol p action = case userProtocol p of @@ -2238,7 +2237,7 @@ processChatCommand' vr = \case forwardFile chatName fileId sendCommand = withUser $ \user -> do withStore (\db -> getFileTransfer db user fileId) >>= \case 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} where forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs @@ -2296,12 +2295,12 @@ processChatCommand' vr = \case setUserPrivacy :: User -> User -> m ChatResponse setUserPrivacy user@User {userId} user'@User {userId = userId'} | userId == userId' = do - asks currentUser >>= atomically . (`writeTVar` Just user') - withStore' (`updateUserPrivacy` user') - pure $ CRUserPrivacy {user = user', updatedUser = user'} + asks currentUser >>= atomically . (`writeTVar` Just user') + withStore' (`updateUserPrivacy` user') + pure $ CRUserPrivacy {user = user', updatedUser = user'} | otherwise = do - withStore' (`updateUserPrivacy` user') - pure $ CRUserPrivacy {user, updatedUser = user'} + withStore' (`updateUserPrivacy` user') + pure $ CRUserPrivacy {user, updatedUser = user'} checkDeleteChatUser :: User -> m () checkDeleteChatUser user@User {userId} = do users <- withStore' getUsers @@ -2336,11 +2335,11 @@ processChatCommand' vr = \case Just (RcvDirectMsgConnection conn ct_) -> do let Connection {connStatus, contactConnInitiated} = conn if - | connStatus == ConnNew && contactConnInitiated -> + | connStatus == ConnNew && contactConnInitiated -> pure $ CPInvitationLink ILPOwnLink - | not (connReady conn) -> + | not (connReady conn) -> pure $ CPInvitationLink (ILPConnecting ct_) - | otherwise -> case ct_ of + | otherwise -> case ct_ of Just ct -> pure $ CPInvitationLink (ILPKnown ct) Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact" Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" @@ -2351,6 +2350,7 @@ processChatCommand' vr = \case ( CRInvitationUri crData {crScheme = CRSSimplex} e2e, CRInvitationUri crData {crScheme = simplexChat} e2e ) + _ -> (cReq, cReq) -- ghc8107 connectPlan user (ACR SCMContact cReq) = do let CRContactUri ConnReqUriData {crClientData} = cReq groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli @@ -2387,7 +2387,7 @@ processChatCommand' vr = \case (Nothing, Just _) -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" (Just gInfo@GroupInfo {membership}, _) | not (memberActive membership) && not (memberRemoved membership) -> - pure $ CPGroupLink (GLPConnectingProhibit gInfo_) + pure $ CPGroupLink (GLPConnectingProhibit gInfo_) | memberActive membership -> pure $ CPGroupLink (GLPKnown gInfo) | otherwise -> pure $ CPGroupLink GLPOk where @@ -2397,6 +2397,7 @@ processChatCommand' vr = \case ( CRContactUri crData {crScheme = CRSSimplex}, CRContactUri crData {crScheme = simplexChat} ) + _ -> (cReq, cReq) -- ghc8107 cReqHashes :: (ConnReqUriHash, ConnReqUriHash) cReqHashes = bimap hash hash cReqSchemas hash = ConnReqUriHash . C.sha256Hash . strEncode @@ -2649,14 +2650,14 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI inline <- receiveInline vr <- chatVersionRange if - | inline -> do + | inline -> do -- accepting inline ci <- withStoreCtx (Just "acceptFile, acceptRcvInlineFT") $ \db -> acceptRcvInlineFT db vr user fileId filePath sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId send $ XFileAcptInv sharedMsgId Nothing fName pure ci - | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName - | otherwise -> do + | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName + | otherwise -> do -- accepting via a new connection subMode <- chatReadVar subscriptionMode connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode @@ -2934,9 +2935,9 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user@User {userId} = groupEvent | memberStatus membership == GSMemInvited = CRGroupInvitation user g | all (\GroupMember {activeConn} -> isNothing activeConn) members = - if memberActive membership - then CRGroupEmpty user g - else CRGroupRemoved user g + if memberActive membership + then CRGroupEmpty user g + else CRGroupRemoved user g | otherwise = CRGroupSubscribed user g sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> m () sndFileSubsToView rs sfts = do @@ -3008,11 +3009,11 @@ cleanupManager = do `catchChatError` (toView . CRChatError (Just user)) cleanupMessages = do ts <- liftIO getCurrentTime - let cutoffTs = addUTCTime (-(30 * nominalDay)) ts + let cutoffTs = addUTCTime (- (30 * nominalDay)) ts withStoreCtx' (Just "cleanupManager, deleteOldMessages") (`deleteOldMessages` cutoffTs) cleanupProbes = do ts <- liftIO getCurrentTime - let cutoffTs = addUTCTime (-(14 * nominalDay)) ts + let cutoffTs = addUTCTime (- (14 * nominalDay)) ts withStore' (`deleteOldProbes` cutoffTs) startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m () @@ -3198,7 +3199,7 @@ processAgentMsgSndFile _corrId aFileId msg = _ -> pure () -- TODO error? SFERR e | temporaryAgentError e -> - throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e + throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e | otherwise -> do ci <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId CIFSSndError @@ -3272,7 +3273,7 @@ processAgentMsgRcvFile _corrId aFileId msg = toView $ CRRcvFileComplete user ci RFERR e | temporaryAgentError e -> - throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e + throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e | otherwise -> do ci <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId CIFSRcvError @@ -3560,18 +3561,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case chatMsgEvent of XGrpAcpt memId | sameMemberId memId m -> do - withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId XOk + withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn' confId XOk | otherwise -> messageError "x.grp.acpt: memberId is different from expected" _ -> messageError "CONF from invited member must have x.grp.acpt" _ -> case chatMsgEvent of XGrpMemInfo memId _memProfile | sameMemberId memId m -> do - -- TODO update member profile - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membership.memberId (fromLocalProfile $ memberProfile membership) + -- TODO update member profile + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn' confId $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" _ -> messageError "CONF from member must have x.grp.mem.info" INFO connInfo -> do @@ -3580,8 +3581,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case chatMsgEvent of XGrpMemInfo memId _memProfile | sameMemberId memId m -> do - -- TODO update member profile - pure () + -- TODO update member profile + pure () | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" XInfo _ -> pure () -- sent when connecting via group link XOk -> pure () @@ -3726,12 +3727,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = forM_ (invitedByGroupMemberId membership) $ \hostId -> do host <- withStore $ \db -> getGroupMember db user groupId hostId forM_ (memberConn host) $ \hostConn -> - void $ sendDirectMessage hostConn (XGrpMemCon m.memberId) (GroupId groupId) + void $ sendDirectMessage hostConn (XGrpMemCon $ memberId (m :: GroupMember)) (GroupId groupId) GCPostMember -> forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId 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" MSG msgMeta _msgFlags msgBody -> do checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure () @@ -3744,7 +3745,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Left e -> toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) checkSendRcpt $ rights aChatMsgs -- currently only a single message is forwarded - when (membership.memberRole >= GRAdmin) $ case aChatMsgs of + when (memberRole (membership :: GroupMember) >= GRAdmin) $ case aChatMsgs of [Right (ACMsg _ chatMsg)] -> forwardMsg_ chatMsg _ -> pure () where @@ -3805,7 +3806,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- invited members to which this member was introduced invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable let ms = introducedMembers <> invitedMembers - msg = XGrpMsgForward m.memberId chatMsg' brokerTs + msg = XGrpMsgForward (memberId (m :: GroupMember)) chatMsg' brokerTs unless (null ms) . void $ sendGroupMessage user gInfo ms msg RCVD msgMeta msgRcpt -> @@ -3877,11 +3878,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = mdeUpdatedCI :: (MsgDecryptError, Word32) -> CChatItem c -> Maybe (ChatItem c 'MDRcv, CIContent 'MDRcv) mdeUpdatedCI (mde', n') (CChatItem _ ci@ChatItem {content = CIRcvDecryptionError mde n}) | mde == mde' = case mde of - MDERatchetHeader -> r (n + n') - MDETooManySkipped -> r n' -- the numbers are not added as sequential MDETooManySkipped will have it incremented by 1 - MDERatchetEarlier -> r (n + n') - MDEOther -> r (n + n') - MDERatchetSync -> r 0 + MDERatchetHeader -> r (n + n') + MDETooManySkipped -> r n' -- the numbers are not added as sequential MDETooManySkipped will have it incremented by 1 + MDERatchetEarlier -> r (n + n') + MDEOther -> r (n + n') + MDERatchetSync -> r 0 | otherwise = Nothing where r n'' = Just (ci, CIRcvDecryptionError mde n'') @@ -3899,9 +3900,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- TODO save XFileAcpt message XFileAcpt name | name == fileName -> do - withStore' $ \db -> updateSndFileStatus db ft FSAccepted - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId XOk + withStore' $ \db -> updateSndFileStatus db ft FSAccepted + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn' confId XOk | otherwise -> messageError "x.file.acpt: fileName is different from expected" _ -> messageError "CONF from file connection must have x.file.acpt" CON -> do @@ -4066,8 +4067,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = _ -> toView $ CRReceivedContactRequest user cReq memberCanSend :: GroupMember -> m () -> m () - memberCanSend mem a - | mem.memberRole <= GRObserver = messageError "member is not allowed to send messages" + memberCanSend GroupMember {memberRole} a + | memberRole <= GRObserver = messageError "member is not allowed to send messages" | otherwise = a incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> m () @@ -4093,8 +4094,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case cmdData_ of Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction} | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == APCT SAEConn ERR_) -> do - withStore' $ \db -> deleteCommand db user cmdId - action cmdData + withStore' $ \db -> deleteCommand db user cmdId + action cmdData | 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 Nothing -> throwChatError . CEAgentCommandError $ "command not found, corrId = " <> show corrId @@ -4415,15 +4416,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt} | moderatorRole < GRAdmin || moderatorRole < memberRole = - createItem timed_ live + createItem timed_ live | groupFeatureAllowed SGFFullDelete gInfo = do - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed_ False - ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt - toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci' + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed_ False + ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt + toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci' | otherwise = do - file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m - 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 + file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m + 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 createItem timed_ live = do file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live @@ -4492,7 +4493,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = _ -> messageError "x.msg.del: message of another member without memberId" checkRole GroupMember {memberRole} a | 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 delete :: MsgDirectionI d => ChatItem 'CTGroup d -> Maybe GroupMember -> m ChatResponse delete ci byGroupMember @@ -4746,17 +4747,17 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact processContactProfileUpdate c@Contact {profile = p} p' createItems | fromLocalProfile p /= p' = do - c' <- withStore $ \db -> - if userTTL == rcvTTL - then updateContactProfile db user c p' - else do - c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' - updateContactProfile db user c' p' - when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c' - toView $ CRContactUpdated user c c' - pure c' + c' <- withStore $ \db -> + if userTTL == rcvTTL + then updateContactProfile db user c p' + else do + c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' + updateContactProfile db user c' p' + when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c' + toView $ CRContactUpdated user c c' + pure c' | otherwise = - pure c + pure c where Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs @@ -4844,21 +4845,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case cgm2 of COMContact c2@Contact {contactId = cId2, profile = p2} | cId1 /= cId2 && profilesMatch p1 p2 -> do - void . sendDirectContactMessage c1 $ XInfoProbeOk probe - COMContact <$$> mergeContacts c1 c2 + void . sendDirectContactMessage c1 $ XInfoProbeOk probe + COMContact <$$> mergeContacts c1 c2 | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId} | isNothing memberContactId && profilesMatch p1 p2 -> do - void . sendDirectContactMessage c1 $ XInfoProbeOk probe - COMContact <$$> associateMemberAndContact c1 m2 + void . sendDirectContactMessage c1 $ XInfoProbeOk probe + COMContact <$$> associateMemberAndContact c1 m2 | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} -> case cgm2 of COMContact c2@Contact {profile = p2} | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do - void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId) - COMContact <$$> associateMemberAndContact c2 m1 + void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId) + COMContact <$$> associateMemberAndContact c2 m1 | 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 @@ -4975,16 +4976,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just call@Call {contactId, callId, chatItemId} | contactId /= ctId' || callId /= callId' -> messageError $ eventName <> ": wrong contact or callId" | otherwise -> do - (call_, aciContent_) <- action call - case call_ of - Just call' -> do - unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId' - atomically $ TM.insert ctId' call' calls - _ -> do - withStore' $ \db -> deleteCalls db user ctId' - atomically $ TM.delete ctId' calls - forM_ aciContent_ $ \aciContent -> - updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId + (call_, aciContent_) <- action call + case call_ of + Just call' -> do + unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId' + atomically $ TM.insert ctId' call' calls + _ -> do + withStore' $ \db -> deleteCalls db user ctId' + atomically $ TM.delete ctId' calls + forM_ aciContent_ $ \aciContent -> + updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId msgCallStateError :: Text -> Call -> m () msgCallStateError eventName Call {callState} = @@ -5035,8 +5036,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = suffixOrd displayName localDisplayName | localDisplayName == displayName = Just 0 | otherwise = case T.stripPrefix (displayName <> "_") localDisplayName of - Just suffix -> readMaybe $ T.unpack suffix - Nothing -> Nothing + Just suffix -> readMaybe $ T.unpack suffix + Nothing -> Nothing associateMemberWithContact :: Contact -> GroupMember -> m Contact associateMemberWithContact c1 m2@GroupMember {groupId} = do @@ -5137,7 +5138,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> saveMemberInvitation db toMember introInv subMode <- chatReadVar subscriptionMode -- [incognito] send membership incognito profile, create direct connection as incognito - dm <- directMessage $ XGrpMemInfo membership.memberId (fromLocalProfile $ memberProfile membership) + dm <- directMessage $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership) -- [async agent commands] no continuation needed, but commands should be asynchronous for stability groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode @@ -5147,21 +5148,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> m () xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs - | membership.memberId == memId = - let gInfo' = gInfo {membership = membership {memberRole = memRole}} - in changeMemberRole gInfo' membership $ RGEUserRole memRole + | memberId (membership :: GroupMember) == memId = + let gInfo' = gInfo {membership = membership {memberRole = memRole}} + in changeMemberRole gInfo' membership $ RGEUserRole memRole | otherwise = - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case - Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole - Left _ -> messageError "x.grp.mem.role with unknown member ID" + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole + Left _ -> messageError "x.grp.mem.role with unknown member ID" where changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" | otherwise = do - withStore' $ \db -> updateGroupMemberRole db user member memRole - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) - groupMsgToView gInfo ci - toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} + withStore' $ \db -> updateGroupMemberRole db user member memRole + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) + groupMsgToView gInfo ci + toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} checkHostRole :: GroupMember -> GroupMemberRole -> m () checkHostRole GroupMember {memberRole, localDisplayName} memRole = @@ -5208,7 +5209,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> m () 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 deleteGroupLinkIfExists user gInfo -- member records are not deleted to keep history @@ -5231,7 +5232,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where checkRole GroupMember {memberRole} a | senderRole < GRAdmin || senderRole < memberRole = - messageError "x.grp.mem.del with insufficient member permissions" + messageError "x.grp.mem.del with insufficient member permissions" | otherwise = a deleteMemberItem gEvent = do ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) @@ -5263,13 +5264,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpInfo g@GroupInfo {groupProfile = p} m@GroupMember {memberRole} p' msg brokerTs | memberRole < GROwner = messageError "x.grp.info with insufficient member permissions" | otherwise = unless (p == p') $ do - g' <- withStore $ \db -> updateGroupProfile db user g p' - toView $ CRGroupUpdated user g g' (Just m) - let cd = CDGroupRcv g' m - unless (sameGroupProfileInfo p p') $ do - ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') - groupMsgToView g' ci - createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' + g' <- withStore $ \db -> updateGroupProfile db user g p' + toView $ CRGroupUpdated user g g' (Just m) + let cd = CDGroupRcv g' m + unless (sameGroupProfileInfo p p') $ do + ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') + groupMsgToView g' ci + createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> m () xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do @@ -5320,8 +5321,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> m () - xGrpMsgForward gInfo@GroupInfo {groupId} m memberId msg msgTs = do - when (m.memberRole < GRAdmin) $ throwChatError (CEGroupContactRole m.localDisplayName) + xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId msg msgTs = do + when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName) author <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memberId processForwardedMsg author msg where @@ -5372,8 +5373,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) | itemStatus == newStatus -> pure () | otherwise -> do - chatItem <- withStore $ \db -> updateDirectChatItemStatus db user ct itemId newStatus - toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) + chatItem <- withStore $ \db -> updateDirectChatItemStatus db user ct itemId newStatus + toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) _ -> pure () updateGroupMemSndStatus :: ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> m Bool @@ -5498,7 +5499,7 @@ parseFileChunk :: ChatMonad m => ByteString -> m FileChunk parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode appendFileChunk :: forall m. ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> Bool -> m () -appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs} chunkNo chunk final = +appendFileChunk ft@RcvFileTransfer {fileId, fileInvitation, fileStatus, cryptoArgs} chunkNo chunk final = case fileStatus of RFSConnected RcvFileInfo {filePath} -> append_ filePath -- sometimes update of file transfer status to FSConnected @@ -5516,7 +5517,7 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs} chunkNo chun when final $ do closeFileHandle fileId rcvFiles forM_ cryptoArgs $ \cfArgs -> do - tmpFile <- getChatTempDirectory >>= (`uniqueCombine` ft.fileInvitation.fileName) + tmpFile <- getChatTempDirectory >>= (`uniqueCombine` fileName (fileInvitation :: FileInvitation)) tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case Right () -> do removeFile fsFilePath `catchChatError` \_ -> pure () @@ -5745,7 +5746,7 @@ memberSendAction chatMsgEvent members m = case memberConn m of forwardSupported = let mcvr = memberChatVRange' m in isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward - invitingMemberSupportsForward = case m.invitedByGroupMemberId of + invitingMemberSupportsForward = case invitedByGroupMemberId m of Just invMemberId -> -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember case find (\m' -> groupMemberId' m' == invMemberId) members of @@ -5804,14 +5805,14 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta let agentMsgId = fst $ recipient agentMsgMeta newMsg = NewRcvMessage {chatMsgEvent, msgBody} rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} - amId = Just am'.groupMemberId + amId = Just $ groupMemberId' am' msg <- withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery amId) `catchChatError` \e -> case e of ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId 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 pure (am', conn', msg) @@ -5825,9 +5826,9 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember msgBody ChatMes `catchChatError` \e -> case e of ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do am <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId - if sameMemberId refAuthorMember.memberId am + if sameMemberId (memberId (refAuthorMember :: GroupMember)) am 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" throwError e _ -> throwError e @@ -5973,7 +5974,7 @@ createSndFeatureItems :: forall m. ChatMonad m => User -> Contact -> Contact -> createSndFeatureItems user ct ct' = createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref where - getPref u = (userPreference u).preference + getPref = (preference :: ContactUserPref (FeaturePreference f) -> FeaturePreference f) . userPreference type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d @@ -6057,7 +6058,7 @@ getCreateActiveUser st testView = do Right user -> pure user selectUser :: [User] -> IO User selectUser [user] = do - withTransaction st (`setActiveUser` user.userId) + withTransaction st (`setActiveUser` userId (user :: User)) pure user selectUser users = do putStrLn "Select user profile:" @@ -6071,9 +6072,9 @@ getCreateActiveUser st testView = do Just n | n <= 0 || n > length users -> putStrLn "invalid user number" >> loop | otherwise -> do - let user = users !! (n - 1) - withTransaction st (`setActiveUser` user.userId) - pure user + let user = users !! (n - 1) + withTransaction st (`setActiveUser` userId (user :: User)) + pure user userStr :: User -> String userStr User {localDisplayName, profile = LocalProfile {fullName}} = T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")" @@ -6082,10 +6083,10 @@ getCreateActiveUser st testView = do displayName <- getWithPrompt "display name" let validName = mkValidName displayName if - | null displayName -> putStrLn "display name can't be empty" >> 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 - | otherwise -> pure $ T.pack displayName + | null displayName -> putStrLn "display name can't be empty" >> 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 + | otherwise -> pure $ T.pack displayName getWithPrompt :: String -> IO String getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs index c5c5ff7eed..3f7e2c2f09 100644 --- a/src/Simplex/Chat/Bot.hs +++ b/src/Simplex/Chat/Bot.hs @@ -9,6 +9,7 @@ module Simplex.Chat.Bot where import Control.Concurrent.Async import Control.Concurrent.STM import Control.Monad +import Control.Monad.Reader import qualified Data.ByteString.Char8 as B import qualified Data.Text as T import Simplex.Chat.Controller diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 993cc1eea3..cdd1931039 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -5,7 +5,6 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -344,7 +343,7 @@ contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessag | forUser enabled && forContact enabled = Just ttl | otherwise = Nothing where - TimedMessagesPreference {ttl} = userPreference.preference + TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference) groupTimedTTL :: GroupInfo -> Maybe (Maybe Int) groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}} diff --git a/src/Simplex/Chat/Messages/Batch.hs b/src/Simplex/Chat/Messages/Batch.hs index dc2c9c3865..4c1b59f25a 100644 --- a/src/Simplex/Chat/Messages/Batch.hs +++ b/src/Simplex/Chat/Messages/Batch.hs @@ -4,11 +4,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Simplex.Chat.Messages.Batch - ( MsgBatch (..), - batchMessages, - ) -where +module Simplex.Chat.Messages.Batch ( + MsgBatch (..), + batchMessages, +) where import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -16,7 +15,6 @@ import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..)) import Simplex.Chat.Messages data MsgBatch = MsgBatch ByteString [SndMessage] - deriving (Show) -- | Batches [SndMessage] into batches of ByteStrings in form of JSON arrays. -- Does not check if the resulting batch is a valid JSON. diff --git a/src/Simplex/Chat/Mobile/Shared.hs b/src/Simplex/Chat/Mobile/Shared.hs index a4961c15f3..d55ccc7969 100644 --- a/src/Simplex/Chat/Mobile/Shared.hs +++ b/src/Simplex/Chat/Mobile/Shared.hs @@ -16,12 +16,12 @@ type JSONByteString = LB.ByteString getByteString :: Ptr Word8 -> CInt -> IO ByteString getByteString ptr len = do fp <- newForeignPtr_ ptr - pure $ BS fp $ fromIntegral len + pure $ PS fp 0 $ fromIntegral len {-# INLINE getByteString #-} putByteString :: Ptr Word8 -> ByteString -> IO () -putByteString ptr (BS fp len) = - withForeignPtr fp $ \p -> memcpy ptr p len +putByteString ptr (PS fp offset len) = + withForeignPtr fp $ \p -> memcpy ptr (p `plusPtr` offset) len {-# INLINE putByteString #-} putLazyByteString :: Ptr Word8 -> LB.ByteString -> IO () diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 7504f19c95..b54a986d2b 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -489,7 +488,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers ExceptT $ maybeM getContactRequestByXContactId xContactId_ >>= \case Nothing -> createContactRequest - Just cr -> updateContactRequest cr $> Right cr.contactRequestId + Just cr -> updateContactRequest cr $> Right (contactRequestId (cr :: UserContactRequest)) getContactRequest db user cReqId createContactRequest :: IO (Either StoreError Int64) createContactRequest = do diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 4d419c5727..abc368e9a3 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -493,7 +492,7 @@ createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do currentTs <- liftIO getCurrentTime rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr - let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ + let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_ -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP @@ -514,7 +513,7 @@ createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvi createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do currentTs <- liftIO getCurrentTime rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr - let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ + let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_ -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_ fileProtocol = if isJust rfd_ then FPXFTP else FPSMP @@ -929,7 +928,7 @@ getLocalCryptoFile db userId fileId sent = _ -> do unless sent $ throwError $ SEFileNotFound 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 -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem updateDirectCIFileStatus db vr user fileId fileStatus = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 2066626364..ddb97e590a 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} @@ -358,7 +357,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ "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) 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 membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} @@ -1056,7 +1055,7 @@ saveIntroInvitation db reMember toMember introInv = do WHERE group_member_intro_id = :intro_id |] [ ":intro_status" := GMIntroInvReceived, - ":group_queue_info" := introInv.groupConnReq, + ":group_queue_info" := groupConnReq (introInv :: IntroInvitation), ":direct_queue_info" := directConnReq introInv, ":updated_at" := currentTs, ":intro_id" := introId intro @@ -1164,7 +1163,7 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO () createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do - let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn + let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn currentTs <- getCurrentTime Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode setCommandConnId db user groupCmdId groupConnId diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index ce1d17859a..c5781a1cfe 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -296,7 +296,7 @@ getUserContactProfiles db User {userId} = |] (Only userId) where - toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> Profile + toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> (Profile) toContactProfile (displayName, fullName, image, contactLink, preferences) = Profile {displayName, fullName, image, contactLink, preferences} createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> SubscriptionMode -> ExceptT StoreError IO () diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index de2dfa8b58..b69f18f8f7 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -9,7 +9,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -61,21 +60,21 @@ class IsContact a where preferences' :: a -> Maybe Preferences instance IsContact User where - contactId' u = u.userContactId + contactId' = userContactId {-# INLINE contactId' #-} - profile' u = u.profile + profile' = profile {-# INLINE profile' #-} - localDisplayName' u = u.localDisplayName + localDisplayName' = localDisplayName {-# INLINE localDisplayName' #-} preferences' User {profile = LocalProfile {preferences}} = preferences {-# INLINE preferences' #-} instance IsContact Contact where - contactId' c = c.contactId + contactId' = contactId {-# INLINE contactId' #-} - profile' c = c.profile + profile' = profile {-# INLINE profile' #-} - localDisplayName' c = c.localDisplayName + localDisplayName' = localDisplayName {-# INLINE localDisplayName' #-} preferences' Contact {profile = LocalProfile {preferences}} = preferences {-# INLINE preferences' #-} @@ -196,7 +195,7 @@ directOrUsed ct@Contact {contactUsed} = contactDirect ct || contactUsed 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 {activeConn} = maybe False connReady activeConn diff --git a/src/Simplex/Chat/Types/Preferences.hs b/src/Simplex/Chat/Types/Preferences.hs index 18a10a83f4..0597ee48cf 100644 --- a/src/Simplex/Chat/Types/Preferences.hs +++ b/src/Simplex/Chat/Types/Preferences.hs @@ -7,7 +7,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -15,7 +14,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} {-# HLINT ignore "Use newtype instead of data" #-} @@ -79,12 +77,12 @@ allChatFeatures = ] chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f) -chatPrefSel f ps = case f of - SCFTimedMessages -> ps.timedMessages - SCFFullDelete -> ps.fullDelete - SCFReactions -> ps.reactions - SCFVoice -> ps.voice - SCFCalls -> ps.calls +chatPrefSel = \case + SCFTimedMessages -> timedMessages + SCFFullDelete -> fullDelete + SCFReactions -> reactions + SCFVoice -> voice + SCFCalls -> calls chatFeature :: SChatFeature f -> ChatFeature chatFeature = \case @@ -104,12 +102,12 @@ instance PreferenceI (Maybe Preferences) where getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs) instance PreferenceI FullPreferences where - getPreference f ps = case f of - SCFTimedMessages -> ps.timedMessages - SCFFullDelete -> ps.fullDelete - SCFReactions -> ps.reactions - SCFVoice -> ps.voice - SCFCalls -> ps.calls + getPreference = \case + SCFTimedMessages -> timedMessages + SCFFullDelete -> fullDelete + SCFReactions -> reactions + SCFVoice -> voice + SCFCalls -> calls {-# INLINE getPreference #-} setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences @@ -198,14 +196,14 @@ allGroupFeatures :: [AGroupFeature] allGroupFeatures = allGroupFeatureItems <> [AGF SGFHistory] groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f) -groupPrefSel f ps = case f of - SGFTimedMessages -> ps.timedMessages - SGFDirectMessages -> ps.directMessages - SGFFullDelete -> ps.fullDelete - SGFReactions -> ps.reactions - SGFVoice -> ps.voice - SGFFiles -> ps.files - SGFHistory -> ps.history +groupPrefSel = \case + SGFTimedMessages -> timedMessages + SGFDirectMessages -> directMessages + SGFFullDelete -> fullDelete + SGFReactions -> reactions + SGFVoice -> voice + SGFFiles -> files + SGFHistory -> history toGroupFeature :: SGroupFeature f -> GroupFeature toGroupFeature = \case @@ -227,14 +225,14 @@ instance GroupPreferenceI (Maybe GroupPreferences) where getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs) instance GroupPreferenceI FullGroupPreferences where - getGroupPreference f ps = case f of - SGFTimedMessages -> ps.timedMessages - SGFDirectMessages -> ps.directMessages - SGFFullDelete -> ps.fullDelete - SGFReactions -> ps.reactions - SGFVoice -> ps.voice - SGFFiles -> ps.files - SGFHistory -> ps.history + getGroupPreference = \case + SGFTimedMessages -> timedMessages + SGFDirectMessages -> directMessages + SGFFullDelete -> fullDelete + SGFReactions -> reactions + SGFVoice -> voice + SGFFiles -> files + SGFHistory -> history {-# INLINE getGroupPreference #-} -- collection of optional group preferences @@ -384,19 +382,19 @@ class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureA prefParam :: FeaturePreference f -> Maybe Int instance HasField "allow" TimedMessagesPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: TimedMessagesPreference)) instance HasField "allow" FullDeletePreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: FullDeletePreference)) instance HasField "allow" ReactionsPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: ReactionsPreference)) instance HasField "allow" VoicePreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: VoicePreference)) instance HasField "allow" CallsPreference FeatureAllowed where - hasField p = (\allow -> p {allow}, p.allow) + hasField p = (\allow -> p {allow}, allow (p :: CallsPreference)) instance FeatureI 'CFTimedMessages where type FeaturePreference 'CFTimedMessages = TimedMessagesPreference @@ -463,28 +461,28 @@ class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference groupPrefParam :: GroupFeaturePreference f -> Maybe Int instance HasField "enable" GroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: GroupPreference)) instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: TimedMessagesGroupPreference)) instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: DirectMessagesGroupPreference)) instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: ReactionsGroupPreference)) instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: FullDeleteGroupPreference)) instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: VoiceGroupPreference)) instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference)) instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where - hasField p = (\enable -> p {enable}, p.enable) + hasField p = (\enable -> p {enable}, enable (p :: HistoryGroupPreference)) instance GroupFeatureI 'GFTimedMessages where type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference @@ -722,12 +720,12 @@ preferenceState pref = in (allow, param) getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f) -getContactUserPreference f ps = case f of - SCFTimedMessages -> ps.timedMessages - SCFFullDelete -> ps.fullDelete - SCFReactions -> ps.reactions - SCFVoice -> ps.voice - SCFCalls -> ps.calls +getContactUserPreference = \case + SCFTimedMessages -> timedMessages + SCFFullDelete -> fullDelete + SCFReactions -> reactions + SCFVoice -> voice + SCFCalls -> calls $(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index b0408690ae..b328ce9c03 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -212,7 +211,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRContactConnecting u _ -> ttyUser u [] CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"] - CRSubscriptionEnd u acEntity -> ttyUser u [sShow ((entityConnection acEntity).connId) <> ": END"] + CRSubscriptionEnd u acEntity -> ttyUser u [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"] CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e] @@ -494,7 +493,7 @@ viewGroupSubscribed :: GroupInfo -> [StyledString] viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"] showSMPServer :: SMPServer -> String -showSMPServer srv = B.unpack $ strEncode srv.host +showSMPServer ProtocolServer {host} = B.unpack $ strEncode host viewHostEvent :: AProtocolType -> TransportHost -> String viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h) @@ -953,7 +952,7 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt 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) role :: GroupMember -> String - role m = B.unpack . strEncode $ m.memberRole + role m = B.unpack . strEncode $ memberRole (m :: GroupMember) category m = case memberCategory m of GCUserMember -> ["you"] GCInviteeMember -> ["invited"] @@ -991,7 +990,7 @@ viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g Text - ldn_ g = T.toLower g.localDisplayName + ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) groupSS (g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}}, GroupSummary {currentMembers}) = case memberStatus membership of GSMemInvited -> groupInvitation' g @@ -1906,7 +1905,7 @@ viewChatError logLevel testView = \case "[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] " Nothing -> "" cId :: Connection -> StyledString - cId conn = sShow conn.connId + cId conn = sShow (connId (conn :: Connection)) ChatErrorRemoteCtrl e -> [plain $ "remote controller 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] diff --git a/tests/Bots/BroadcastTests.hs b/tests/Bots/BroadcastTests.hs index ed0b9e069a..12eaff11c2 100644 --- a/tests/Bots/BroadcastTests.hs +++ b/tests/Bots/BroadcastTests.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Bots.BroadcastTests where @@ -34,7 +33,7 @@ broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadc mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts mkBotOpts tmp publishers = BroadcastBotOpts - { coreOptions = testOpts.coreOptions {dbFilePrefix = tmp botDbPrefix}, + { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp botDbPrefix}, publishers, welcomeMessage = defaultWelcomeMessage publishers, prohibitedMessage = defaultWelcomeMessage publishers diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 3c6991bb52..b33f4f569f 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} @@ -64,7 +63,7 @@ directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", im mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts mkDirectoryOpts tmp superUsers = DirectoryOpts - { coreOptions = testOpts.coreOptions {dbFilePrefix = tmp serviceDbPrefix}, + { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp serviceDbPrefix}, superUsers, directoryLog = Just $ tmp "directory_service.log", serviceName = "SimpleX-Directory",