diff --git a/apps/ios/Shared/ContentView.swift b/apps/ios/Shared/ContentView.swift index ccc8d769d..436819c14 100644 --- a/apps/ios/Shared/ContentView.swift +++ b/apps/ios/Shared/ContentView.swift @@ -136,6 +136,9 @@ struct ContentView: View { .sheet(isPresented: $showWhatsNew) { WhatsNewView() } + if chatModel.setDeliveryReceipts { + SetDeliveryReceiptsView() + } IncomingCallView() } .onContinueUserActivity("INStartCallIntent", perform: processUserActivity) diff --git a/apps/ios/Shared/Model/ChatModel.swift b/apps/ios/Shared/Model/ChatModel.swift index f166cfbff..62f14c792 100644 --- a/apps/ios/Shared/Model/ChatModel.swift +++ b/apps/ios/Shared/Model/ChatModel.swift @@ -13,6 +13,7 @@ import SimpleXChat final class ChatModel: ObservableObject { @Published var onboardingStage: OnboardingStage? + @Published var setDeliveryReceipts = false @Published var v3DBMigration: V3DBMigrationState = v3DBMigrationDefault.get() @Published var currentUser: User? @Published var users: [UserInfo] = [] diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index 1e73abf39..ed5d18b1f 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -1091,6 +1091,7 @@ func initializeChat(start: Bool, dbKey: String? = nil, refreshInvitations: Bool m.currentUser = try apiGetActiveUser() if m.currentUser == nil { onboardingStageDefault.set(.step1_SimpleXInfo) + privacyDeliveryReceiptsSet.set(true) m.onboardingStage = .step1_SimpleXInfo } else if start { try startChat(refreshInvitations: refreshInvitations) @@ -1120,6 +1121,9 @@ func startChat(refreshInvitations: Bool = true) throws { m.onboardingStage = [.step1_SimpleXInfo, .step2_CreateProfile].contains(savedOnboardingStage) && m.users.count == 1 ? .step3_CreateSimpleXAddress : savedOnboardingStage + if m.onboardingStage == .onboardingComplete && !privacyDeliveryReceiptsSet.get() { + m.setDeliveryReceipts = true + } } } ChatReceiver.shared.start() diff --git a/apps/ios/Shared/Views/Chat/ChatInfoView.swift b/apps/ios/Shared/Views/Chat/ChatInfoView.swift index 6d9b50d03..fb105742a 100644 --- a/apps/ios/Shared/Views/Chat/ChatInfoView.swift +++ b/apps/ios/Shared/Views/Chat/ChatInfoView.swift @@ -57,6 +57,22 @@ private func serverHost(_ s: String) -> String { } } +enum SendReceipts: Identifiable, Hashable { + case yes + case no + case userDefault(Bool) + + var id: Self { self } + + var text: LocalizedStringKey { + switch self { + case .yes: "yes" + case .no: "no" + case let .userDefault(on): on ? "default (yes)" : "default (no)" + } + } +} + struct ChatInfoView: View { @EnvironmentObject var chatModel: ChatModel @Environment(\.dismiss) var dismiss: DismissAction @@ -68,6 +84,7 @@ struct ChatInfoView: View { @Binding var connectionCode: String? @FocusState private var aliasTextFieldFocused: Bool @State private var alert: ChatInfoViewAlert? = nil + @State private var sendReceipts = SendReceipts.yes @AppStorage(DEFAULT_DEVELOPER_TOOLS) private var developerTools = false enum ChatInfoViewAlert: Identifiable { @@ -117,6 +134,7 @@ struct ChatInfoView: View { Section { if let code = connectionCode { verifyCodeButton(code) } contactPreferencesButton() + sendReceiptsOption() if let connStats = connectionStats, connStats.ratchetSyncAllowed { synchronizeConnectionButton() @@ -153,7 +171,7 @@ struct ChatInfoView: View { connStats.rcvQueuesInfo.contains { $0.rcvSwitchStatus != nil } || connStats.ratchetSyncSendProhibited ) - if connStats.rcvQueuesInfo.contains { $0.rcvSwitchStatus != nil } { + if connStats.rcvQueuesInfo.contains(where: { $0.rcvSwitchStatus != nil }) { Button("Abort changing address") { alert = .abortSwitchAddressAlert } @@ -295,6 +313,17 @@ struct ChatInfoView: View { } } + private func sendReceiptsOption() -> some View { + Picker(selection: $sendReceipts) { + ForEach([.yes, .no, .userDefault(true)]) { (opt: SendReceipts) in + Text(opt.text) + } + } label: { + Label("Send receipts", systemImage: "checkmark.message") + } + .frame(height: 36) + } + private func synchronizeConnectionButton() -> some View { Button { syncContactConnection(force: false) diff --git a/apps/ios/Shared/Views/UserSettings/PrivacySettings.swift b/apps/ios/Shared/Views/UserSettings/PrivacySettings.swift index 982768710..14ccf950f 100644 --- a/apps/ios/Shared/Views/UserSettings/PrivacySettings.swift +++ b/apps/ios/Shared/Views/UserSettings/PrivacySettings.swift @@ -68,6 +68,25 @@ struct PrivacySettings: View { Text("Opening the link in the browser may reduce connection privacy and security. Untrusted SimpleX links will be red.") } } + + Section { + settingsRow("person") { + Toggle("Contacts", isOn: $useLinkPreviews) + } + settingsRow("person.2") { + Toggle("Small groups (max 10)", isOn: Binding.constant(false)) + } + .foregroundColor(.secondary) + .disabled(true) + } header: { + Text("Send delivery receipts to") + } footer: { + VStack(alignment: .leading) { + Text("These settings are for your current profile **\(ChatModel.shared.currentUser?.displayName ?? "")**.") + Text("They can be overridden in contact and group settings") + } + .frame(maxWidth: .infinity, alignment: .leading) + } } } } diff --git a/apps/ios/Shared/Views/UserSettings/SetDeliveryReceiptsView.swift b/apps/ios/Shared/Views/UserSettings/SetDeliveryReceiptsView.swift new file mode 100644 index 000000000..eee204018 --- /dev/null +++ b/apps/ios/Shared/Views/UserSettings/SetDeliveryReceiptsView.swift @@ -0,0 +1,63 @@ +// +// SetDeliveryReceiptsView.swift +// SimpleX (iOS) +// +// Created by Evgeny on 12/07/2023. +// Copyright © 2023 SimpleX Chat. All rights reserved. +// + +import SwiftUI + +struct SetDeliveryReceiptsView: View { + @EnvironmentObject var m: ChatModel + + var body: some View { + VStack(spacing: 16) { + Text("Delivery receipts!") + .font(.title) + .foregroundColor(.secondary) + .padding(.vertical) + .multilineTextAlignment(.center) + + Spacer() + + Button("Enable") { + m.setDeliveryReceipts = false + } + .font(.largeTitle) + Group { + if m.users.count > 1 { + Text("Delivery receipts will be enabled for all contacts in all visible chat profiles.") + } else { + Text("Delivery receipts will be enabled for all contacts.") + } + } + .multilineTextAlignment(.center) + + Spacer() + + Button("Enable later via Settings") { + AlertManager.shared.showAlert(Alert( + title: Text("Delivery receipts are disabled!"), + message: Text("You can enable them later via app Privacy & Security settings."), + primaryButton: .default(Text("Don't show again")) { + m.setDeliveryReceipts = false + }, + secondaryButton: .default(Text("Ok")) { + m.setDeliveryReceipts = false + } + )) + } + } + .padding() + .padding(.horizontal) + .frame(maxWidth: .infinity, maxHeight: .infinity, alignment: .topLeading) + .background(Color(uiColor: .systemBackground)) + } +} + +struct SetDeliveryReceiptsView_Previews: PreviewProvider { + static var previews: some View { + SetDeliveryReceiptsView() + } +} diff --git a/apps/ios/Shared/Views/UserSettings/SettingsView.swift b/apps/ios/Shared/Views/UserSettings/SettingsView.swift index 35b584ff9..7ca18692a 100644 --- a/apps/ios/Shared/Views/UserSettings/SettingsView.swift +++ b/apps/ios/Shared/Views/UserSettings/SettingsView.swift @@ -31,6 +31,7 @@ let DEFAULT_PRIVACY_ACCEPT_IMAGES = "privacyAcceptImages" let DEFAULT_PRIVACY_LINK_PREVIEWS = "privacyLinkPreviews" let DEFAULT_PRIVACY_SIMPLEX_LINK_MODE = "privacySimplexLinkMode" let DEFAULT_PRIVACY_PROTECT_SCREEN = "privacyProtectScreen" +let DEFAULT_PRIVACY_DELIVERY_RECEIPTS_SET = "privacyDeliveryReceiptsSet" let DEFAULT_EXPERIMENTAL_CALLS = "experimentalCalls" let DEFAULT_CHAT_ARCHIVE_NAME = "chatArchiveName" let DEFAULT_CHAT_ARCHIVE_TIME = "chatArchiveTime" @@ -65,6 +66,7 @@ let appDefaults: [String: Any] = [ DEFAULT_PRIVACY_LINK_PREVIEWS: true, DEFAULT_PRIVACY_SIMPLEX_LINK_MODE: SimpleXLinkMode.description.rawValue, DEFAULT_PRIVACY_PROTECT_SCREEN: false, + DEFAULT_PRIVACY_DELIVERY_RECEIPTS_SET: false, DEFAULT_EXPERIMENTAL_CALLS: false, DEFAULT_CHAT_V3_DB_MIGRATION: V3DBMigrationState.offer.rawValue, DEFAULT_DEVELOPER_TOOLS: false, @@ -114,6 +116,8 @@ let privacySimplexLinkModeDefault = EnumDefault(defaults: UserD let privacyLocalAuthModeDefault = EnumDefault(defaults: UserDefaults.standard, forKey: DEFAULT_LA_MODE, withDefault: .system) +let privacyDeliveryReceiptsSet = BoolDefault(defaults: UserDefaults.standard, forKey: DEFAULT_PRIVACY_DELIVERY_RECEIPTS_SET) + let onboardingStageDefault = EnumDefault(defaults: UserDefaults.standard, forKey: DEFAULT_ONBOARDING_STAGE, withDefault: .onboardingComplete) let customDisappearingMessageTimeDefault = IntDefault(defaults: UserDefaults.standard, forKey: DEFAULT_CUSTOM_DISAPPEARING_MESSAGE_TIME) diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj index 19ad6687c..04a7f1f9f 100644 --- a/apps/ios/SimpleX.xcodeproj/project.pbxproj +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -142,6 +142,7 @@ 5CEACCE327DE9246000BD591 /* ComposeView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEACCE227DE9246000BD591 /* ComposeView.swift */; }; 5CEACCED27DEA495000BD591 /* MsgContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEACCEC27DEA495000BD591 /* MsgContentView.swift */; }; 5CEBD7462A5C0A8F00665FE2 /* KeyboardPadding.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */; }; + 5CEBD7482A5F115D00665FE2 /* SetDeliveryReceiptsView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */; }; 5CFA59C42860BC6200863A68 /* MigrateToAppGroupView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */; }; 5CFA59D12864782E00863A68 /* ChatArchiveView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59CF286477B400863A68 /* ChatArchiveView.swift */; }; 5CFE0921282EEAF60002594B /* ZoomableScrollView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFE0920282EEAF60002594B /* ZoomableScrollView.swift */; }; @@ -419,6 +420,7 @@ 5CEACCE227DE9246000BD591 /* ComposeView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeView.swift; sourceTree = ""; }; 5CEACCEC27DEA495000BD591 /* MsgContentView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MsgContentView.swift; sourceTree = ""; }; 5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = KeyboardPadding.swift; sourceTree = ""; }; + 5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SetDeliveryReceiptsView.swift; sourceTree = ""; }; 5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MigrateToAppGroupView.swift; sourceTree = ""; }; 5CFA59CF286477B400863A68 /* ChatArchiveView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatArchiveView.swift; sourceTree = ""; }; 5CFE0920282EEAF60002594B /* ZoomableScrollView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; name = ZoomableScrollView.swift; path = Shared/Views/ZoomableScrollView.swift; sourceTree = SOURCE_ROOT; }; @@ -744,6 +746,7 @@ 5C65DAF829D0CC20003CEE45 /* DeveloperView.swift */, 64D0C2BF29F9688300B38D5F /* UserAddressView.swift */, 64D0C2C129FA57AB00B38D5F /* UserAddressLearnMore.swift */, + 5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */, ); path = UserSettings; sourceTree = ""; @@ -1194,6 +1197,7 @@ 5C9CC7A928C532AB00BEF955 /* DatabaseErrorView.swift in Sources */, 5C1A4C1E27A715B700EAD5AD /* ChatItemView.swift in Sources */, 64AA1C6927EE10C800AC7277 /* ContextItemView.swift in Sources */, + 5CEBD7482A5F115D00665FE2 /* SetDeliveryReceiptsView.swift in Sources */, 5C9C2DA7289957AE00CC63B1 /* AdvancedNetworkSettings.swift in Sources */, 5CADE79A29211BB900072E13 /* PreferencesView.swift in Sources */, 644EFFE42937BE9700525D5B /* MarkedDeletedItemView.swift in Sources */, diff --git a/cabal.project b/cabal.project index 66e867b2c..9ad481974 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 1afcefa5e7cf7c4a5e5732104105d14259be16b6 + tag: 58cb2855d23ac970a619a61d088ed2a08dfb3d81 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 5ee005529..30382689b 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."1afcefa5e7cf7c4a5e5732104105d14259be16b6" = "0h017r0cjjc00d59wn3gs482dyjaqgapym370s36xhhvhn11n96x"; + "https://github.com/simplex-chat/simplexmq.git"."58cb2855d23ac970a619a61d088ed2a08dfb3d81" = "053id418z9l0qciignvrl88kip6gmnfa36r7sl0avarqpach0fn1"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 53cb483de..8d4bd437d 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -103,6 +103,7 @@ library Simplex.Chat.Migrations.M20230608_deleted_contacts Simplex.Chat.Migrations.M20230618_favorite_chats Simplex.Chat.Migrations.M20230621_chat_item_moderations + Simplex.Chat.Migrations.M20230705_delivery_receipts Simplex.Chat.Mobile Simplex.Chat.Mobile.WebRTC Simplex.Chat.Options diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c575efb34..b9feeb576 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -96,7 +96,6 @@ import Text.Read (readMaybe) import UnliftIO.Async import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay) import UnliftIO.Directory -import qualified UnliftIO.Exception as UE import UnliftIO.IO (hClose, hSeek, hTell, openFile) import UnliftIO.STM @@ -124,6 +123,7 @@ defaultChatConfig = xftpFileConfig = Just defaultXFTPFileConfig, tempDir = Nothing, showReactions = False, + showReceipts = False, logLevel = CLLImportant, subscriptionEvents = False, hostEvents = False, @@ -388,6 +388,13 @@ processChatCommand = \case tryError (withStore (`getUserIdByName` uName)) >>= \case Left _ -> throwChatError CEUserUnknown Right userId -> processChatCommand $ APISetActiveUser userId viewPwd_ + SetAllContactReceipts onOff -> withUser $ \_ -> withStore' (`updateAllContactReceipts` onOff) >> ok_ + APISetUserContactReceipts userId' settings -> withUser $ \user -> do + user' <- privateGetUser userId' + validateUserPassword user user' Nothing + withStore' $ \db -> updateUserContactReceipts db user' settings + ok user + SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserContactReceipts userId settings APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do user' <- privateGetUser userId' case viewPwdHash user' of @@ -1192,18 +1199,8 @@ processChatCommand = \case withStore' $ \db -> setConnectionAuthErrCounter db user conn 0 ok user _ -> throwChatError CEGroupMemberNotActive - ShowMessages (ChatName cType name) ntfOn -> withUser $ \user -> do - (chatId, chatSettings) <- case cType of - CTDirect -> withStore $ \db -> do - ctId <- getContactIdByName db user name - Contact {chatSettings} <- getContact db user ctId - pure (ctId, chatSettings) - CTGroup -> withStore $ \db -> do - gId <- getGroupIdByName db user name - GroupInfo {chatSettings} <- getGroupInfo db user gId - pure (gId, chatSettings) - _ -> throwChatError $ CECommandError "not supported" - processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ chatSettings {enableNtfs = ntfOn} + SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn}) + SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_}) ContactInfo cName -> withContactName cName APIContactInfo GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo SwitchContact cName -> withContactName cName APISwitchContact @@ -1962,6 +1959,19 @@ processChatCommand = \case withAgent $ \a -> deleteUser a (aUserId user) delSMPQueues withStore' (`deleteUserRecord` user) ok_ + updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> m ChatResponse + updateChatSettings (ChatName cType name) updateSettings = withUser $ \user -> do + (chatId, chatSettings) <- case cType of + CTDirect -> withStore $ \db -> do + ctId <- getContactIdByName db user name + Contact {chatSettings} <- getContact db user ctId + pure (ctId, chatSettings) + CTGroup -> withStore $ \db -> do + gId <- getGroupIdByName db user name + GroupInfo {chatSettings} <- getGroupInfo db user gId + pure (gId, chatSettings) + _ -> throwChatError $ CECommandError "not supported" + processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m () assertDirectAllowed user dir ct event = @@ -2744,8 +2754,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do saveConnInfo conn connInfo MSG meta _msgFlags msgBody -> do cmdId <- createAckCmd conn - withAckMessage agentConnId cmdId meta . void $ - saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId + withAckMessage agentConnId cmdId meta $ + saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId $> False SENT msgId -> sentMsgDeliveryEvent conn msgId OK -> @@ -2801,6 +2811,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XCallEnd callId -> xCallEnd ct callId msg msgMeta 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) + RCVD msgMeta msgRcpt -> + withAckMessage' agentConnId conn msgMeta $ + directMsgReceived ct conn msgMeta msgRcpt CONF confId _ connInfo -> do -- confirming direct connection with a member ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo @@ -3048,10 +3063,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XGrpInfo p' -> xGrpInfo gInfo m p' msg msgMeta BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta _ -> messageError $ "unsupported message: " <> T.pack (show event) + pure False -- no receipts in group now $ hasDeliveryReceipt $ toCMEventTag event where canSend a | memberRole (m :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages" | otherwise = a + RCVD msgMeta msgRcpt -> + withAckMessage' agentConnId conn msgMeta $ + groupMsgReceived gInfo m conn msgMeta msgRcpt SENT msgId -> do sentMsgDeliveryEvent conn msgId checkSndInlineFTComplete conn msgId @@ -3156,9 +3175,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do getChatItemByFileId db user fileId toView $ CRSndFileRcvCancelled user ci ft _ -> throwChatError $ CEFileSend fileId err - MSG meta _ _ -> do - cmdId <- createAckCmd conn - withAckMessage agentConnId cmdId meta $ pure () + MSG meta _ _ -> withAckMessage' agentConnId conn meta $ pure () OK -> -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \_cmdData -> pure () @@ -3251,9 +3268,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo where ack a = case conn_ of - Just conn -> do - cmdId <- createAckCmd conn - withAckMessage agentConnId cmdId meta a + Just conn -> withAckMessage' agentConnId conn meta a Nothing -> a processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m () @@ -3336,10 +3351,25 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createAckCmd Connection {connId} = do withStore' $ \db -> createCommand db user (Just connId) CFAckMessage - withAckMessage :: ConnId -> CommandId -> MsgMeta -> m () -> m () + withAckMessage' :: ConnId -> Connection -> MsgMeta -> m () -> m () + withAckMessage' cId conn msgMeta action = do + cmdId <- createAckCmd conn + withAckMessage cId cmdId msgMeta $ action $> False + + withAckMessage :: ConnId -> CommandId -> MsgMeta -> m Bool -> m () withAckMessage cId cmdId MsgMeta {recipient = (msgId, _)} action = do -- [async agent commands] command should be asynchronous, continuation is ackMsgDeliveryEvent - action `chatFinally` withAgent (\a -> ackMessageAsync a (aCorrId cmdId) cId msgId) + -- 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 + -- TODO send receipt depending on contact/group settings + tryChatError action >>= \case + Right withRcpt -> ack $ if withRcpt then Just "" else Nothing + Left e -> ack Nothing >> throwError e + where + ack rcpt = withAgent $ \a -> ackMessageAsync a (aCorrId cmdId) cId msgId rcpt ackMsgDeliveryEvent :: Connection -> CommandId -> m () ackMsgDeliveryEvent Connection {connId} ackCmdId = @@ -4260,6 +4290,23 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do groupMsgToView g' m ci msgMeta createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' + directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () + directMsgReceived ct@Contact {contactId} Connection {connId} msgMeta msgRcpts = do + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta + forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do + withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus + withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId agentMsgId) >>= \case + Just (CChatItem SMDSnd ci) -> do + chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId (chatItemId' ci) $ CISSndRcvd msgRcptStatus + toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) + _ -> pure () + + groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m () + groupMsgReceived gInfo m Connection {connId} msgMeta msgRcpts = do + checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta + forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> + withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus + parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p) parseFileDescription = liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8) @@ -4866,13 +4913,17 @@ withStoreCtx ctx_ action = do chatCommandP :: Parser ChatCommand chatCommandP = choice - [ "/mute " *> ((`ShowMessages` False) <$> chatNameP), - "/unmute " *> ((`ShowMessages` True) <$> chatNameP), + [ "/mute " *> ((`SetShowMessages` False) <$> chatNameP), + "/unmute " *> ((`SetShowMessages` True) <$> chatNameP), + "/receipts " *> (SetSendReceipts <$> chatNameP <* " " <*> ((Just <$> onOffP) <|> ("default" $> Nothing))), "/_create user " *> (CreateActiveUser <$> jsonP), "/create user " *> (CreateActiveUser <$> newUserP), "/users" $> ListUsers, "/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)), ("/user " <|> "/u ") *> (SetActiveUser <$> displayName <*> optional (A.space *> pwdP)), + "/set receipts all " *> (SetAllContactReceipts <$> onOffP), + "/_set receipts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings), + "/set receipts " *> (SetUserContactReceipts <$> receiptSettings), "/_hide user " *> (APIHideUser <$> A.decimal <* A.space <*> jsonP), "/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP), "/_mute user " *> (APIMuteUser <$> A.decimal), @@ -5126,6 +5177,10 @@ chatCommandP = refChar c = c > ' ' && c /= '#' && c /= '@' liveMessageP = " live=" *> onOffP <|> pure False sendMessageTTLP = " ttl=" *> ((Just <$> A.decimal) <|> ("default" $> Nothing)) <|> pure Nothing + receiptSettings = do + enable <- onOffP + clearOverrides <- (" clear_overrides=" *> onOffP) <|> pure False + pure UserMsgReceiptSettings {enable, clearOverrides} onOffP = ("on" $> True) <|> ("off" $> False) profileNames = (,) <$> displayName <*> fullNameP newUserP = do diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index b3552e502..467857a86 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -45,7 +45,7 @@ import Simplex.Chat.Markdown (MarkdownList) import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol -import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink) +import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink, UserMsgReceiptSettings) import Simplex.Chat.Types import Simplex.Messaging.Agent (AgentClient) import Simplex.Messaging.Agent.Client (AgentLocks, ProtocolTestFailure) @@ -61,7 +61,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId, import Simplex.Messaging.TMap (TMap) import Simplex.Messaging.Transport (simplexMQVersion) import Simplex.Messaging.Transport.Client (TransportHost) -import Simplex.Messaging.Util (catchAllErrors, allFinally) +import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors) import System.IO (Handle) import System.Mem.Weak (Weak) import UnliftIO.STM @@ -109,6 +109,7 @@ data ChatConfig = ChatConfig xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled tempDir :: Maybe FilePath, showReactions :: Bool, + showReceipts :: Bool, subscriptionEvents :: Bool, hostEvents :: Bool, logLevel :: ChatLogLevel, @@ -198,6 +199,9 @@ data ChatCommand | ListUsers | APISetActiveUser UserId (Maybe UserPwd) | SetActiveUser UserName (Maybe UserPwd) + | SetAllContactReceipts Bool + | APISetUserContactReceipts UserId UserMsgReceiptSettings + | SetUserContactReceipts UserMsgReceiptSettings | APIHideUser UserId UserPwd | APIUnhideUser UserId UserPwd | APIMuteUser UserId @@ -297,7 +301,8 @@ data ChatCommand | APIVerifyGroupMember GroupId GroupMemberId (Maybe Text) | APIEnableContact ContactId | APIEnableGroupMember GroupId GroupMemberId - | ShowMessages ChatName Bool + | SetShowMessages ChatName Bool + | SetSendReceipts ChatName (Maybe Bool) | ContactInfo ContactName | GroupMemberInfo GroupName ContactName | SwitchContact ContactName @@ -902,6 +907,10 @@ type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m) type ChatMonad m = (ChatMonad' m, MonadError ChatError m) +tryChatError :: ChatMonad m => m a -> m (Either ChatError a) +tryChatError = tryAllErrors mkChatError +{-# INLINE tryChatError #-} + catchChatError :: ChatMonad m => m a -> (ChatError -> m a) -> m a catchChatError = catchAllErrors mkChatError {-# INLINE catchChatError #-} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 2c5f4755f..2dbac741b 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -35,9 +35,9 @@ import Simplex.Chat.Markdown import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol import Simplex.Chat.Types -import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..)) +import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..)) import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON) +import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON) import Simplex.Messaging.Protocol (MsgBody) import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) @@ -624,6 +624,7 @@ data CIFileInfo = CIFileInfo data CIStatus (d :: MsgDirection) where CISSndNew :: CIStatus 'MDSnd CISSndSent :: CIStatus 'MDSnd + CISSndRcvd :: MsgReceiptStatus -> CIStatus 'MDSnd CISSndErrorAuth :: CIStatus 'MDSnd CISSndError :: String -> CIStatus 'MDSnd CISRcvNew :: CIStatus 'MDRcv @@ -647,6 +648,7 @@ instance MsgDirectionI d => StrEncoding (CIStatus d) where strEncode = \case CISSndNew -> "snd_new" CISSndSent -> "snd_sent" + CISSndRcvd status -> "snd_rcvd " <> strEncode status CISSndErrorAuth -> "snd_error_auth" CISSndError e -> "snd_error " <> encodeUtf8 (T.pack e) CISRcvNew -> "rcv_new" @@ -659,6 +661,7 @@ instance StrEncoding ACIStatus where A.takeTill (== ' ') >>= \case "snd_new" -> pure $ ACIStatus SMDSnd CISSndNew "snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent + "snd_rcvd" -> ACIStatus SMDSnd . CISSndRcvd <$> (A.space *> strP) "snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth "snd_error" -> ACIStatus SMDSnd . CISSndError . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString) "rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew @@ -668,6 +671,7 @@ instance StrEncoding ACIStatus where data JSONCIStatus = JCISSndNew | JCISSndSent + | JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus} | JCISSndErrorAuth | JCISSndError {agentError :: String} | JCISRcvNew @@ -682,6 +686,7 @@ jsonCIStatus :: CIStatus d -> JSONCIStatus jsonCIStatus = \case CISSndNew -> JCISSndNew CISSndSent -> JCISSndSent + CISSndRcvd ok -> JCISSndRcvd ok CISSndErrorAuth -> JCISSndErrorAuth CISSndError e -> JCISSndError e CISRcvNew -> JCISRcvNew @@ -805,7 +810,7 @@ data MsgDeliveryStatus (d :: MsgDirection) where MDSSndPending :: MsgDeliveryStatus 'MDSnd MDSSndAgent :: MsgDeliveryStatus 'MDSnd MDSSndSent :: MsgDeliveryStatus 'MDSnd - MDSSndReceived :: MsgDeliveryStatus 'MDSnd + MDSSndRcvd :: MsgReceiptStatus -> MsgDeliveryStatus 'MDSnd MDSSndRead :: MsgDeliveryStatus 'MDSnd data AMsgDeliveryStatus = forall d. AMDS (SMsgDirection d) (MsgDeliveryStatus d) @@ -822,20 +827,23 @@ serializeMsgDeliveryStatus = \case MDSSndPending -> "snd_pending" MDSSndAgent -> "snd_agent" MDSSndSent -> "snd_sent" - MDSSndReceived -> "snd_received" + MDSSndRcvd status -> "snd_rcvd " <> safeDecodeUtf8 (strEncode status) MDSSndRead -> "snd_read" msgDeliveryStatusT :: Text -> Maybe AMsgDeliveryStatus -msgDeliveryStatusT = \case - "rcv_agent" -> Just $ AMDS SMDRcv MDSRcvAgent - "rcv_acknowledged" -> Just $ AMDS SMDRcv MDSRcvAcknowledged - "snd_pending" -> Just $ AMDS SMDSnd MDSSndPending - "snd_agent" -> Just $ AMDS SMDSnd MDSSndAgent - "snd_sent" -> Just $ AMDS SMDSnd MDSSndSent - "snd_received" -> Just $ AMDS SMDSnd MDSSndReceived - "snd_read" -> Just $ AMDS SMDSnd MDSSndRead - _ -> Nothing - +msgDeliveryStatusT = eitherToMaybe . parseAll statusP . encodeUtf8 + where + statusP = + A.takeTill (== ' ') >>= \case + "rcv_agent" -> pure $ AMDS SMDRcv MDSRcvAgent + "rcv_acknowledged" -> pure $ AMDS SMDRcv MDSRcvAcknowledged + "snd_pending" -> pure $ AMDS SMDSnd MDSSndPending + "snd_agent" -> pure $ AMDS SMDSnd MDSSndAgent + "snd_sent" -> pure $ AMDS SMDSnd MDSSndSent + "snd_rcvd" -> AMDS SMDSnd . MDSSndRcvd <$> (A.space *> strP) + "snd_read" -> pure $ AMDS SMDSnd MDSSndRead + _ -> fail "bad AMsgDeliveryStatus" + msgDeliveryStatusT' :: forall d. MsgDirectionI d => Text -> Maybe (MsgDeliveryStatus d) msgDeliveryStatusT' s = msgDeliveryStatusT s >>= \(AMDS d st) -> diff --git a/src/Simplex/Chat/Migrations/M20230705_delivery_receipts.hs b/src/Simplex/Chat/Migrations/M20230705_delivery_receipts.hs new file mode 100644 index 000000000..ec59209d6 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230705_delivery_receipts.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230705_delivery_receipts where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230705_delivery_receipts :: Query +m20230705_delivery_receipts = + [sql| +ALTER TABLE users ADD COLUMN send_rcpts_contacts INTEGER NOT NULL DEFAULT 0; +ALTER TABLE users ADD COLUMN send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0; +ALTER TABLE contacts ADD COLUMN send_rcpts INTEGER; +ALTER TABLE groups ADD COLUMN send_rcpts INTEGER; +|] + +down_m20230705_delivery_receipts :: Query +down_m20230705_delivery_receipts = + [sql| +ALTER TABLE users DROP COLUMN send_rcpts_contacts; +ALTER TABLE users DROP COLUMN send_rcpts_small_groups; +ALTER TABLE contacts DROP COLUMN send_rcpts; +ALTER TABLE groups DROP COLUMN send_rcpts; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 176397ddc..893d00d34 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -31,7 +31,9 @@ CREATE TABLE users( agent_user_id INTEGER CHECK(agent_user_id NOT NULL), view_pwd_hash BLOB, view_pwd_salt BLOB, - show_ntfs INTEGER NOT NULL DEFAULT 1, -- 1 for active user + show_ntfs INTEGER NOT NULL DEFAULT 1, + send_rcpts_contacts INTEGER NOT NULL DEFAULT 0, + send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0, -- 1 for active user FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -65,6 +67,7 @@ CREATE TABLE contacts( chat_ts TEXT, deleted INTEGER NOT NULL DEFAULT 0, favorite INTEGER NOT NULL DEFAULT 0, + send_rcpts INTEGER, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -137,7 +140,8 @@ CREATE TABLE groups( host_conn_custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL), chat_ts TEXT, - favorite INTEGER NOT NULL DEFAULT 0, -- received + favorite INTEGER NOT NULL DEFAULT 0, + send_rcpts INTEGER, -- received FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 49bd4db91..62f8055da 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -712,6 +712,13 @@ hasNotification = \case XCallInv_ -> True _ -> False +hasDeliveryReceipt :: CMEventTag e -> Bool +hasDeliveryReceipt = \case + XMsgNew_ -> True + XGrpInv_ -> True + XCallInv_ -> True + _ -> False + appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary) appBinaryToCM AppMessageBinary {msgId, tag, body} = do eventTag <- strDecode $ B.singleton tag diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 4e3c4ab90..5f8577ffb 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -1,6 +1,7 @@ module Simplex.Chat.Store ( SQLiteStore, StoreError (..), + UserMsgReceiptSettings (..), UserContactLink (..), AutoAccept (..), createChatStore, diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 5b0b07281..416986173 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -60,17 +60,17 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do db [sql| SELECT - c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.favorite, + c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.send_rcpts, c.favorite, p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts FROM contacts c JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0 |] (userId, contactId) - toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, Maybe Bool, Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)] -> Either StoreError Contact - toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)] = + toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)] -> Either StoreError Contact + toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)] = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs} toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" @@ -82,7 +82,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, + g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 845167bdd..da03ed3a7 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -12,6 +12,7 @@ module Simplex.Chat.Store.Direct updateContactProfile_, updateContactProfile_', deleteContactProfile_, + -- * Contacts and connections functions getPendingContactConnection, deletePendingContactConnection, @@ -134,7 +135,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do [sql| SELECT -- Contact - ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias, @@ -421,7 +422,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi [sql| SELECT -- Contact - ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias, @@ -566,7 +567,7 @@ getContact_ db user@User {userId} contactId deleted = [sql| SELECT -- Contact - ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias, @@ -670,8 +671,8 @@ updateConnectionStatus db Connection {connId} connStatus = do DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ? WHERE connection_id = ?" (connStatus, currentTs, connId) updateContactSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO () -updateContactSettings db User {userId} contactId ChatSettings {enableNtfs, favorite} = - DB.execute db "UPDATE contacts SET enable_ntfs = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, favorite, userId, contactId) +updateContactSettings db User {userId} contactId ChatSettings {enableNtfs, sendRcpts, favorite} = + DB.execute db "UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, sendRcpts, favorite, userId, contactId) setConnConnReqInv :: DB.Connection -> User -> Int64 -> ConnReqInvitation -> IO () setConnConnReqInv db User {userId} connId connReq = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 1829192df..c622f3e87 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -103,16 +103,16 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Util (eitherToMaybe) import UnliftIO.STM -type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo -toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) = +toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) = let membership = toGroupMember userContactId userMemberRow - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs} @@ -218,7 +218,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId = [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, + g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, @@ -270,7 +270,7 @@ createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do insertedRowId db memberId <- liftIO $ encodedRandomBytes gVar 12 membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs - let chatSettings = ChatSettings {enableNtfs = True, favorite = False} + let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs} -- | creates a new group record for the group the current user was invited to, or returns an existing one @@ -315,7 +315,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo insertedRowId db GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs - let chatSettings = ChatSettings {enableNtfs = True, favorite = False} + let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False} pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId) getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId @@ -452,7 +452,7 @@ getUserGroupDetails db User {userId, userContactId} = <$> DB.query db [sql| - SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, + SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences FROM groups g @@ -633,7 +633,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} = [sql| SELECT -- Contact - ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias, @@ -932,7 +932,7 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} = [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, + g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, @@ -972,7 +972,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = db [sql| SELECT - ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter @@ -989,10 +989,10 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = |] (userId, groupMemberId) where - toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, Maybe Bool, Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)) :. ConnectionRow -> Contact - toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) = + toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)) :. ConnectionRow -> Contact + toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} activeConn = toConnection connRow mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs} @@ -1039,7 +1039,7 @@ getGroupInfo db User {userId, userContactId} groupId = [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, + g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, @@ -1229,8 +1229,8 @@ mergeContactRecords db userId ct1 ct2 = do ctCreatedAt Contact {createdAt} = createdAt updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO () -updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, favorite} = - DB.execute db "UPDATE groups SET enable_ntfs = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, favorite, userId, groupId) +updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} = + DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId) getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont)) getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 0cc17320e..1bbb8bcaa 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -466,7 +466,7 @@ getDirectChatPreviews_ db user@User {userId} = do [sql| SELECT -- Contact - ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite, + ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, -- Connection c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias, @@ -531,7 +531,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do [sql| SELECT -- GroupInfo - g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, + g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index f1294de64..f1fd40d43 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -73,6 +73,7 @@ import Simplex.Chat.Migrations.M20230529_indexes import Simplex.Chat.Migrations.M20230608_deleted_contacts import Simplex.Chat.Migrations.M20230618_favorite_chats import Simplex.Chat.Migrations.M20230621_chat_item_moderations +import Simplex.Chat.Migrations.M20230705_delivery_receipts import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -145,7 +146,8 @@ schemaMigrations = ("20230529_indexes", m20230529_indexes, Just down_m20230529_indexes), ("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts), ("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats), - ("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations) + ("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations), + ("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 121f563c2..797f237f7 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -9,6 +9,7 @@ module Simplex.Chat.Store.Profiles ( AutoAccept (..), + UserMsgReceiptSettings (..), UserContactLink (..), createUserRecord, createUserRecordAt, @@ -27,6 +28,8 @@ module Simplex.Chat.Store.Profiles getUserFileInfo, deleteUserRecord, updateUserPrivacy, + updateAllContactReceipts, + updateUserContactReceipts, updateUserProfile, setUserProfileContactLink, getUserContactProfiles, @@ -86,10 +89,13 @@ createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> UTCTime createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, preferences = userPreferences} activeUser currentTs = checkConstraint SEDuplicateName . liftIO $ do when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0" + let showNtfs = True + sendRcptsContacts = True + sendRcptsSmallGroups = False DB.execute db - "INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, created_at, updated_at) VALUES (?,?,?,0,?,?,?)" - (auId, displayName, activeUser, True, currentTs, currentTs) + "INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)" + (auId, displayName, activeUser, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, currentTs, currentTs) userId <- insertedRowId db DB.execute db @@ -106,7 +112,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, (profileId, displayName, userId, True, currentTs, currentTs) contactId <- insertedRowId db DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId) - pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences, True) :. (Nothing, Nothing) + pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing) getUsersInfo :: DB.Connection -> IO [UserInfo] getUsersInfo db = getUsers db >>= mapM getUserInfo @@ -213,6 +219,15 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} = where hashSalt = L.unzip . fmap (\UserPwdHash {hash, salt} -> (hash, salt)) +updateAllContactReceipts :: DB.Connection -> Bool -> IO () +updateAllContactReceipts db onOff = + DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE view_pwd_hash IS NULL" (Only onOff) + +updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO () +updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do + DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId) + when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL" + updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User updateUserProfile db user p' | displayName == newName = do @@ -357,6 +372,12 @@ deleteUserAddress db user@User {userId} = do void $ setUserProfileContactLink db user Nothing DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL" (Only userId) +data UserMsgReceiptSettings = UserMsgReceiptSettings + { enable :: Bool, + clearOverrides :: Bool + } + deriving (Show) + data UserContactLink = UserContactLink { connReqContact :: ConnReqContact, autoAccept :: Maybe AutoAccept diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index dad63d64e..fc1444a8a 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -218,20 +218,20 @@ deleteUnusedIncognitoProfileById_ db User {userId} profile_id = |] [":user_id" := userId, ":profile_id" := profile_id] -type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, Maybe Bool, Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) +type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) toContact :: User -> ContactRow :. ConnectionRow -> Contact -toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) = +toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} activeConn = toConnection connRow - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs} toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact -toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) = +toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} in case toMaybeConnection connRow of Just activeConn -> let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn @@ -263,15 +263,16 @@ toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userCo userQuery :: Query userQuery = [sql| - SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences, u.show_ntfs, u.view_pwd_hash, u.view_pwd_salt + SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences, + u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt FROM users u JOIN contacts uct ON uct.contact_id = u.contact_id JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id |] -toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences, Bool) :. (Maybe B64UrlByteString, Maybe B64UrlByteString) -> User -toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences, showNtfs) :. (viewPwdHash_, viewPwdSalt_)) = - User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, viewPwdHash} +toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString) -> User +toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_)) = + User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash} where profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""} fullPreferences = mergePreferences Nothing userPreferences diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 13570124a..1ddf3c384 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -112,7 +112,9 @@ data User = User fullPreferences :: FullPreferences, activeUser :: Bool, viewPwdHash :: Maybe UserPwdHash, - showNtfs :: Bool + showNtfs :: Bool, + sendRcptsContacts :: Bool, + sendRcptsSmallGroups :: Bool } deriving (Show, Generic, FromJSON) @@ -334,6 +336,7 @@ contactAndGroupIds = \case -- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties) data ChatSettings = ChatSettings { enableNtfs :: Bool, + sendRcpts :: Maybe Bool, favorite :: Bool } deriving (Eq, Show, Generic, FromJSON) @@ -343,6 +346,7 @@ instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOpt defaultChatSettings :: ChatSettings defaultChatSettings = ChatSettings { enableNtfs = True, + sendRcpts = Nothing, favorite = False } @@ -352,8 +356,7 @@ pattern DisableNtfs <- ChatSettings {enableNtfs = False} data ChatFeature = CFTimedMessages | CFFullDelete - | -- | CFReceipts - CFReactions + | CFReactions | CFVoice | CFCalls deriving (Show, Generic) @@ -398,7 +401,6 @@ allChatFeatures :: [AChatFeature] allChatFeatures = [ ACF SCFTimedMessages, ACF SCFFullDelete, - -- ACF SCFReceipts, ACF SCFReactions, ACF SCFVoice, ACF SCFCalls @@ -408,7 +410,6 @@ chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f) chatPrefSel = \case SCFTimedMessages -> timedMessages SCFFullDelete -> fullDelete - -- SCFReceipts -> receipts SCFReactions -> reactions SCFVoice -> voice SCFCalls -> calls @@ -434,7 +435,6 @@ instance PreferenceI FullPreferences where getPreference = \case SCFTimedMessages -> timedMessages SCFFullDelete -> fullDelete - -- CFReceipts -> receipts SCFReactions -> reactions SCFVoice -> voice SCFCalls -> calls @@ -464,7 +464,6 @@ setPreference_ f pref_ prefs = data Preferences = Preferences { timedMessages :: Maybe TimedMessagesPreference, fullDelete :: Maybe FullDeletePreference, - -- receipts :: Maybe SimplePreference, reactions :: Maybe ReactionsPreference, voice :: Maybe VoicePreference, calls :: Maybe CallsPreference @@ -485,8 +484,7 @@ data GroupFeature = GFTimedMessages | GFDirectMessages | GFFullDelete - | -- | GFReceipts - GFReactions + | GFReactions | GFVoice | GFFiles deriving (Show, Generic) @@ -495,7 +493,6 @@ data SGroupFeature (f :: GroupFeature) where SGFTimedMessages :: SGroupFeature 'GFTimedMessages SGFDirectMessages :: SGroupFeature 'GFDirectMessages SGFFullDelete :: SGroupFeature 'GFFullDelete - -- SGFReceipts :: SGroupFeature 'GFReceipts SGFReactions :: SGroupFeature 'GFReactions SGFVoice :: SGroupFeature 'GFVoice SGFFiles :: SGroupFeature 'GFFiles @@ -537,7 +534,6 @@ allGroupFeatures = [ AGF SGFTimedMessages, AGF SGFDirectMessages, AGF SGFFullDelete, - -- GFReceipts, AGF SGFReactions, AGF SGFVoice, AGF SGFFiles @@ -548,7 +544,6 @@ groupPrefSel = \case SGFTimedMessages -> timedMessages SGFDirectMessages -> directMessages SGFFullDelete -> fullDelete - -- GFReceipts -> receipts SGFReactions -> reactions SGFVoice -> voice SGFFiles -> files @@ -576,7 +571,6 @@ instance GroupPreferenceI FullGroupPreferences where SGFTimedMessages -> timedMessages SGFDirectMessages -> directMessages SGFFullDelete -> fullDelete - -- GFReceipts -> receipts SGFReactions -> reactions SGFVoice -> voice SGFFiles -> files @@ -587,7 +581,6 @@ data GroupPreferences = GroupPreferences { timedMessages :: Maybe TimedMessagesGroupPreference, directMessages :: Maybe DirectMessagesGroupPreference, fullDelete :: Maybe FullDeleteGroupPreference, - -- receipts :: Maybe GroupPreference, reactions :: Maybe ReactionsGroupPreference, voice :: Maybe VoiceGroupPreference, files :: Maybe FilesGroupPreference @@ -637,7 +630,6 @@ setGroupTimedMessagesPreference pref prefs_ = data FullPreferences = FullPreferences { timedMessages :: TimedMessagesPreference, fullDelete :: FullDeletePreference, - -- receipts :: SimplePreference, reactions :: ReactionsPreference, voice :: VoicePreference, calls :: CallsPreference @@ -652,7 +644,6 @@ data FullGroupPreferences = FullGroupPreferences { timedMessages :: TimedMessagesGroupPreference, directMessages :: DirectMessagesGroupPreference, fullDelete :: FullDeleteGroupPreference, - -- receipts :: GroupPreference, reactions :: ReactionsGroupPreference, voice :: VoiceGroupPreference, files :: FilesGroupPreference @@ -665,7 +656,6 @@ instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.de data ContactUserPreferences = ContactUserPreferences { timedMessages :: ContactUserPreference TimedMessagesPreference, fullDelete :: ContactUserPreference FullDeletePreference, - -- receipts :: ContactUserPreference, reactions :: ContactUserPreference ReactionsPreference, voice :: ContactUserPreference VoicePreference, calls :: ContactUserPreference CallsPreference @@ -695,7 +685,6 @@ toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} Preferences { timedMessages = Just timedMessages, fullDelete = Just fullDelete, - -- receipts = Just receipts, reactions = Just reactions, voice = Just voice, calls = Just calls @@ -706,7 +695,6 @@ defaultChatPrefs = FullPreferences { timedMessages = TimedMessagesPreference {allow = FAYes, ttl = Nothing}, fullDelete = FullDeletePreference {allow = FANo}, - -- receipts = SimplePreference {allow = FANo}, reactions = ReactionsPreference {allow = FAYes}, voice = VoicePreference {allow = FAYes}, calls = CallsPreference {allow = FAYes} @@ -721,7 +709,6 @@ defaultGroupPrefs = { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400}, directMessages = DirectMessagesGroupPreference {enable = FEOff}, fullDelete = FullDeleteGroupPreference {enable = FEOff}, - -- receipts = GroupPreference {enable = FEOff}, reactions = ReactionsGroupPreference {enable = FEOn}, voice = VoiceGroupPreference {enable = FEOn}, files = FilesGroupPreference {enable = FEOn} @@ -1009,7 +996,6 @@ mergePreferences contactPrefs userPreferences = FullPreferences { timedMessages = pref SCFTimedMessages, fullDelete = pref SCFFullDelete, - -- receipts = pref CFReceipts, reactions = pref SCFReactions, voice = pref SCFVoice, calls = pref SCFCalls @@ -1034,7 +1020,6 @@ mergeGroupPreferences groupPreferences = { timedMessages = pref SGFTimedMessages, directMessages = pref SGFDirectMessages, fullDelete = pref SGFFullDelete, - -- receipts = pref GFReceipts, reactions = pref SGFReactions, voice = pref SGFVoice, files = pref SGFFiles @@ -1049,7 +1034,6 @@ toGroupPreferences groupPreferences = { timedMessages = pref SGFTimedMessages, directMessages = pref SGFDirectMessages, fullDelete = pref SGFFullDelete, - -- receipts = pref GFReceipts, reactions = pref SGFReactions, voice = pref SGFVoice, files = pref SGFFiles @@ -1128,7 +1112,6 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit ContactUserPreferences { timedMessages = pref SCFTimedMessages, fullDelete = pref SCFFullDelete, - -- receipts = pref CFReceipts, reactions = pref SCFReactions, voice = pref SCFVoice, calls = pref SCFCalls @@ -1156,7 +1139,6 @@ getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactU getContactUserPreference = \case SCFTimedMessages -> timedMessages SCFFullDelete -> fullDelete - -- CFReceipts -> receipts SCFReactions -> reactions SCFVoice -> voice SCFCalls -> calls diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8328b1507..600266576 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -62,7 +62,7 @@ serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse - serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString] -responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts tz = \case +responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz = \case CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile CRUsersList users -> viewUsersList users CRChatStarted -> ["chat started"] @@ -98,7 +98,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId] - CRChatItemStatusUpdated u _ -> ttyUser u [] + CRChatItemStatusUpdated u ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView @@ -461,6 +461,20 @@ localTs tz ts = do formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime formattedTime +viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString] +viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts = + case itemStatus of + CISSndRcvd rcptStatus -> + if testView && showReceipts + then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz + else [] + _ -> [] + +viewDeliveryReceipt :: MsgReceiptStatus -> StyledString +viewDeliveryReceipt = \case + MROk -> "⩗" + MRBadMsgHash -> ttyError' "⩗!" + viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString] viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of DirectChat c -> case chatDir of @@ -495,7 +509,7 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive} quote = maybe [] (groupQuote g) quotedItem _ -> [] -hideLive :: CIMeta с d -> [StyledString] -> [StyledString] +hideLive :: CIMeta c d -> [StyledString] -> [StyledString] hideLive CIMeta {itemLive = Just True} _ = [] hideLive _ s = s diff --git a/stack.yaml b/stack.yaml index fb0a56f1a..21030e109 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 1afcefa5e7cf7c4a5e5732104105d14259be16b6 + commit: 58cb2855d23ac970a619a61d088ed2a08dfb3d81 - github: kazu-yamamoto/http2 commit: b5a1b7200cf5bc7044af34ba325284271f6dff25 # - ../direct-sqlcipher diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 8970c6304..b0c3a3b49 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -116,6 +116,7 @@ testCfg :: ChatConfig testCfg = defaultChatConfig { agentConfig = testAgentCfg, + showReceipts = False, testView = True, tbqSize = 16, xftpFileConfig = Nothing @@ -248,6 +249,7 @@ getTermLine cc = Just s -> do -- remove condition to always echo virtual terminal when (printOutput cc) $ do + -- when True $ do name <- userName cc putStrLn $ name <> ": " <> s pure s diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 82da77d03..7d4774500 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -91,6 +91,9 @@ chatDirectTests = do it "synchronize ratchets, reset connection code" testSyncRatchetCodeReset describe "message reactions" $ do it "set message reactions" testSetMessageReactions + describe "delivery receipts" $ do + it "should send delivery receipts" testSendDeliveryReceipts + it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts testAddContact :: HasCallStack => SpecWith FilePath testAddContact = versionTestMatrix2 runTestAddContact @@ -491,6 +494,7 @@ testRepeatAuthErrorsDisableContact = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob alice <##> bob + threadDelay 500000 bob ##> "/d alice" bob <## "alice: contact is deleted" forM_ [1 .. authErrDisableCount] $ \_ -> sendAuth alice @@ -2007,7 +2011,7 @@ testMsgDecryptError tmp = withTestChat tmp "bob" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" alice #> "@bob hello again" - bob <# "alice> skipped message ID 5..7" + bob <# "alice> skipped message ID 9..11" bob <# "alice> hello again" bob #> "@alice received!" alice <# "bob> received!" @@ -2017,10 +2021,15 @@ setupDesynchronizedRatchet tmp alice = do copyDb "bob" "bob_old" withTestChat tmp "bob" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" - alice #> "@bob hello" - bob <# "alice> hello" - bob #> "@alice hello too" - alice <# "bob> hello too" + alice #> "@bob 1" + bob <# "alice> 1" + bob #> "@alice 2" + alice <# "bob> 2" + alice #> "@bob 3" + bob <# "alice> 3" + bob #> "@alice 4" + alice <# "bob> 4" + threadDelay 500000 withTestChat tmp "bob_old" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" bob ##> "/sync alice" @@ -2168,3 +2177,97 @@ testSetMessageReactions = bob ##> "/tail @alice 1" bob <# "alice> hi" bob <## " 👍 1" + +testSendDeliveryReceipts :: HasCallStack => FilePath -> IO () +testSendDeliveryReceipts tmp = + withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do + connectUsers alice bob + + alice #> "@bob hi" + bob <# "alice> hi" + alice ⩗ "@bob hi" + + bob #> "@alice hey" + alice <# "bob> hey" + bob ⩗ "@alice hey" + where + cfg = testCfg {showReceipts = True} + +testConfigureDeliveryReceipts :: HasCallStack => FilePath -> IO () +testConfigureDeliveryReceipts tmp = + withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do + withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do + connectUsers alice bob + connectUsers alice cath + + -- for new users receipts are enabled by default + receipt bob alice "1" + receipt cath alice "2" + + -- configure receipts in all chats + alice ##> "/set receipts all off" + alice <## "ok" + noReceipt bob alice "3" + noReceipt cath alice "4" + + -- configure receipts for user contacts + alice ##> "/_set receipts 1 on" + alice <## "ok" + receipt bob alice "5" + receipt cath alice "6" + + -- configure receipts for user contacts (terminal api) + alice ##> "/set receipts off" + alice <## "ok" + noReceipt bob alice "7" + noReceipt cath alice "8" + + -- configure receipts for contact + alice ##> "/receipts @bob on" + alice <## "ok" + receipt bob alice "9" + noReceipt cath alice "10" + + -- configure receipts for user contacts (don't clear overrides) + alice ##> "/_set receipts 1 off" + alice <## "ok" + receipt bob alice "11" + noReceipt cath alice "12" + + alice ##> "/_set receipts 1 off clear_overrides=off" + alice <## "ok" + receipt bob alice "13" + noReceipt cath alice "14" + + -- configure receipts for user contacts (clear overrides) + alice ##> "/set receipts off clear_overrides=on" + alice <## "ok" + noReceipt bob alice "15" + noReceipt cath alice "16" + + -- configure receipts for contact, reset to default + alice ##> "/receipts @bob on" + alice <## "ok" + receipt bob alice "17" + noReceipt cath alice "18" + + alice ##> "/receipts @bob default" + alice <## "ok" + noReceipt bob alice "19" + noReceipt cath alice "20" + where + cfg = testCfg {showReceipts = True} + receipt cc1 cc2 msg = do + name1 <- userName cc1 + name2 <- userName cc2 + cc1 #> ("@" <> name2 <> " " <> msg) + cc2 <# (name1 <> "> " <> msg) + cc1 ⩗ ("@" <> name2 <> " " <> msg) + noReceipt cc1 cc2 msg = do + name1 <- userName cc1 + name2 <- userName cc2 + cc1 #> ("@" <> name2 <> " " <> msg) + cc2 <# (name1 <> "> " <> msg) + cc1 "/d bob" alice <## "bob: contact is deleted" bob ##> "/j team" @@ -1798,6 +1799,7 @@ testGroupLinkContactUsed = bob @@@ [("#team", "connected")] alice #> "@bob hello" bob <# "alice> hello" + threadDelay 500000 alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY") alice @@@ [("@bob", ""), ("#team", "connected")] bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY") diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 2b142cb5e..08d33df1d 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -106,7 +106,7 @@ testUpdateProfileImage = alice <## "profile image removed" alice ##> "/show profile image" alice <## "No profile image" - alice ##> "/_profile 1 {\"displayName\": \"alice2\", \"fullName\": \"\"}" + alice ##> "/_profile 1 {\"displayName\": \"alice2\", \"fullName\": \"\", \"preferences\": {\"receipts\": {\"allow\": \"yes\", \"activated\": true}}}" alice <## "user profile is changed to alice2 (your 1 contacts are notified)" bob <## "contact alice changed to alice2" bob <## "use @alice2 to send messages" @@ -596,6 +596,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $ bob ##> "/contacts" bob <## "i alice (Alice)" bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito] + threadDelay 500000 -- delete contact, incognito profile is deleted bob ##> "/d alice" bob <## "alice: contact is deleted" @@ -878,7 +879,7 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr cath <## "alice (Alice): contact is connected" ] alice <## "cath (Catherine): contact is connected" - alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"\", \"preferences\": {\"fullDelete\": {\"allow\": \"always\"}}}" + alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"\", \"preferences\": {\"fullDelete\": {\"allow\": \"always\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}" alice <## "user full name removed (your 1 contacts are notified)" alice <## "updated preferences:" alice <## "Full deletion allowed: always" @@ -1050,7 +1051,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $ createDirectoryIfMissing True "./tests/tmp/bob" copyFile "./tests/fixtures/test.txt" "./tests/tmp/alice/test.txt" copyFile "./tests/fixtures/test.txt" "./tests/tmp/bob/test.txt" - bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"Bob\", \"preferences\": {\"voice\": {\"allow\": \"no\"}}}" + bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"Bob\", \"preferences\": {\"voice\": {\"allow\": \"no\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}" bob <## "profile image removed" bob <## "updated preferences:" bob <## "Voice messages allowed: no" @@ -1100,7 +1101,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $ bob <## "Voice messages: off (you allow: default (no), contact allows: yes)" bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off")]) (bob "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"allow\": \"yes\"}}}" + bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"allow\": \"yes\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}" bob <## "user full name removed (your 1 contacts are notified)" bob <## "updated preferences:" bob <## "Voice messages allowed: yes" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index bd0c1c65f..9a3b3b09c 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -307,6 +307,9 @@ cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line ($<#) :: HasCallStack => (TestCC, String) -> String -> Expectation (cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line +(⩗) :: HasCallStack => TestCC -> String -> Expectation +cc ⩗ line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line + ( TestCC -> Expectation ( Nothing +dropReceipt :: HasCallStack => String -> String +dropReceipt msg = fromMaybe err $ dropReceipt_ msg + where + err = error $ "invalid receipt: " <> msg + +dropReceipt_ :: String -> Maybe String +dropReceipt_ msg = case splitAt 2 msg of + ("⩗ ", text) -> Just text + _ -> Nothing + getInvitation :: HasCallStack => TestCC -> IO String getInvitation cc = do cc <## "pass this invitation link to your contact (via another channel):" diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index f8d443829..220c8a0d3 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -16,7 +16,7 @@ mobileTests :: SpecWith FilePath mobileTests = do describe "mobile API" $ do it "start new chat without user" testChatApiNoUser - xit "start new chat with existing user" testChatApi + it "start new chat with existing user" testChatApi noActiveUser :: String #if defined(darwin_HOST_OS) && defined(swiftJSON) @@ -27,16 +27,16 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e activeUserExists :: String #if defined(darwin_HOST_OS) && defined(swiftJSON) -activeUserExists = "{\"resp\":{\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true},\"chatError\":{\"error\":{\"errorType\":{\"userExists\":{\"contactName\":\"alice\"}}}}}}}" +activeUserExists = "{\"resp\":{\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false},\"chatError\":{\"error\":{\"errorType\":{\"userExists\":{\"contactName\":\"alice\"}}}}}}}" #else -activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}" +activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}" #endif activeUser :: String #if defined(darwin_HOST_OS) && defined(swiftJSON) -activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}}" +activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}}}}" #else -activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}" +activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}}}" #endif chatStarted :: String @@ -75,7 +75,7 @@ pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\"," <> userJSON <> #endif userJSON :: String -userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}" +userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}" parsedMarkdown :: String #if defined(darwin_HOST_OS) && defined(swiftJSON)