dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-24 21:45:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into master-android

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-05-24 21:34:06 +01:00
parent cdf5520084 23581f59ae
commit 312d315d73
21 changed files with 226 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
apps/ios/SimpleX.xcodeproj/project.pbxproj
+26 -26
View File
@@ -76,11 +76,11 @@
5C9CC7AD28C55D7800BEF955 /* DatabaseEncryptionView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C9CC7AC28C55D7800BEF955 /* DatabaseEncryptionView.swift */; };
5C9D13A3282187BB00AB8B43 /* WebRTC.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C9D13A2282187BB00AB8B43 /* WebRTC.swift */; };
5C9D811A2AA8727A001D49FD /* CryptoFile.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C9D81182AA7A4F1001D49FD /* CryptoFile.swift */; };
5C9F3DCC2BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DC72BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g.a */; };
5C9F3DCD2BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DC82BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g-ghc9.6.3.a */; };
5C9F3DCE2BF7A6900003B86B /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DC92BF7A6900003B86B /* libgmp.a */; };
5C9F3DCF2BF7A6900003B86B /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DCA2BF7A6900003B86B /* libgmpxx.a */; };
5C9F3DD02BF7A6900003B86B /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DCB2BF7A6900003B86B /* libffi.a */; };
5C9F3DD62BFBCDD90003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DD12BFBCDD80003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf-ghc9.6.3.a */; };
5C9F3DD72BFBCDD90003B86B /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DD22BFBCDD80003B86B /* libffi.a */; };
5C9F3DD82BFBCDD90003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DD32BFBCDD80003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf.a */; };
5C9F3DD92BFBCDD90003B86B /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DD42BFBCDD90003B86B /* libgmpxx.a */; };
5C9F3DDA2BFBCDD90003B86B /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C9F3DD52BFBCDD90003B86B /* libgmp.a */; };
5C9FD96E27A5D6ED0075386C /* SendMessageView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C9FD96D27A5D6ED0075386C /* SendMessageView.swift */; };
5CA059DC279559F40002BEB4 /* Tests_iOS.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059DB279559F40002BEB4 /* Tests_iOS.swift */; };
5CA059DE279559F40002BEB4 /* Tests_iOSLaunchTests.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059DD279559F40002BEB4 /* Tests_iOSLaunchTests.swift */; };
@@ -359,11 +359,11 @@
5C9CC7AC28C55D7800BEF955 /* DatabaseEncryptionView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = DatabaseEncryptionView.swift; sourceTree = "<group>"; };
5C9D13A2282187BB00AB8B43 /* WebRTC.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = WebRTC.swift; sourceTree = "<group>"; };
5C9D81182AA7A4F1001D49FD /* CryptoFile.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CryptoFile.swift; sourceTree = "<group>"; };
5C9F3DC72BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g.a"; sourceTree = "<group>"; };
5C9F3DC82BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g-ghc9.6.3.a"; sourceTree = "<group>"; };
5C9F3DC92BF7A6900003B86B /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
5C9F3DCA2BF7A6900003B86B /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
5C9F3DCB2BF7A6900003B86B /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
5C9F3DD12BFBCDD80003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf-ghc9.6.3.a"; sourceTree = "<group>"; };
5C9F3DD22BFBCDD80003B86B /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
5C9F3DD32BFBCDD80003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf.a"; sourceTree = "<group>"; };
5C9F3DD42BFBCDD90003B86B /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
5C9F3DD52BFBCDD90003B86B /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
5C9FD96A27A56D4D0075386C /* JSON.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = JSON.swift; sourceTree = "<group>"; };
5C9FD96D27A5D6ED0075386C /* SendMessageView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SendMessageView.swift; sourceTree = "<group>"; };
5CA059C3279559F40002BEB4 /* SimpleXApp.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SimpleXApp.swift; sourceTree = "<group>"; };
@@ -539,13 +539,13 @@
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
5C9F3DCF2BF7A6900003B86B /* libgmpxx.a in Frameworks */,
5C9F3DD92BFBCDD90003B86B /* libgmpxx.a in Frameworks */,
5C9F3DDA2BFBCDD90003B86B /* libgmp.a in Frameworks */,
5C9F3DD82BFBCDD90003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf.a in Frameworks */,
5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
5C9F3DCE2BF7A6900003B86B /* libgmp.a in Frameworks */,
5C9F3DCC2BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g.a in Frameworks */,
5C9F3DD02BF7A6900003B86B /* libffi.a in Frameworks */,
5C9F3DD62BFBCDD90003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf-ghc9.6.3.a in Frameworks */,
5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
5C9F3DCD2BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g-ghc9.6.3.a in Frameworks */,
5C9F3DD72BFBCDD90003B86B /* libffi.a in Frameworks */,
);
runOnlyForDeploymentPostprocessing = 0;
};
@@ -611,11 +611,11 @@
5C764E5C279C70B7000C6508 /* Libraries */ = {
isa = PBXGroup;
children = (
5C9F3DCB2BF7A6900003B86B /* libffi.a */,
5C9F3DC92BF7A6900003B86B /* libgmp.a */,
5C9F3DCA2BF7A6900003B86B /* libgmpxx.a */,
5C9F3DC82BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g-ghc9.6.3.a */,
5C9F3DC72BF7A6900003B86B /* libHSsimplex-chat-5.8.0.1-BrjXjAnJqNV7yWXU89n05g.a */,
5C9F3DD22BFBCDD80003B86B /* libffi.a */,
5C9F3DD52BFBCDD90003B86B /* libgmp.a */,
5C9F3DD42BFBCDD90003B86B /* libgmpxx.a */,
5C9F3DD12BFBCDD80003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf-ghc9.6.3.a */,
5C9F3DD32BFBCDD80003B86B /* libHSsimplex-chat-5.8.0.2-8RkLdmy05dJBsgWrGV50Uf.a */,
);
path = Libraries;
sourceTree = "<group>";
@@ -1562,7 +1562,7 @@
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 217;
CURRENT_PROJECT_VERSION = 218;
DEAD_CODE_STRIPPING = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
@@ -1611,7 +1611,7 @@
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 217;
CURRENT_PROJECT_VERSION = 218;
DEAD_CODE_STRIPPING = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
@@ -1697,7 +1697,7 @@
CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements";
CODE_SIGN_IDENTITY = "Apple Development";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 217;
CURRENT_PROJECT_VERSION = 218;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
GCC_OPTIMIZATION_LEVEL = s;
@@ -1734,7 +1734,7 @@
CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements";
CODE_SIGN_IDENTITY = "Apple Development";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 217;
CURRENT_PROJECT_VERSION = 218;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
ENABLE_CODE_COVERAGE = NO;
@@ -1771,7 +1771,7 @@
CLANG_TIDY_BUGPRONE_REDUNDANT_BRANCH_CONDITION = YES;
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 217;
CURRENT_PROJECT_VERSION = 218;
DEFINES_MODULE = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
DYLIB_COMPATIBILITY_VERSION = 1;
@@ -1822,7 +1822,7 @@
CLANG_TIDY_BUGPRONE_REDUNDANT_BRANCH_CONDITION = YES;
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 217;
CURRENT_PROJECT_VERSION = 218;
DEFINES_MODULE = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
DYLIB_COMPATIBILITY_VERSION = 1;
apps/multiplatform/gradle.properties
+4 -4
View File
@@ -26,11 +26,11 @@ android.enableJetifier=true
kotlin.mpp.androidSourceSetLayoutVersion=2
kotlin.jvm.target=11
android.version_name=5.8-beta.1
android.version_code=209
android.version_name=5.8-beta.2
android.version_code=210
desktop.version_name=5.8-beta.1
desktop.version_code=46
desktop.version_name=5.8-beta.2
desktop.version_code=47
kotlin.version=1.9.23
gradle.plugin.version=8.2.0
apps/simplex-directory-service/src/Directory/Events.hs
+11 -1
View File
@@ -35,8 +35,10 @@ import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol (MsgContent (..))
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (AgentErrorType (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util ((<$?>))
import Simplex.Messaging.Protocol (BrokerErrorType (..))
import Simplex.Messaging.Util (tshow, (<$?>))
data DirectoryEvent
= DEContactConnected Contact
@@ -53,6 +55,7 @@ data DirectoryEvent
| DEItemEditIgnored Contact
| DEItemDeleteIgnored Contact
| DEContactCommand Contact ChatItemId ADirectoryCmd
| DELogChatResponse Text
deriving (Show)
crDirectoryEvent :: ChatResponse -> Maybe DirectoryEvent
@@ -77,6 +80,13 @@ crDirectoryEvent = \case
where
ciId = chatItemId' ci
err = ADC SDRUser DCUnknownCommand
CRMessageError {severity, errorMessage} -> Just $ DELogChatResponse $ "message error: " <> severity <> ", " <> errorMessage
CRChatCmdError {chatError} -> Just $ DELogChatResponse $ "chat cmd error: " <> tshow chatError
CRChatError {chatError} -> case chatError of
ChatErrorAgent {agentError = BROKER _ NETWORK} -> Nothing
ChatErrorAgent {agentError = BROKER _ TIMEOUT} -> Nothing
_ -> Just $ DELogChatResponse $ "chat error: " <> tshow chatError
CRChatErrors {chatErrors} -> Just $ DELogChatResponse $ "chat errors: " <> T.intercalate ", " (map tshow chatErrors)
_ -> Nothing
data DirectoryRole = DRUser | DRSuperUser
apps/simplex-directory-service/src/Directory/Service.hs
+1
View File
@@ -102,6 +102,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, searchResults, testi
case sUser of
SDRUser -> deUserCommand env ct ciId cmd
SDRSuperUser -> deSuperUserCommand ct ciId cmd
DELogChatResponse r -> logInfo r
where
withSuperUsers action = void . forkIO $ forM_ superUsers $ \KnownContact {contactId} -> action contactId
notifySuperUsers s = withSuperUsers $ \contactId -> sendMessage' cc contactId s
apps/simplex-directory-service/src/Directory/Store.hs
+7 -6
View File
@@ -39,8 +39,8 @@ import Data.Text (Text)
import Simplex.Chat.Types
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util (ifM)
import System.IO (Handle, IOMode (..), openFile, BufferMode (..), hSetBuffering)
import System.Directory (renameFile, doesFileExist)
import System.Directory (doesFileExist, renameFile)
import System.IO (BufferMode (..), Handle, IOMode (..), hSetBuffering, openFile)
data DirectoryStore = DirectoryStore
{ groupRegs :: TVar [GroupReg],
@@ -112,7 +112,7 @@ addGroupReg st ct GroupInfo {groupId} grStatus = do
let ugrId = 1 + foldl' maxUgrId 0 grs
grData' = grData {userGroupRegId_ = ugrId}
gr' = gr {userGroupRegId = ugrId}
in (grData', gr' : grs)
in (grData', gr' : grs)
ctId = contactId' ct
maxUgrId mx GroupReg {dbContactId, userGroupRegId}
| dbContactId == ctId && userGroupRegId > mx = userGroupRegId
@@ -311,14 +311,15 @@ readDirectoryData f =
Right r -> case r of
GRCreate gr@GroupRegData {dbGroupId_ = gId} -> do
when (isJust $ M.lookup gId m) $
putStrLn $ "Warning: duplicate group with ID " <> show gId <> ", group replaced."
putStrLn $
"Warning: duplicate group with ID " <> show gId <> ", group replaced."
pure $ M.insert gId gr m
GRUpdateStatus gId groupRegStatus_ -> case M.lookup gId m of
Just gr -> pure $ M.insert gId gr {groupRegStatus_} m
Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <>", status update ignored.")
Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", status update ignored.")
GRUpdateOwner gId grOwnerId -> case M.lookup gId m of
Just gr -> pure $ M.insert gId gr {dbOwnerMemberId_ = Just grOwnerId} m
Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <>", owner update ignored.")
Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", owner update ignored.")
writeDirectoryData :: FilePath -> [GroupRegData] -> IO Handle
writeDirectoryData f grs = do
cabal.project
+1 -1
View File
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: e3f5d244c1a435593e33adc023bf1f920f379f8d
tag: bd67844169d2206d8543c01e6ed966315115b0e3
source-repository-package
type: git
package.yaml
+22 -3
View File
@@ -1,5 +1,5 @@
name: simplex-chat
version: 5.8.0.2
version: 5.8.0.3
#synopsis:
#description:
homepage: https://github.com/simplex-chat/simplex-chat#readme
@@ -152,12 +152,31 @@ tests:
ghc-options:
# - -haddock
- -O2
- -Wall
- -Weverything
- -Wno-missing-exported-signatures
- -Wno-missing-import-lists
- -Wno-missed-specialisations
- -Wno-all-missed-specialisations
- -Wno-unsafe
- -Wno-safe
- -Wno-missing-local-signatures
- -Wno-missing-kind-signatures
- -Wno-missing-deriving-strategies
- -Wno-monomorphism-restriction
- -Wno-prepositive-qualified-module
- -Wno-unused-packages
- -Wno-implicit-prelude
- -Wno-missing-safe-haskell-mode
- -Wno-missing-export-lists
- -Wno-partial-fields
- -Wcompat
- -Werror=incomplete-record-updates
- -Werror=incomplete-patterns
- -Werror=missing-methods
- -Werror=incomplete-uni-patterns
- -Werror=tabs
- -Wredundant-constraints
- -Wincomplete-record-updates
- -Wincomplete-uni-patterns
- -Wunused-type-patterns
default-extensions:
scripts/nix/sha256map.nix
+1 -1
View File
@@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."e3f5d244c1a435593e33adc023bf1f920f379f8d" = "1klin78kgvgzdvf64nahn3280m7hw5f8wzrca43cmyajm2qp3wfs";
"https://github.com/simplex-chat/simplexmq.git"."bd67844169d2206d8543c01e6ed966315115b0e3" = "1g218q15hrg21h8gyidavfys5zx8dzmxq7iwfm5bfaw71grpd7pn";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
simplex-chat.cabal
+8 -8
View File
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: simplex-chat
version: 5.8.0.2
version: 5.8.0.3
category: Web, System, Services, Cryptography
homepage: https://github.com/simplex-chat/simplex-chat#readme
author: simplex.chat
@@ -190,7 +190,7 @@ library
src
default-extensions:
StrictData
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
@@ -252,7 +252,7 @@ executable simplex-bot
apps/simplex-bot
default-extensions:
StrictData
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
@@ -315,7 +315,7 @@ executable simplex-bot-advanced
apps/simplex-bot-advanced
default-extensions:
StrictData
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
@@ -381,7 +381,7 @@ executable simplex-broadcast-bot
Broadcast.Bot
Broadcast.Options
Paths_simplex_chat
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
@@ -445,7 +445,7 @@ executable simplex-chat
apps/simplex-chat
default-extensions:
StrictData
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
@@ -515,7 +515,7 @@ executable simplex-directory-service
Directory.Service
Directory.Store
Paths_simplex_chat
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
@@ -610,7 +610,7 @@ test-suite simplex-chat-test
apps/simplex-directory-service/src
default-extensions:
StrictData
ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
build-depends:
QuickCheck ==2.14.*
, aeson ==2.2.*
src/Simplex/Chat.hs
+87 -40
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -228,6 +229,7 @@ newChatController
smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode
agentAsync <- newTVarIO Nothing
random <- liftIO C.newRandom
eventSeq <- newTVarIO 0
inputQ <- newTBQueueIO tbqSize
outputQ <- newTBQueueIO tbqSize
connNetworkStatuses <- atomically TM.empty
@@ -265,6 +267,7 @@ newChatController
chatStore,
chatStoreChanged,
random,
eventSeq,
inputQ,
outputQ,
connNetworkStatuses,
@@ -1701,7 +1704,7 @@ processChatCommand' vr = \case
sndMsgs <- lift $ createSndMessages idsEvts
let msgReqs_ :: NonEmpty (Either ChatError MsgReq) = L.zipWith (fmap . ctMsgReq) ctConns sndMsgs
(errs, ctSndMsgs :: [(Contact, SndMessage)]) <-
lift $ partitionEithers . L.toList . zipWith3' combineResults ctConns sndMsgs <$> deliverMessagesB msgReqs_
partitionEithers . L.toList . zipWith3' combineResults ctConns sndMsgs <$> deliverMessagesB msgReqs_
timestamp <- liftIO getCurrentTime
lift . void $ withStoreBatch' $ \db -> map (createCI db user timestamp) ctSndMsgs
pure CRBroadcastSent {user, msgContent = mc, successes = length ctSndMsgs, failures = length errs, timestamp}
@@ -2397,7 +2400,7 @@ processChatCommand' vr = \case
Just changedCts -> do
let idsEvts = L.map ctSndEvent changedCts
msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts
(errs, cts) <- lift $ partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
(errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
unless (null errs) $ toView $ CRChatErrors (Just user) errs
let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts
lift $ createContactsSndFeatureItems user' changedCts'
@@ -3316,7 +3319,10 @@ deleteGroupLink_ user gInfo conn = do
agentSubscriber :: CM' ()
agentSubscriber = do
q <- asks $ subQ . smpAgent
forever $ atomically (readTBQueue q) >>= process
forever (atomically (readTBQueue q) >>= process)
`E.catchAny` \e -> do
toView' $ CRChatError Nothing $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) Nothing
E.throwIO e
where
process :: (ACorrId, EntityId, APartyCmd 'Agent) -> CM' ()
process (corrId, entId, APC e msg) = run $ case e of
@@ -3936,7 +3942,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO only acknowledge without saving message?
-- probably this branch is never executed, so there should be no reason
-- to save message if contact hasn't been created yet - chat item isn't created anyway
withAckMessage' agentConnId meta $
withAckMessage' "new contact msg" agentConnId meta $
void $
saveDirectRcvMSG conn meta msgBody
SENT msgId _proxy ->
@@ -3967,14 +3973,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
forM_ contData $ \(hostConnId, xGrpMemIntroCont) ->
sendXGrpMemInv hostConnId (Just directConnReq) xGrpMemIntroCont
CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
MSG msgMeta _msgFlags msgBody ->
withAckMessage agentConnId msgMeta True $ do
MSG msgMeta _msgFlags msgBody -> do
tags <- newTVarIO []
withAckMessage "contact msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do
let MsgMeta {pqEncryption} = msgMeta
(ct', conn') <- updateContactPQRcv user ct conn pqEncryption
checkIntegrityCreateItem (CDDirectRcv ct') msgMeta `catchChatError` \_ -> pure ()
(conn'', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn' msgMeta msgBody
let tag = toCMEventTag event
atomically $ writeTVar tags [tshow tag]
logInfo $ "contact msg=" <> tshow tag <> " " <> eInfo
let ct'' = ct' {activeConn = Just conn''} :: Contact
assertDirectAllowed user MDRcv ct'' $ toCMEventTag event
assertDirectAllowed user MDRcv ct'' tag
case event of
XMsgNew mc -> newContentMessage ct'' mc msg msgMeta
XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr
@@ -3999,9 +4009,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
BFileChunk sharedMsgId chunk -> bFileChunk ct'' sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event)
let Contact {chatSettings = ChatSettings {sendRcpts}} = ct''
pure $ fromMaybe (sendRcptsContacts user) sendRcpts && hasDeliveryReceipt (toCMEventTag event)
pure $ fromMaybe (sendRcptsContacts user) sendRcpts && hasDeliveryReceipt tag
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId msgMeta $
withAckMessage' "contact rcvd" agentConnId msgMeta $
directMsgReceived ct conn msgMeta msgRcpt
CONF confId pqSupport _ connInfo -> do
conn' <- processCONFpqSupport conn pqSupport
@@ -4380,19 +4390,26 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId
_ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
MSG msgMeta _msgFlags msgBody -> do
withAckMessage agentConnId msgMeta True $ do
tags <- newTVarIO []
withAckMessage "group msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure ()
forM_ aChatMsgs $ \case
Right (ACMsg _ chatMsg) ->
processEvent chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e
Left e -> toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e)
forwardMsg_ `catchChatError` \_ -> pure ()
processEvent tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e
Left e -> do
atomically $ modifyTVar' tags ("error" :)
logInfo $ "group msg=error " <> eInfo <> " " <> tshow e
toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e)
forwardMsg_ `catchChatError` (toView . CRChatError (Just user))
checkSendRcpt $ rights aChatMsgs
where
aChatMsgs = parseChatMessages msgBody
brokerTs = metaBrokerTs msgMeta
processEvent :: MsgEncodingI e => ChatMessage e -> CM ()
processEvent chatMsg = do
processEvent :: TVar [Text] -> Text -> MsgEncodingI e => ChatMessage e -> CM ()
processEvent tags eInfo chatMsg@ChatMessage {chatMsgEvent} = do
let tag = toCMEventTag chatMsgEvent
atomically $ modifyTVar' tags (tshow tag :)
logInfo $ "group msg=" <> tshow tag <> " " <> eInfo
(m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta msgBody chatMsg
case event of
XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False
@@ -4423,7 +4440,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
XInfoProbeCheck probeHash -> xInfoProbeCheck (COMGroupMember m') probeHash
XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event)
_ -> messageError $ "unsupported message: " <> tshow event
checkSendRcpt :: [AChatMessage] -> CM Bool
checkSendRcpt aMsgs = do
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
@@ -4457,7 +4474,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
sendGroupMessage' user gInfo ms msg
_ -> pure ()
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId msgMeta $
withAckMessage' "group rcvd" agentConnId msgMeta $
groupMsgReceived gInfo m conn msgMeta msgRcpt
SENT msgId proxy -> do
sentMsgDeliveryEvent conn msgId
@@ -4581,7 +4598,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
lookupChatItemByFileId db vr user fileId
toView $ CRSndFileRcvCancelled user ci ft
_ -> throwChatError $ CEFileSend fileId err
MSG meta _ _ -> withAckMessage' agentConnId meta $ pure ()
MSG meta _ _ ->
withAckMessage' "file msg" agentConnId meta $ pure ()
OK ->
-- [async agent commands] continuation on receiving OK
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
@@ -4657,7 +4675,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
RcvChunkOk ->
if B.length chunk /= fromInteger chunkSize
then badRcvFileChunk ft "incorrect chunk size"
else withAckMessage' agentConnId meta $ appendFileChunk ft chunkNo chunk False
else withAckMessage' "file msg" agentConnId meta $ appendFileChunk ft chunkNo chunk False
RcvChunkFinal ->
if B.length chunk > fromInteger chunkSize
then badRcvFileChunk ft "incorrect chunk size"
@@ -4671,7 +4689,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
getChatItemByFileId db vr user fileId
toView $ CRRcvFileComplete user ci
forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn)
RcvChunkDuplicate -> withAckMessage' agentConnId meta $ pure ()
RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure ()
RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> CM ()
@@ -4755,25 +4773,45 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withStore' $ \db -> updateCommandStatus db user cmdId CSError
throwChatError . CEAgentCommandError $ msg
withAckMessage' :: ConnId -> MsgMeta -> CM () -> CM ()
withAckMessage' cId msgMeta action = do
withAckMessage cId msgMeta False $ action $> False
withAckMessage' :: Text -> ConnId -> MsgMeta -> CM () -> CM ()
withAckMessage' label cId msgMeta action = do
withAckMessage label cId msgMeta False Nothing $ \_ -> action $> False
withAckMessage :: ConnId -> MsgMeta -> Bool -> CM Bool -> CM ()
withAckMessage cId msgMeta showCritical action =
withAckMessage :: Text -> ConnId -> MsgMeta -> Bool -> Maybe (TVar [Text]) -> (Text -> CM Bool) -> CM ()
withAckMessage label cId msgMeta showCritical tags action = do
-- [async agent commands] command should be asynchronous
-- TODO catching error and sending ACK after an error, particularly if it is a database error, will result in the message not processed (and no notification to the user).
-- Possible solutions are:
-- 1) retry processing several times
-- 2) stabilize database
-- 3) show screen of death to the user asking to restart
tryChatError action >>= \case
Right withRcpt -> ackMsg msgMeta $ if withRcpt then Just "" else Nothing
eInfo <- eventInfo
logInfo $ label <> ": " <> eInfo
tryChatError (action eInfo) >>= \case
Right withRcpt ->
withLog (eInfo <> " ok") $ ackMsg msgMeta $ if withRcpt then Just "" else Nothing
-- If showCritical is True, then these errors don't result in ACK and show user visible alert
-- This prevents losing the message that failed to be processed.
Left (ChatErrorStore SEDBBusyError {message}) | showCritical -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing
Left e -> ackMsg msgMeta Nothing >> throwError e
Left e -> do
withLog (eInfo <> " error: " <> tshow e) $ ackMsg msgMeta Nothing
throwError e
where
eventInfo = do
v <- asks eventSeq
eId <- atomically $ stateTVar v $ \i -> (i + 1, i + 1)
pure $ "conn_id=" <> tshow cId <> " event_id=" <> tshow eId
withLog eInfo' ack = do
ts <- showTags
logInfo $ T.unwords [label, "ack:", ts, eInfo']
ack
logInfo $ T.unwords [label, "ack=success:", ts, eInfo']
showTags = do
ts <- maybe (pure []) readTVarIO tags
pure $ case ts of
[] -> "no_chat_messages"
[t] -> "chat_message=" <> t
_ -> "chat_message_batch=" <> T.intercalate "," (reverse ts)
ackMsg :: MsgMeta -> Maybe MsgReceiptInfo -> CM ()
ackMsg MsgMeta {recipient = (msgId, _)} rcpt = withAgent $ \a -> ackMessageAsync a "" cId msgId rcpt
@@ -6561,21 +6599,21 @@ deliverMessage conn cmEventTag msgBody msgId = do
deliverMessage' :: Connection -> MsgFlags -> MsgBody -> MessageId -> CM (Int64, PQEncryption)
deliverMessage' conn msgFlags msgBody msgId =
lift (deliverMessages ((conn, msgFlags, msgBody, msgId) :| [])) >>= \case
deliverMessages ((conn, msgFlags, msgBody, msgId) :| []) >>= \case
r :| [] -> liftEither r
rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs)
type MsgReq = (Connection, MsgFlags, MsgBody, MessageId)
deliverMessages :: NonEmpty MsgReq -> CM' (NonEmpty (Either ChatError (Int64, PQEncryption)))
deliverMessages :: NonEmpty MsgReq -> CM (NonEmpty (Either ChatError (Int64, PQEncryption)))
deliverMessages msgs = deliverMessagesB $ L.map Right msgs
deliverMessagesB :: NonEmpty (Either ChatError MsgReq) -> CM' (NonEmpty (Either ChatError (Int64, PQEncryption)))
deliverMessagesB :: NonEmpty (Either ChatError MsgReq) -> CM (NonEmpty (Either ChatError (Int64, PQEncryption)))
deliverMessagesB msgReqs = do
msgReqs' <- liftIO compressBodies
sent <- L.zipWith prepareBatch msgReqs' <$> withAgent' (`sendMessagesB` L.map toAgent msgReqs')
void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
sent <- L.zipWith prepareBatch msgReqs' <$> withAgent (`sendMessagesB` L.map toAgent msgReqs')
lift . void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
lift . withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
where
compressBodies =
forME msgReqs $ \mr@(conn@Connection {pqSupport, connChatVersion = v}, msgFlags, msgBody, msgId) ->
@@ -6607,6 +6645,8 @@ deliverMessagesB msgReqs = do
where
updatePQ = updateConnPQSndEnabled db connId pqSndEnabled'
-- TODO combine profile update and message into one batch
-- Take into account that it may not fit, and that we currently don't support sending multiple messages to the same connection in one call.
sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM (SndMessage, [GroupMember])
sendGroupMessage user gInfo members chatMsgEvent = do
when shouldSendProfileUpdate $
@@ -6634,10 +6674,11 @@ sendGroupMessage' user GroupInfo {groupId} members chatMsgEvent = do
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId)
recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent}
(toSend, pending) = foldr addMember ([], []) recipientMembers
(toSend, pending, _, dups) = foldr addMember ([], [], S.empty, 0 :: Int) recipientMembers
-- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here
msgReqs = map (\(_, conn) -> (conn, msgFlags, msgBody, msgId)) toSend
delivered <- maybe (pure []) (fmap L.toList . lift . deliverMessages) $ L.nonEmpty msgReqs
when (dups /= 0) $ logError $ "sendGroupMessage: " <> tshow dups <> " duplicate members"
delivered <- maybe (pure []) (fmap L.toList . deliverMessages) $ L.nonEmpty msgReqs
let errors = lefts delivered
unless (null errors) $ toView $ CRChatErrors (Just user) errors
stored <- lift . withStoreBatch' $ \db -> map (\m -> createPendingGroupMessage db (groupMemberId' m) msgId Nothing) pending
@@ -6650,10 +6691,16 @@ sendGroupMessage' user GroupInfo {groupId} members chatMsgEvent = do
liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
where
isAdmin GroupMember {memberRole} = memberRole >= GRAdmin
addMember m (toSend, pending) = case memberSendAction chatMsgEvent members m of
Just (MSASend conn) -> ((m, conn) : toSend, pending)
Just MSAPending -> (toSend, m : pending)
Nothing -> (toSend, pending)
addMember m acc@(toSend, pending, !mIds, !dups) = case memberSendAction chatMsgEvent members m of
Just a
| mId `S.member` mIds -> (toSend, pending, mIds, dups + 1)
| otherwise -> case a of
MSASend conn -> ((m, conn) : toSend, pending, mIds', dups)
MSAPending -> (toSend, m : pending, mIds', dups)
Nothing -> acc
where
mId = groupMemberId' m
mIds' = S.insert mId mIds
filterSent :: [Either ChatError a] -> [mem] -> (mem -> GroupMember) -> [GroupMember]
filterSent rs ms mem = [mem m | (Right _, m) <- zip rs ms]
src/Simplex/Chat/Archive.hs
+1
View File
@@ -26,6 +26,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import qualified Database.SQLite3 as SQL
import Simplex.Chat.Controller
import Simplex.Chat.Util ()
import Simplex.Messaging.Agent.Client (agentClientStore)
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), closeSQLiteStore, keyString, sqlString, storeKey)
import Simplex.Messaging.Util
src/Simplex/Chat/Controller.hs
+2
View File
@@ -13,6 +13,7 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-implicit-lift #-}
module Simplex.Chat.Controller where
@@ -205,6 +206,7 @@ data ChatController = ChatController
chatStore :: SQLiteStore,
chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted
random :: TVar ChaChaDRG,
eventSeq :: TVar Int,
inputQ :: TBQueue String,
outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse),
connNetworkStatuses :: TMap AgentConnId NetworkStatus,
src/Simplex/Chat/Messages.hs
+4 -3
View File
@@ -14,6 +14,7 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-operator-whitespace #-}
module Simplex.Chat.Messages where
@@ -455,10 +456,10 @@ deriving instance Show ACIReaction
data JSONCIReaction c d = JSONCIReaction {chatInfo :: ChatInfo c, chatReaction :: CIReaction c d}
type family ChatTypeQuotable (a :: ChatType) :: Constraint where
ChatTypeQuotable CTDirect = ()
ChatTypeQuotable CTGroup = ()
ChatTypeQuotable 'CTDirect = ()
ChatTypeQuotable 'CTGroup = ()
ChatTypeQuotable a =
(Int ~ Bool, TypeError (Type.Text "ChatType " :<>: ShowType a :<>: Type.Text " cannot be quoted"))
(Int ~ Bool, TypeError ('Type.Text "ChatType " ':<>: 'ShowType a ':<>: 'Type.Text " cannot be quoted"))
data CIQDirection (c :: ChatType) where
CIQDirectSnd :: CIQDirection 'CTDirect
src/Simplex/Chat/Remote.hs
+2 -2
View File
@@ -72,11 +72,11 @@ import UnliftIO.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExis
-- when acting as host
minRemoteCtrlVersion :: AppVersion
minRemoteCtrlVersion = AppVersion [5, 7, 0, 3]
minRemoteCtrlVersion = AppVersion [5, 8, 0, 2]
-- when acting as controller
minRemoteHostVersion :: AppVersion
minRemoteHostVersion = AppVersion [5, 7, 0, 3]
minRemoteHostVersion = AppVersion [5, 8, 0, 2]
currentAppVersion :: AppVersion
currentAppVersion = AppVersion SC.version
src/Simplex/Chat/Store/Messages.hs
+4 -4
View File
@@ -838,7 +838,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
ciMeta content status =
let itemDeleted' = case itemDeleted of
DBCINotDeleted -> Nothing
_ -> Just (CIDeleted @CTLocal deletedTs)
_ -> Just (CIDeleted @'CTLocal deletedTs)
itemEdited' = fromMaybe False itemEdited
itemForwarded = toCIForwardedFrom forwardedFromRow
in mkCIMeta itemId content itemText status sentViaProxy sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
@@ -1458,7 +1458,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
ciMeta content status =
let itemDeleted' = case itemDeleted of
DBCINotDeleted -> Nothing
_ -> Just (CIDeleted @CTDirect deletedTs)
_ -> Just (CIDeleted @'CTDirect deletedTs)
itemEdited' = fromMaybe False itemEdited
itemForwarded = toCIForwardedFrom forwardedFromRow
in mkCIMeta itemId content itemText status sentViaProxy sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
@@ -1520,7 +1520,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
DBCINotDeleted -> Nothing
DBCIBlocked -> Just (CIBlocked deletedTs)
DBCIBlockedByAdmin -> Just (CIBlockedByAdmin deletedTs)
_ -> Just (maybe (CIDeleted @CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
itemEdited' = fromMaybe False itemEdited
itemForwarded = toCIForwardedFrom forwardedFromRow
in mkCIMeta itemId content itemText status sentViaProxy sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
@@ -1919,7 +1919,7 @@ markGroupChatItemDeleted db User {userId} GroupInfo {groupId} ci@ChatItem {meta}
let itemId = chatItemId' ci
(deletedByGroupMemberId, itemDeleted) = case byGroupMember_ of
Just m@GroupMember {groupMemberId} -> (Just groupMemberId, Just $ CIModerated (Just deletedTs) m)
_ -> (Nothing, Just $ CIDeleted @CTGroup (Just deletedTs))
_ -> (Nothing, Just $ CIDeleted @'CTGroup (Just deletedTs))
insertChatItemMessage_ db itemId msgId currentTs
DB.execute
db
src/Simplex/Chat/Util.hs
+30
View File
@@ -1,10 +1,18 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Simplex.Chat.Util (week, encryptFile, chunkSize, liftIOEither, shuffle) where
import Control.Exception (Exception)
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift (MonadUnliftIO (..))
import Control.Monad.Reader
import Data.Bifunctor (first)
import qualified Data.ByteString.Lazy as LB
import Data.List (sortBy)
import Data.Ord (comparing)
@@ -13,6 +21,7 @@ import Data.Word (Word16)
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import System.Random (randomRIO)
import qualified UnliftIO.Exception as E
import UnliftIO.IO (IOMode (..), withFile)
week :: NominalDiffTime
@@ -46,3 +55,24 @@ shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) x
liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a
liftIOEither a = liftIO a >>= liftEither
{-# INLINE liftIOEither #-}
newtype InternalException e = InternalException {unInternalException :: e}
deriving (Eq, Show)
instance Exception e => Exception (InternalException e)
instance Exception e => MonadUnliftIO (ExceptT e IO) where
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. ExceptT e IO a -> IO a) -> IO b) -> ExceptT e IO b
withRunInIO inner =
ExceptT . fmap (first unInternalException) . E.try $
withRunInIO $ \run ->
inner $ run . (either (E.throwIO . InternalException) pure <=< runExceptT)
instance Exception e => MonadUnliftIO (ExceptT e (ReaderT r IO)) where
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. ExceptT e (ReaderT r IO) a -> IO a) -> IO b) -> ExceptT e (ReaderT r IO) b
withRunInIO inner =
withExceptT unInternalException . ExceptT . E.try $
withRunInIO $ \run ->
inner $ run . (either (E.throwIO . InternalException) pure <=< runExceptT)
src/Simplex/Chat/View.hs
+4 -2
View File
@@ -2028,14 +2028,16 @@ viewChatError logLevel testView = \case
DBErrorOpen e -> ["error opening database after encryption: " <> sqliteError' e]
e -> ["chat database error: " <> sShow e]
ChatErrorAgent err entity_ -> case err of
CMD PROHIBITED -> [withConnEntity <> "error: command is prohibited"]
CMD PROHIBITED cxt -> [withConnEntity <> plain ("error: command is prohibited, " <> cxt)]
SMP _ SMP.AUTH ->
[ withConnEntity
<> "error: connection authorization failed - this could happen if connection was deleted,\
\ secured with different credentials, or due to a bug - please re-create the connection"
]
BROKER _ NETWORK -> []
BROKER _ TIMEOUT -> []
AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug]
AGENT A_PROHIBITED -> [withConnEntity <> "error: AGENT A_PROHIBITED" | logLevel <= CLLWarning]
AGENT (A_PROHIBITED e) -> [withConnEntity <> "error: AGENT A_PROHIBITED, " <> plain e | logLevel <= CLLWarning]
CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning]
CRITICAL restart e -> [plain $ "critical error: " <> e] <> ["please restart the app" | restart]
INTERNAL e -> [plain $ "internal error: " <> e]
tests/ChatClient.hs
+2 -1
View File
@@ -431,7 +431,8 @@ serverCfg =
smpHandshakeTimeout = 1000000,
controlPort = Nothing,
smpAgentCfg = defaultSMPClientAgentConfig,
allowSMPProxy = False
allowSMPProxy = False,
serverClientConcurrency = 16
}
withSmpServer :: IO () -> IO ()
tests/ChatTests/Direct.hs
+6 -6
View File
@@ -2310,12 +2310,12 @@ testAbortSwitchContact tmp = do
alice <## "bob: you started changing address"
-- repeat switch is prohibited
alice ##> "/switch bob"
alice <## "error: command is prohibited"
alice <## "error: command is prohibited, switchConnectionAsync: already switching"
-- stop switch
alice #$> ("/abort switch bob", id, "switch aborted")
-- repeat switch stop is prohibited
alice ##> "/abort switch bob"
alice <## "error: command is prohibited"
alice <## "error: command is prohibited, abortConnectionSwitch: not allowed"
withTestChatContactConnected tmp "bob" $ \bob -> do
bob <## "alice started changing address for you"
-- alice changes address again
@@ -2356,12 +2356,12 @@ testAbortSwitchGroupMember tmp = do
alice <## "#team: you started changing address for bob"
-- repeat switch is prohibited
alice ##> "/switch #team bob"
alice <## "error: command is prohibited"
alice <## "error: command is prohibited, switchConnectionAsync: already switching"
-- stop switch
alice #$> ("/abort switch #team bob", id, "switch aborted")
-- repeat switch stop is prohibited
alice ##> "/abort switch #team bob"
alice <## "error: command is prohibited"
alice <## "error: command is prohibited, abortConnectionSwitch: not allowed"
withTestChatContactConnected tmp "bob" $ \bob -> do
bob <## "#team: connected to server(s)"
bob <## "#team: alice started changing address for you"
@@ -2485,7 +2485,7 @@ setupDesynchronizedRatchet tmp alice = do
withTestChat tmp "bob_old" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob ##> "/sync alice"
bob <## "error: command is prohibited"
bob <## "error: command is prohibited, synchronizeRatchet: not allowed"
alice #> "@bob 1"
bob <## "alice: decryption error (connection out of sync), synchronization required"
bob <## "use /sync alice to synchronize"
@@ -2495,7 +2495,7 @@ setupDesynchronizedRatchet tmp alice = do
bob ##> "/tail @alice 1"
bob <# "alice> decryption error, possibly due to the device change (header, 3 messages)"
bob ##> "@alice 1"
bob <## "error: command is prohibited"
bob <## "error: command is prohibited, sendMessagesB: send prohibited"
(alice </)
where
copyDb from to = do
tests/ChatTests/Groups.hs
+2 -2
View File
@@ -3266,7 +3266,7 @@ setupDesynchronizedRatchet tmp alice = do
bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)"
bob ##> "/sync #team alice"
bob <## "error: command is prohibited"
bob <## "error: command is prohibited, synchronizeRatchet: not allowed"
alice #> "#team 1"
bob <## "#team alice: decryption error (connection out of sync), synchronization required"
bob <## "use /sync #team alice to synchronize"
@@ -3294,7 +3294,7 @@ testGroupSyncRatchet tmp =
bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)"
bob `send` "#team 1"
bob <## "error: command is prohibited" -- silence?
bob <## "error: command is prohibited, sendMessagesB: send prohibited" -- silence?
bob <# "#team 1"
(alice </)
-- synchronize bob and alice
tests/MobileTests.hs
+1 -1
View File
@@ -294,7 +294,7 @@ testFileCApi fileName tmp = do
let sz' = fromIntegral sz
contents <- create sz' $ \toPtr -> copyBytes toPtr (ptr' `plusPtr` 5) sz'
contents `shouldBe` src
sz' `shouldBe` fromIntegral len
sz' `shouldBe` len
testMissingFileCApi :: FilePath -> IO ()
testMissingFileCApi tmp = do