diff --git a/README.md b/README.md index 52f753a5ab..936667da8c 100644 --- a/README.md +++ b/README.md @@ -163,13 +163,14 @@ Your donations help us raise more funds - any amount, even the price of the cup It is possible to donate via: - [GitHub](https://github.com/sponsors/simplex-chat) (commission-free) or [OpenCollective](https://opencollective.com/simplex-chat) (~10% commission). -- Bitcoin: bc1qd74rc032ek2knhhr3yjq2ajzc5enz3h4qwnxad -- Monero: 8568eeVjaJ1RQ65ZUn9PRQ8ENtqeX9VVhcCYYhnVLxhV4JtBqw42so2VEUDQZNkFfsH5sXCuV7FN8VhRQ21DkNibTZP57Qt +- BTC: bc1q2gy6f02nn6vvcxs0pnu29tpnpyz0qf66505d4u +- XMR: 8568eeVjaJ1RQ65ZUn9PRQ8ENtqeX9VVhcCYYhnVLxhV4JtBqw42so2VEUDQZNkFfsH5sXCuV7FN8VhRQ21DkNibTZP57Qt - BCH: bitcoincash:qq6c8vfvxqrk6rhdysgvkhqc24sggkfsx5nqvdlqcg -- Ethereum: 0xD9ee7Db0AD0dc1Dfa7eD53290199ED06beA04692 -- USDT: - - Ethereum: 0xD9ee7Db0AD0dc1Dfa7eD53290199ED06beA04692 -- Solana: 7JCf5m3TiHmYKZVr6jCu1KeZVtb9Y1jRMQDU69p5ARnu +- ETH: 0xD9ee7Db0AD0dc1Dfa7eD53290199ED06beA04692 +- USDT (Ethereum): 0xD9ee7Db0AD0dc1Dfa7eD53290199ED06beA04692 +- ZEC: t1fwjQW5gpFhDqXNhxqDWyF9j9WeKvVS5Jg +- DOGE: D99pV4n9TrPxBPCkQGx4w4SMSa6QjRBxPf +- SOL: 7JCf5m3TiHmYKZVr6jCu1KeZVtb9Y1jRMQDU69p5ARnu - please ask if you want to donate any other coins. Thank you, @@ -233,7 +234,7 @@ You can use SimpleX with your own servers and still communicate with people usin Recent and important updates: -[Nov 25, 2025. Servers operated by Flux - true privacy and decentralization for all users](./20241125-servers-operated-by-flux-true-privacy-and-decentralization-for-all-users.md) +[Dec 10, 2024. SimpleX network: preset servers operated by Flux, business chats and more with v6.2 of the apps](./20241210-simplex-network-v6-2-servers-by-flux-business-chats.md) [Oct 14, 2024. SimpleX network: security review of protocols design by Trail of Bits, v6.1 released with better calls and user experience.](./blog/20241014-simplex-network-v6-1-security-review-better-calls-user-experience.md) @@ -243,20 +244,14 @@ Recent and important updates: [Mar 14, 2024. SimpleX Chat v5.6 beta: adding quantum resistance to Signal double ratchet algorithm.](./blog/20240314-simplex-chat-v5-6-quantum-resistance-signal-double-ratchet-algorithm.md) -[Jan 24, 2024. SimpleX Chat: free infrastructure from Linode, v5.5 released with private notes, group history and a simpler UX to connect.](./blog/20240124-simplex-chat-infrastructure-costs-v5-5-simplex-ux-private-notes-group-history.md) - [Nov 25, 2023. SimpleX Chat v5.4 released: link mobile and desktop apps via quantum resistant protocol, and much better groups](./blog/20231125-simplex-chat-v5-4-link-mobile-desktop-quantum-resistant-better-groups.md). -[Sep 25, 2023. SimpleX Chat v5.3 released: desktop app, local file encryption, improved groups and directory service](./blog/20230925-simplex-chat-v5-3-desktop-app-local-file-encryption-directory-service.md). - [Apr 22, 2023. SimpleX Chat: vision and funding, v5.0 released with videos and files up to 1gb](./blog/20230422-simplex-chat-vision-funding-v5-videos-files-passcode.md). [Mar 1, 2023. SimpleX File Transfer Protocol – send large files efficiently, privately and securely, soon to be integrated into SimpleX Chat apps.](./blog/20230301-simplex-file-transfer-protocol.md). [Nov 8, 2022. Security audit by Trail of Bits, the new website and v4.2 released](./blog/20221108-simplex-chat-v4.2-security-audit-new-website.md). -[Sep 28, 2022. v4.0: encrypted local chat database and many other changes](./blog/20220928-simplex-chat-v4-encrypted-database.md). - [All updates](./blog) ## :zap: Quick installation of a terminal app @@ -384,9 +379,11 @@ Please also join [#simplex-devs](https://simplex.chat/contact#/?v=1-2&smp=smp%3A - ✅ Improve sending videos (including encryption of locally stored videos). - ✅ Post-quantum resistant key exchange in double ratchet protocol. - ✅ Message delivery relay for senders (to conceal IP address from the recipients' servers and to reduce the traffic). +- ✅ Support multiple network operators in the app. +- 🏗 Large groups, communities and public channels. +- 🏗 Short links to connect and join groups. - 🏗 Improve stability and reduce battery usage. - 🏗 Improve experience for the new users. -- 🏗 Large groups, communities and public channels. - Privacy & security slider - a simple way to set all settings at once. - SMP queue redundancy and rotation (manual is supported). - Include optional message into connection request sent via contact address. diff --git a/apps/ios/Shared/Model/ChatModel.swift b/apps/ios/Shared/Model/ChatModel.swift index 6b6b0ac03f..dad84571ea 100644 --- a/apps/ios/Shared/Model/ChatModel.swift +++ b/apps/ios/Shared/Model/ChatModel.swift @@ -100,6 +100,94 @@ class ItemsModel: ObservableObject { } } +class ChatTagsModel: ObservableObject { + static let shared = ChatTagsModel() + + @Published var userTags: [ChatTag] = [] + @Published var activeFilter: ActiveFilter? = nil + @Published var presetTags: [PresetTag:Int] = [:] + @Published var unreadTags: [Int64:Int] = [:] + + func updateChatTags(_ chats: [Chat]) { + let tm = ChatTagsModel.shared + var newPresetTags: [PresetTag:Int] = [:] + var newUnreadTags: [Int64:Int] = [:] + for chat in chats { + for tag in PresetTag.allCases { + if presetTagMatchesChat(tag, chat.chatInfo) { + newPresetTags[tag] = (newPresetTags[tag] ?? 0) + 1 + } + } + if chat.unreadTag, let tags = chat.chatInfo.chatTags { + for tag in tags { + newUnreadTags[tag] = (newUnreadTags[tag] ?? 0) + 1 + } + } + } + if case let .presetTag(tag) = tm.activeFilter, (newPresetTags[tag] ?? 0) == 0 { + activeFilter = nil + } + presetTags = newPresetTags + unreadTags = newUnreadTags + } + + func updateChatFavorite(favorite: Bool, wasFavorite: Bool) { + let count = presetTags[.favorites] + if favorite && !wasFavorite { + presetTags[.favorites] = (count ?? 0) + 1 + } else if !favorite && wasFavorite, let count { + presetTags[.favorites] = max(0, count - 1) + if case .presetTag(.favorites) = activeFilter, (presetTags[.favorites] ?? 0) == 0 { + activeFilter = nil + } + } + } + + func addPresetChatTags(_ chatInfo: ChatInfo) { + for tag in PresetTag.allCases { + if presetTagMatchesChat(tag, chatInfo) { + presetTags[tag] = (presetTags[tag] ?? 0) + 1 + } + } + } + + func removePresetChatTags(_ chatInfo: ChatInfo) { + for tag in PresetTag.allCases { + if presetTagMatchesChat(tag, chatInfo) { + if let count = presetTags[tag] { + presetTags[tag] = max(0, count - 1) + } + } + } + } + + func markChatTagRead(_ chat: Chat) -> Void { + if chat.unreadTag, let tags = chat.chatInfo.chatTags { + decTagsReadCount(tags) + } + } + + func updateChatTagRead(_ chat: Chat, wasUnread: Bool) -> Void { + guard let tags = chat.chatInfo.chatTags else { return } + let nowUnread = chat.unreadTag + if nowUnread && !wasUnread { + for tag in tags { + unreadTags[tag] = (unreadTags[tag] ?? 0) + 1 + } + } else if !nowUnread && wasUnread { + decTagsReadCount(tags) + } + } + + func decTagsReadCount(_ tags: [Int64]) -> Void { + for tag in tags { + if let count = unreadTags[tag] { + unreadTags[tag] = max(0, count - 1) + } + } + } +} + class NetworkModel: ObservableObject { // map of connections network statuses, key is agent connection id @Published var networkStatuses: Dictionary = [:] @@ -344,6 +432,7 @@ final class ChatModel: ObservableObject { updateChatInfo(cInfo) } else if addMissing { addChat(Chat(chatInfo: cInfo, chatItems: [])) + ChatTagsModel.shared.addPresetChatTags(cInfo) } } @@ -566,6 +655,7 @@ final class ChatModel: ObservableObject { _updateChat(cInfo.id) { chat in self.decreaseUnreadCounter(user: self.currentUser!, by: chat.chatStats.unreadCount) self.updateFloatingButtons(unreadCount: 0) + ChatTagsModel.shared.markChatTagRead(chat) chat.chatStats = ChatStats() } // update current chat @@ -604,7 +694,9 @@ final class ChatModel: ObservableObject { // update preview let markedCount = chat.chatStats.unreadCount - unreadBelow if markedCount > 0 { + let wasUnread = chat.unreadTag chat.chatStats.unreadCount -= markedCount + ChatTagsModel.shared.updateChatTagRead(chat, wasUnread: wasUnread) self.decreaseUnreadCounter(user: self.currentUser!, by: markedCount) self.updateFloatingButtons(unreadCount: chat.chatStats.unreadCount) } @@ -617,7 +709,9 @@ final class ChatModel: ObservableObject { func markChatUnread(_ cInfo: ChatInfo, unreadChat: Bool = true) { _updateChat(cInfo.id) { chat in + let wasUnread = chat.unreadTag chat.chatStats.unreadChat = unreadChat + ChatTagsModel.shared.updateChatTagRead(chat, wasUnread: wasUnread) } } @@ -626,6 +720,7 @@ final class ChatModel: ObservableObject { if let chat = getChat(cInfo.id) { self.decreaseUnreadCounter(user: self.currentUser!, by: chat.chatStats.unreadCount) chat.chatItems = [] + ChatTagsModel.shared.markChatTagRead(chat) chat.chatStats = ChatStats() chat.chatInfo = cInfo } @@ -752,7 +847,9 @@ final class ChatModel: ObservableObject { } func changeUnreadCounter(_ chatIndex: Int, by count: Int) { + let wasUnread = chats[chatIndex].unreadTag chats[chatIndex].chatStats.unreadCount = chats[chatIndex].chatStats.unreadCount + count + ChatTagsModel.shared.updateChatTagRead(chats[chatIndex], wasUnread: wasUnread) changeUnreadCounter(user: currentUser!, by: count) } @@ -857,7 +954,10 @@ final class ChatModel: ObservableObject { func removeChat(_ id: String) { withAnimation { - chats.removeAll(where: { $0.id == id }) + if let i = getChatIndex(id) { + let removed = chats.remove(at: i) + ChatTagsModel.shared.removePresetChatTags(removed.chatInfo) + } } } @@ -955,6 +1055,10 @@ final class Chat: ObservableObject, Identifiable, ChatLike { } } + var unreadTag: Bool { + chatInfo.ntfsEnabled && (chatStats.unreadCount > 0 || chatStats.unreadChat) + } + var id: ChatId { get { chatInfo.id } } var viewId: String { get { "\(chatInfo.id) \(created.timeIntervalSince1970)" } } diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index 51be3191ec..7eb78edf74 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -318,6 +318,20 @@ private func apiChatsResponse(_ r: ChatResponse) throws -> [ChatData] { throw r } +func apiGetChatTags() throws -> [ChatTag] { + let userId = try currentUserId("apiGetChatTags") + let r = chatSendCmdSync(.apiGetChatTags(userId: userId)) + if case let .chatTags(_, tags) = r { return tags } + throw r +} + +func apiGetChatTagsAsync() async throws -> [ChatTag] { + let userId = try currentUserId("apiGetChatTags") + let r = await chatSendCmd(.apiGetChatTags(userId: userId)) + if case let .chatTags(_, tags) = r { return tags } + throw r +} + let loadItemsPerPage = 50 func apiGetChat(type: ChatType, id: Int64, search: String = "") async throws -> Chat { @@ -368,6 +382,34 @@ func apiForwardChatItems(toChatType: ChatType, toChatId: Int64, fromChatType: Ch return await processSendMessageCmd(toChatType: toChatType, cmd: cmd) } +func apiCreateChatTag(tag: ChatTagData) async throws -> [ChatTag] { + let r = await chatSendCmd(.apiCreateChatTag(tag: tag)) + if case let .chatTags(_, userTags) = r { + return userTags + } + throw r +} + +func apiSetChatTags(type: ChatType, id: Int64, tagIds: [Int64]) async throws -> ([ChatTag], [Int64]) { + let r = await chatSendCmd(.apiSetChatTags(type: type, id: id, tagIds: tagIds)) + if case let .tagsUpdated(_, userTags, chatTags) = r { + return (userTags, chatTags) + } + throw r +} + +func apiDeleteChatTag(tagId: Int64) async throws { + try await sendCommandOkResp(.apiDeleteChatTag(tagId: tagId)) +} + +func apiUpdateChatTag(tagId: Int64, tag: ChatTagData) async throws { + try await sendCommandOkResp(.apiUpdateChatTag(tagId: tagId, tagData: tag)) +} + +func apiReorderChatTags(tagIds: [Int64]) async throws { + try await sendCommandOkResp(.apiReorderChatTags(tagIds: tagIds)) +} + func apiSendMessages(type: ChatType, id: Int64, live: Bool = false, ttl: Int? = nil, composedMessages: [ComposedMessage]) async -> [ChatItem]? { let cmd: ChatCommand = .apiSendMessages(type: type, id: id, live: live, ttl: ttl, composedMessages: composedMessages) return await processSendMessageCmd(toChatType: type, cmd: cmd) @@ -1746,24 +1788,37 @@ func getUserChatData() throws { m.userAddress = try apiGetUserAddress() m.chatItemTTL = try getChatItemTTL() let chats = try apiGetChats() + let tags = try apiGetChatTags() m.updateChats(chats) + let tm = ChatTagsModel.shared + tm.activeFilter = nil + tm.userTags = tags + tm.updateChatTags(m.chats) } private func getUserChatDataAsync() async throws { let m = ChatModel.shared + let tm = ChatTagsModel.shared if m.currentUser != nil { let userAddress = try await apiGetUserAddressAsync() let chatItemTTL = try await getChatItemTTLAsync() let chats = try await apiGetChatsAsync() + let tags = try await apiGetChatTagsAsync() await MainActor.run { m.userAddress = userAddress m.chatItemTTL = chatItemTTL m.updateChats(chats) + tm.activeFilter = nil + tm.userTags = tags + tm.updateChatTags(m.chats) } } else { await MainActor.run { m.userAddress = nil m.updateChats([]) + tm.activeFilter = nil + tm.userTags = [] + tm.presetTags = [:] } } } diff --git a/apps/ios/Shared/Views/Chat/ChatInfoView.swift b/apps/ios/Shared/Views/Chat/ChatInfoView.swift index ea9daa74bc..1c3203920a 100644 --- a/apps/ios/Shared/Views/Chat/ChatInfoView.swift +++ b/apps/ios/Shared/Views/Chat/ChatInfoView.swift @@ -156,8 +156,8 @@ struct ChatInfoView: View { HStack(alignment: .center, spacing: 8) { let buttonWidth = g.size.width / 4 searchButton(width: buttonWidth) - AudioCallButton(chat: chat, contact: contact, width: buttonWidth) { alert = .someAlert(alert: $0) } - VideoButton(chat: chat, contact: contact, width: buttonWidth) { alert = .someAlert(alert: $0) } + AudioCallButton(chat: chat, contact: contact, connectionStats: $connectionStats, width: buttonWidth) { alert = .someAlert(alert: $0) } + VideoButton(chat: chat, contact: contact, connectionStats: $connectionStats, width: buttonWidth) { alert = .someAlert(alert: $0) } muteButton(width: buttonWidth) } } @@ -314,7 +314,15 @@ struct ChatInfoView: View { case .networkStatusAlert: return networkStatusAlert() case .switchAddressAlert: return switchAddressAlert(switchContactAddress) case .abortSwitchAddressAlert: return abortSwitchAddressAlert(abortSwitchContactAddress) - case .syncConnectionForceAlert: return syncConnectionForceAlert({ syncContactConnection(force: true) }) + case .syncConnectionForceAlert: + return syncConnectionForceAlert({ + Task { + if let stats = await syncContactConnection(contact, force: true, showAlert: { alert = .someAlert(alert: $0) }) { + connectionStats = stats + dismiss() + } + } + }) case let .queueInfo(info): return queueInfoAlert(info) case let .someAlert(a): return a.alert case let .error(title, error): return mkAlert(title: title, message: error) @@ -324,7 +332,7 @@ struct ChatInfoView: View { .sheet(item: $sheet) { if #available(iOS 16.0, *) { $0.content - .presentationDetents([.fraction(0.4)]) + .presentationDetents([.fraction($0.fraction)]) } else { $0.content } @@ -493,7 +501,12 @@ struct ChatInfoView: View { private func synchronizeConnectionButton() -> some View { Button { - syncContactConnection(force: false) + Task { + if let stats = await syncContactConnection(contact, force: false, showAlert: { alert = .someAlert(alert: $0) }) { + connectionStats = stats + dismiss() + } + } } label: { Label("Fix connection", systemImage: "exclamationmark.arrow.triangle.2.circlepath") .foregroundColor(.orange) @@ -612,25 +625,6 @@ struct ChatInfoView: View { } } - private func syncContactConnection(force: Bool) { - Task { - do { - let stats = try apiSyncContactRatchet(contact.apiId, force) - connectionStats = stats - await MainActor.run { - chatModel.updateContactConnectionStats(contact, stats) - dismiss() - } - } catch let error { - logger.error("syncContactConnection apiSyncContactRatchet error: \(responseError(error))") - let a = getErrorAlert(error, "Error synchronizing connection") - await MainActor.run { - alert = .error(title: a.title, error: a.message) - } - } - } - } - private func savePreferences() { Task { do { @@ -649,9 +643,32 @@ struct ChatInfoView: View { } } +func syncContactConnection(_ contact: Contact, force: Bool, showAlert: (SomeAlert) -> Void) async -> ConnectionStats? { + do { + let stats = try apiSyncContactRatchet(contact.apiId, force) + await MainActor.run { + ChatModel.shared.updateContactConnectionStats(contact, stats) + } + return stats + } catch let error { + logger.error("syncContactConnection apiSyncContactRatchet error: \(responseError(error))") + let a = getErrorAlert(error, "Error synchronizing connection") + await MainActor.run { + showAlert( + SomeAlert( + alert: mkAlert(title: a.title, message: a.message), + id: "syncContactConnection error" + ) + ) + } + return nil + } +} + struct AudioCallButton: View { var chat: Chat var contact: Contact + @Binding var connectionStats: ConnectionStats? var width: CGFloat var showAlert: (SomeAlert) -> Void @@ -659,6 +676,7 @@ struct AudioCallButton: View { CallButton( chat: chat, contact: contact, + connectionStats: $connectionStats, image: "phone.fill", title: "call", mediaType: .audio, @@ -671,6 +689,7 @@ struct AudioCallButton: View { struct VideoButton: View { var chat: Chat var contact: Contact + @Binding var connectionStats: ConnectionStats? var width: CGFloat var showAlert: (SomeAlert) -> Void @@ -678,6 +697,7 @@ struct VideoButton: View { CallButton( chat: chat, contact: contact, + connectionStats: $connectionStats, image: "video.fill", title: "video", mediaType: .video, @@ -690,6 +710,7 @@ struct VideoButton: View { private struct CallButton: View { var chat: Chat var contact: Contact + @Binding var connectionStats: ConnectionStats? var image: String var title: LocalizedStringKey var mediaType: CallMediaType @@ -701,12 +722,40 @@ private struct CallButton: View { InfoViewButton(image: image, title: title, disabledLook: !canCall, width: width) { if canCall { - if CallController.useCallKit() { - CallController.shared.startCall(contact, mediaType) - } else { - // When CallKit is not used, colorscheme will be changed and it will be visible if not hiding sheets first - dismissAllSheets(animated: true) { - CallController.shared.startCall(contact, mediaType) + if let connStats = connectionStats { + if connStats.ratchetSyncState == .ok { + if CallController.useCallKit() { + CallController.shared.startCall(contact, mediaType) + } else { + // When CallKit is not used, colorscheme will be changed and it will be visible if not hiding sheets first + dismissAllSheets(animated: true) { + CallController.shared.startCall(contact, mediaType) + } + } + } else if connStats.ratchetSyncAllowed { + showAlert(SomeAlert( + alert: Alert( + title: Text("Fix connection?"), + message: Text("Connection requires encryption renegotiation."), + primaryButton: .default(Text("Fix")) { + Task { + if let stats = await syncContactConnection(contact, force: false, showAlert: showAlert) { + connectionStats = stats + } + } + }, + secondaryButton: .cancel() + ), + id: "can't call contact, fix connection" + )) + } else { + showAlert(SomeAlert( + alert: mkAlert( + title: "Can't call contact", + message: "Encryption renegotiation in progress." + ), + id: "can't call contact, encryption renegotiation in progress" + )) } } } else if contact.nextSendGrpInv { diff --git a/apps/ios/Shared/Views/Chat/ChatView.swift b/apps/ios/Shared/Views/Chat/ChatView.swift index 0c5a458930..32b4fab291 100644 --- a/apps/ios/Shared/Views/Chat/ChatView.swift +++ b/apps/ios/Shared/Views/Chat/ChatView.swift @@ -440,6 +440,7 @@ struct ChatView: View { maxWidth: maxWidth, composeState: $composeState, selectedMember: $selectedMember, + showChatInfoSheet: $showChatInfoSheet, revealedChatItem: $revealedChatItem, selectedChatItems: $selectedChatItems, forwardedChatItems: $forwardedChatItems @@ -893,12 +894,14 @@ struct ChatView: View { private struct ChatItemWithMenu: View { @EnvironmentObject var m: ChatModel @EnvironmentObject var theme: AppTheme + @AppStorage(DEFAULT_PROFILE_IMAGE_CORNER_RADIUS) private var profileRadius = defaultProfileImageCorner @Binding @ObservedObject var chat: Chat @ObservedObject var dummyModel: ChatItemDummyModel = .shared let chatItem: ChatItem let maxWidth: CGFloat @Binding var composeState: ComposeState @Binding var selectedMember: GMember? + @Binding var showChatInfoSheet: Bool @Binding var revealedChatItem: ChatItem? @State private var deletingItem: ChatItem? = nil @@ -1255,16 +1258,22 @@ struct ChatView: View { setReaction(ci, add: !r.userReacted, reaction: r.reaction) } } - if case let .group(groupInfo) = chat.chatInfo { + switch chat.chatInfo { + case let .group(groupInfo): v.contextMenu { ReactionContextMenu( groupInfo: groupInfo, itemId: ci.id, reactionCount: r, - selectedMember: $selectedMember + selectedMember: $selectedMember, + profileRadius: profileRadius ) } - } else { + case let .direct(contact): + v.contextMenu { + contactReactionMenu(contact, r) + } + default: v } } @@ -1767,6 +1776,20 @@ struct ChatView: View { } } } + + @ViewBuilder private func contactReactionMenu(_ contact: Contact, _ r: CIReactionCount) -> some View { + if !r.userReacted || r.totalReacted > 1 { + Button { showChatInfoSheet = true } label: { + profileMenuItem(Text(contact.displayName), contact.image, radius: profileRadius) + } + } + if r.userReacted { + Button {} label: { + profileMenuItem(Text("you"), m.currentUser?.profile.image, radius: profileRadius) + } + .disabled(true) + } + } private struct SelectedChatItem: View { @EnvironmentObject var theme: AppTheme @@ -1859,13 +1882,12 @@ struct ReactionContextMenu: View { var itemId: Int64 var reactionCount: CIReactionCount @Binding var selectedMember: GMember? + var profileRadius: CGFloat @State private var memberReactions: [MemberReaction] = [] - @AppStorage(DEFAULT_PROFILE_IMAGE_CORNER_RADIUS) private var radius = defaultProfileImageCorner var body: some View { groupMemberReactionList() .task { - logger.debug("ReactionContextMenu task \(radius)") await loadChatItemReaction() } } @@ -1889,27 +1911,12 @@ struct ReactionContextMenu: View { selectedMember = member } } label: { - HStack { - Text(mem.displayName) - if let img = cropImage(mem.image) { - Image(uiImage: img) - } else { - Image(systemName: "person.crop.circle") - } - } + profileMenuItem(Text(mem.displayName), mem.image, radius: profileRadius) } .disabled(userMember) } } } - - private func cropImage(_ img: String?) -> UIImage? { - return if let originalImage = imageFromBase64(img) { - maskToCustomShape(originalImage, size: 30, radius: radius) - } else { - nil - } - } private func loadChatItemReaction() async { do { @@ -1927,6 +1934,17 @@ struct ReactionContextMenu: View { } } +func profileMenuItem(_ nameText: Text, _ image: String?, radius: CGFloat) -> some View { + HStack { + nameText + if let image, let img = imageFromBase64(image) { + Image(uiImage: maskToCustomShape(img, size: 30, radius: radius)) + } else { + Image(systemName: "person.crop.circle") + } + } +} + func maskToCustomShape(_ image: UIImage, size: CGFloat, radius: CGFloat) -> UIImage { let path = Path { path in if radius >= 50 { @@ -1989,6 +2007,9 @@ func updateChatSettings(_ chat: Chat, chatSettings: ChatSettings) { do { try await apiSetChatSettings(type: chat.chatInfo.chatType, id: chat.chatInfo.apiId, chatSettings: chatSettings) await MainActor.run { + let wasFavorite = chat.chatInfo.chatSettings?.favorite ?? false + ChatTagsModel.shared.updateChatFavorite(favorite: chatSettings.favorite, wasFavorite: wasFavorite) + let wasUnread = chat.unreadTag switch chat.chatInfo { case var .direct(contact): contact.chatSettings = chatSettings @@ -1998,6 +2019,7 @@ func updateChatSettings(_ chat: Chat, chatSettings: ChatSettings) { ChatModel.shared.updateGroup(groupInfo) default: () } + ChatTagsModel.shared.updateChatTagRead(chat, wasUnread: wasUnread) } } catch let error { logger.error("apiSetChatSettings error \(responseError(error))") diff --git a/apps/ios/Shared/Views/Chat/Group/GroupMemberInfoView.swift b/apps/ios/Shared/Views/Chat/Group/GroupMemberInfoView.swift index b73c5e10f5..30972f7242 100644 --- a/apps/ios/Shared/Views/Chat/Group/GroupMemberInfoView.swift +++ b/apps/ios/Shared/Views/Chat/Group/GroupMemberInfoView.swift @@ -20,6 +20,9 @@ struct GroupMemberInfoView: View { @State private var connectionStats: ConnectionStats? = nil @State private var connectionCode: String? = nil @State private var connectionLoaded: Bool = false + @State private var knownContactChat: Chat? = nil + @State private var knownContact: Contact? = nil + @State private var knownContactConnectionStats: ConnectionStats? = nil @State private var newRole: GroupMemberRole = .member @State private var alert: GroupMemberInfoViewAlert? @State private var sheet: PlanAndConnectActionSheet? @@ -119,8 +122,8 @@ struct GroupMemberInfoView: View { } label: { Label("Share address", systemImage: "square.and.arrow.up") } - if let contactId = member.memberContactId { - if knownDirectChat(contactId) == nil && !groupInfo.fullGroupPreferences.directMessages.on(for: groupInfo.membership) { + if member.memberContactId != nil { + if knownContactChat == nil && !groupInfo.fullGroupPreferences.directMessages.on(for: groupInfo.membership) { connectViaAddressButton(contactLink) } } else { @@ -159,7 +162,7 @@ struct GroupMemberInfoView: View { } .disabled( connStats.rcvQueuesInfo.contains { $0.rcvSwitchStatus != nil } - || connStats.ratchetSyncSendProhibited + || !member.sendMsgEnabled ) if connStats.rcvQueuesInfo.contains(where: { $0.rcvSwitchStatus != nil }) { Button("Abort changing address") { @@ -167,7 +170,7 @@ struct GroupMemberInfoView: View { } .disabled( connStats.rcvQueuesInfo.contains { $0.rcvSwitchStatus != nil && !$0.canAbortSwitch } - || connStats.ratchetSyncSendProhibited + || !member.sendMsgEnabled ) } smpServers("Receiving via", connStats.rcvQueuesInfo.map { $0.rcvServer }, theme.colors.secondary) @@ -229,6 +232,18 @@ struct GroupMemberInfoView: View { } logger.error("apiGroupMemberInfo or apiGetGroupMemberCode error: \(responseError(error))") } + if let contactId = member.memberContactId, let (contactChat, contact) = knownDirectChat(contactId) { + knownContactChat = contactChat + knownContact = contact + do { + let (stats, _) = try await apiContactInfo(contactChat.chatInfo.apiId) + await MainActor.run { + knownContactConnectionStats = stats + } + } catch let error { + logger.error("apiContactInfo error: \(responseError(error))") + } + } } .onChange(of: newRole) { newRole in if newRole != member.memberRole { @@ -274,15 +289,15 @@ struct GroupMemberInfoView: View { GeometryReader { g in let buttonWidth = g.size.width / 4 HStack(alignment: .center, spacing: 8) { - if let contactId = member.memberContactId, let (chat, contact) = knownDirectChat(contactId) { + if let chat = knownContactChat, let contact = knownContact { knownDirectChatButton(chat, width: buttonWidth) - AudioCallButton(chat: chat, contact: contact, width: buttonWidth) { alert = .someAlert(alert: $0) } - VideoButton(chat: chat, contact: contact, width: buttonWidth) { alert = .someAlert(alert: $0) } + AudioCallButton(chat: chat, contact: contact, connectionStats: $knownContactConnectionStats, width: buttonWidth) { alert = .someAlert(alert: $0) } + VideoButton(chat: chat, contact: contact, connectionStats: $knownContactConnectionStats, width: buttonWidth) { alert = .someAlert(alert: $0) } } else if groupInfo.fullGroupPreferences.directMessages.on(for: groupInfo.membership) { if let contactId = member.memberContactId { newDirectChatButton(contactId, width: buttonWidth) } else if member.activeConn?.peerChatVRange.isCompatibleRange(CREATE_MEMBER_CONTACT_VRANGE) ?? false { - createMemberContactButton(width: buttonWidth) + createMemberContactButton(member, width: buttonWidth) } InfoViewButton(image: "phone.fill", title: "call", disabledLook: true, width: buttonWidth) { showSendMessageToEnableCallsAlert() } @@ -364,28 +379,69 @@ struct GroupMemberInfoView: View { } } - func createMemberContactButton(width: CGFloat) -> some View { - InfoViewButton(image: "message.fill", title: "message", width: width) { - progressIndicator = true - Task { - do { - let memberContact = try await apiCreateMemberContact(groupInfo.apiId, groupMember.groupMemberId) - await MainActor.run { - progressIndicator = false - chatModel.addChat(Chat(chatInfo: .direct(contact: memberContact))) - ItemsModel.shared.loadOpenChat(memberContact.id) { - dismissAllSheets(animated: true) + func createMemberContactButton(_ member: GroupMember, width: CGFloat) -> some View { + InfoViewButton( + image: "message.fill", + title: "message", + disabledLook: + !( + member.sendMsgEnabled || + (member.activeConn?.connectionStats?.ratchetSyncAllowed ?? false) + ), + width: width + ) { + if member.sendMsgEnabled { + progressIndicator = true + Task { + do { + let memberContact = try await apiCreateMemberContact(groupInfo.apiId, groupMember.groupMemberId) + await MainActor.run { + progressIndicator = false + chatModel.addChat(Chat(chatInfo: .direct(contact: memberContact))) + ItemsModel.shared.loadOpenChat(memberContact.id) { + dismissAllSheets(animated: true) + } + NetworkModel.shared.setContactNetworkStatus(memberContact, .connected) + } + } catch let error { + logger.error("createMemberContactButton apiCreateMemberContact error: \(responseError(error))") + let a = getErrorAlert(error, "Error creating member contact") + await MainActor.run { + progressIndicator = false + alert = .error(title: a.title, error: a.message) } - NetworkModel.shared.setContactNetworkStatus(memberContact, .connected) - } - } catch let error { - logger.error("createMemberContactButton apiCreateMemberContact error: \(responseError(error))") - let a = getErrorAlert(error, "Error creating member contact") - await MainActor.run { - progressIndicator = false - alert = .error(title: a.title, error: a.message) } } + } else if let connStats = connectionStats { + if connStats.ratchetSyncAllowed { + alert = .someAlert(alert: SomeAlert( + alert: Alert( + title: Text("Fix connection?"), + message: Text("Connection requires encryption renegotiation."), + primaryButton: .default(Text("Fix")) { + syncMemberConnection(force: false) + }, + secondaryButton: .cancel() + ), + id: "can't message member, fix connection" + )) + } else if connStats.ratchetSyncInProgress { + alert = .someAlert(alert: SomeAlert( + alert: mkAlert( + title: "Can't message member", + message: "Encryption renegotiation in progress." + ), + id: "can't message member, encryption renegotiation in progress" + )) + } else { + alert = .someAlert(alert: SomeAlert( + alert: mkAlert( + title: "Can't message member", + message: "Connection not ready." + ), + id: "can't message member, connection not ready" + )) + } } } } diff --git a/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift b/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift index 6c5dad1f74..36a98e3f2f 100644 --- a/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift +++ b/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift @@ -8,6 +8,7 @@ import SwiftUI import SimpleXChat +import ElegantEmojiPicker typealias DynamicSizes = ( rowHeight: CGFloat, @@ -43,9 +44,11 @@ func dynamicSize(_ font: DynamicTypeSize) -> DynamicSizes { struct ChatListNavLink: View { @EnvironmentObject var chatModel: ChatModel @EnvironmentObject var theme: AppTheme + @EnvironmentObject var chatTagsModel: ChatTagsModel @Environment(\.dynamicTypeSize) private var userFont: DynamicTypeSize @AppStorage(GROUP_DEFAULT_ONE_HAND_UI, store: groupDefaults) private var oneHandUI = false @ObservedObject var chat: Chat + @Binding var parentSheet: SomeSheet? @State private var showContactRequestDialog = false @State private var showJoinGroupDialog = false @State private var showContactConnectionInfo = false @@ -85,6 +88,7 @@ struct ChatListNavLink: View { progressByTimeout = false } } + .actionSheet(item: $actionSheet) { $0.actionSheet } } @ViewBuilder private func contactNavLink(_ contact: Contact) -> some View { @@ -124,6 +128,7 @@ struct ChatListNavLink: View { toggleNtfsButton(chat: chat) } .swipeActions(edge: .trailing, allowsFullSwipe: true) { + tagChatButton(chat) if !chat.chatItems.isEmpty { clearChatButton() } @@ -145,11 +150,10 @@ struct ChatListNavLink: View { } } .alert(item: $alert) { $0.alert } - .actionSheet(item: $actionSheet) { $0.actionSheet } .sheet(item: $sheet) { if #available(iOS 16.0, *) { $0.content - .presentationDetents([.fraction(0.4)]) + .presentationDetents([.fraction($0.fraction)]) } else { $0.content } @@ -185,6 +189,7 @@ struct ChatListNavLink: View { AlertManager.shared.showAlert(groupInvitationAcceptedAlert()) } .swipeActions(edge: .trailing) { + tagChatButton(chat) if (groupInfo.membership.memberCurrent) { leaveGroupChatButton(groupInfo) } @@ -206,14 +211,25 @@ struct ChatListNavLink: View { toggleNtfsButton(chat: chat) } .swipeActions(edge: .trailing, allowsFullSwipe: true) { - if !chat.chatItems.isEmpty { + tagChatButton(chat) + let showClearButton = !chat.chatItems.isEmpty + let showDeleteGroup = groupInfo.canDelete + let showLeaveGroup = groupInfo.membership.memberCurrent + let totalNumberOfButtons = 1 + (showClearButton ? 1 : 0) + (showDeleteGroup ? 1 : 0) + (showLeaveGroup ? 1 : 0) + + if showClearButton, totalNumberOfButtons <= 3 { clearChatButton() } - if (groupInfo.membership.memberCurrent) { + if (showLeaveGroup) { leaveGroupChatButton(groupInfo) } - if groupInfo.canDelete { - deleteGroupChatButton(groupInfo) + + if showDeleteGroup { + if totalNumberOfButtons <= 3 { + deleteGroupChatButton(groupInfo) + } else { + moreOptionsButton(chat, groupInfo) + } } } } @@ -306,7 +322,67 @@ struct ChatListNavLink: View { } .tint(Color.orange) } - + + private func tagChatButton(_ chat: Chat) -> some View { + Button { + setTagChatSheet(chat) + } label: { + SwipeLabel(NSLocalizedString("List", comment: "swipe action"), systemImage: "tag.fill", inverted: oneHandUI) + } + .tint(.mint) + } + + private func setTagChatSheet(_ chat: Chat) { + let screenHeight = UIScreen.main.bounds.height + let reservedSpace: Double = 4 * 44 // 2 for padding, 1 for "Create list" and another for extra tag + let tagsSpace = Double(max(chatTagsModel.userTags.count, 3)) * 44 + let fraction = min((reservedSpace + tagsSpace) / screenHeight, 0.62) + + parentSheet = SomeSheet( + content: { + AnyView( + NavigationView { + if chatTagsModel.userTags.isEmpty { + ChatListTagEditor(chat: chat) + } else { + ChatListTag(chat: chat) + } + } + ) + }, + id: "lists sheet", + fraction: fraction + ) + } + + private func moreOptionsButton(_ chat: Chat, _ groupInfo: GroupInfo?) -> some View { + Button { + var buttons: [Alert.Button] = [ + .default(Text("Clear")) { + AlertManager.shared.showAlert(clearChatAlert()) + } + ] + + if let gi = groupInfo, gi.canDelete { + buttons.append(.destructive(Text("Delete")) { + AlertManager.shared.showAlert(deleteGroupAlert(gi)) + }) + } + + buttons.append(.cancel()) + + actionSheet = SomeActionSheet( + actionSheet: ActionSheet( + title: Text("Clear or delete group?"), + buttons: buttons + ), + id: "other options" + ) + } label: { + SwipeLabel(NSLocalizedString("More", comment: "swipe action"), systemImage: "ellipsis", inverted: oneHandUI) + } + } + private func clearNoteFolderButton() -> some View { Button { AlertManager.shared.showAlert(clearNoteFolderAlert()) @@ -484,6 +560,405 @@ struct ChatListNavLink: View { } } +struct TagEditorNavParams { + let chat: Chat? + let chatListTag: ChatTagData? + let tagId: Int64? +} + +struct ChatListTag: View { + var chat: Chat? = nil + @Environment(\.dismiss) var dismiss: DismissAction + @EnvironmentObject var theme: AppTheme + @EnvironmentObject var chatTagsModel: ChatTagsModel + @EnvironmentObject var m: ChatModel + @State private var editMode = EditMode.inactive + @State private var tagEditorNavParams: TagEditorNavParams? = nil + + var chatTagsIds: [Int64] { chat?.chatInfo.contact?.chatTags ?? chat?.chatInfo.groupInfo?.chatTags ?? [] } + + var body: some View { + List { + Section { + ForEach(chatTagsModel.userTags, id: \.id) { tag in + let text = tag.chatTagText + let emoji = tag.chatTagEmoji + let tagId = tag.chatTagId + let selected = chatTagsIds.contains(tagId) + + HStack { + if let emoji { + Text(emoji) + } else { + Image(systemName: "tag") + } + Text(text) + .padding(.leading, 12) + Spacer() + if chat != nil { + radioButton(selected: selected) + } + } + .contentShape(Rectangle()) + .onTapGesture { + if let c = chat { + setChatTag(tagId: selected ? nil : tagId, chat: c) { dismiss() } + } else { + tagEditorNavParams = TagEditorNavParams(chat: nil, chatListTag: ChatTagData(emoji: emoji, text: text), tagId: tagId) + } + } + .swipeActions(edge: .trailing, allowsFullSwipe: true) { + Button { + showAlert( + NSLocalizedString("Delete list?", comment: "alert title"), + message: NSLocalizedString("All chats will be removed from the list \(text), and the list deleted.", comment: "alert message"), + actions: {[ + UIAlertAction( + title: NSLocalizedString("Cancel", comment: "alert action"), + style: .default + ), + UIAlertAction( + title: NSLocalizedString("Delete", comment: "alert action"), + style: .destructive, + handler: { _ in + deleteTag(tagId) + } + ) + ]} + ) + } label: { + Label("Delete", systemImage: "trash.fill") + } + .tint(.red) + } + .swipeActions(edge: .leading, allowsFullSwipe: true) { + Button { + tagEditorNavParams = TagEditorNavParams(chat: nil, chatListTag: ChatTagData(emoji: emoji, text: text), tagId: tagId) + } label: { + Label("Edit", systemImage: "pencil") + } + .tint(theme.colors.primary) + } + .background( + // isActive required to navigate to edit view from any possible tag edited in swipe action + NavigationLink(isActive: Binding(get: { tagEditorNavParams != nil }, set: { _ in tagEditorNavParams = nil })) { + if let params = tagEditorNavParams { + ChatListTagEditor( + chat: params.chat, + tagId: params.tagId, + emoji: params.chatListTag?.emoji, + name: params.chatListTag?.text ?? "" + ) + } + } label: { + EmptyView() + } + .opacity(0) + ) + } + .onMove(perform: moveItem) + + NavigationLink { + ChatListTagEditor(chat: chat) + } label: { + Label("Create list", systemImage: "plus") + } + } header: { + if chat == nil { + editTagsButton() + .textCase(nil) + .frame(maxWidth: .infinity, alignment: .trailing) + } + } + } + .modifier(ThemedBackground(grouped: true)) + .environment(\.editMode, $editMode) + } + + private func editTagsButton() -> some View { + if editMode.isEditing { + Button("Done") { + editMode = .inactive + dismiss() + } + } else { + Button("Edit") { + editMode = .active + } + } + } + + @ViewBuilder private func radioButton(selected: Bool) -> some View { + Image(systemName: selected ? "checkmark.circle.fill" : "circle") + .imageScale(.large) + .foregroundStyle(selected ? Color.accentColor : Color(.tertiaryLabel)) + } + + private func moveItem(from source: IndexSet, to destination: Int) { + Task { + do { + var tags = chatTagsModel.userTags + tags.move(fromOffsets: source, toOffset: destination) + try await apiReorderChatTags(tagIds: tags.map { $0.chatTagId }) + + await MainActor.run { + chatTagsModel.userTags = tags + } + } catch let error { + showAlert( + NSLocalizedString("Error reordering lists", comment: "alert title"), + message: responseError(error) + ) + } + } + } + + private func deleteTag(_ tagId: Int64) { + Task { + try await apiDeleteChatTag(tagId: tagId) + + await MainActor.run { + chatTagsModel.userTags = chatTagsModel.userTags.filter { $0.chatTagId != tagId } + if case let .userTag(tag) = chatTagsModel.activeFilter, tagId == tag.chatTagId { + chatTagsModel.activeFilter = nil + } + m.chats.forEach { c in + if var contact = c.chatInfo.contact, contact.chatTags.contains(tagId) { + contact.chatTags = contact.chatTags.filter({ $0 != tagId }) + m.updateContact(contact) + } else if var group = c.chatInfo.groupInfo, group.chatTags.contains(tagId) { + group.chatTags = group.chatTags.filter({ $0 != tagId }) + m.updateGroup(group) + } + } + } + } + } +} + +private func setChatTag(tagId: Int64?, chat: Chat, closeSheet: @escaping () -> Void) { + Task { + do { + let tagIds: [Int64] = if let t = tagId { [t] } else {[]} + let (userTags, chatTags) = try await apiSetChatTags( + type: chat.chatInfo.chatType, + id: chat.chatInfo.apiId, + tagIds: tagIds + ) + + await MainActor.run { + let m = ChatModel.shared + let tm = ChatTagsModel.shared + tm.userTags = userTags + if chat.unreadTag, let tags = chat.chatInfo.chatTags { + tm.decTagsReadCount(tags) + } + if var contact = chat.chatInfo.contact { + contact.chatTags = chatTags + m.updateContact(contact) + } else if var group = chat.chatInfo.groupInfo { + group.chatTags = chatTags + m.updateGroup(group) + } + ChatTagsModel.shared.updateChatTagRead(chat, wasUnread: false) + closeSheet() + } + } catch let error { + showAlert( + NSLocalizedString("Error saving chat list", comment: "alert title"), + message: responseError(error) + ) + } + } +} + +struct EmojiPickerView: UIViewControllerRepresentable { + @Binding var selectedEmoji: String? + @Binding var showingPicker: Bool + @Environment(\.presentationMode) var presentationMode + + class Coordinator: NSObject, ElegantEmojiPickerDelegate, UIAdaptivePresentationControllerDelegate { + var parent: EmojiPickerView + + init(parent: EmojiPickerView) { + self.parent = parent + } + + func emojiPicker(_ picker: ElegantEmojiPicker, didSelectEmoji emoji: Emoji?) { + parent.selectedEmoji = emoji?.emoji + parent.showingPicker = false + picker.dismiss(animated: true) + } + + // Called when the picker is dismissed manually (without selection) + func presentationControllerWillDismiss(_ presentationController: UIPresentationController) { + parent.showingPicker = false + } + } + + func makeCoordinator() -> Coordinator { + return Coordinator(parent: self) + } + + func makeUIViewController(context: Context) -> UIViewController { + let config = ElegantConfiguration(showRandom: false, showReset: true, showClose: false) + let picker = ElegantEmojiPicker(delegate: context.coordinator, configuration: config) + + picker.presentationController?.delegate = context.coordinator + + let viewController = UIViewController() + DispatchQueue.main.async { + if let topVC = getTopViewController() { + topVC.present(picker, animated: true) + } + } + + return viewController + } + + func updateUIViewController(_ uiViewController: UIViewController, context: Context) { + // No need to update the controller after creation + } +} + +struct ChatListTagEditor: View { + @Environment(\.dismiss) var dismiss: DismissAction + @EnvironmentObject var chatTagsModel: ChatTagsModel + @EnvironmentObject var theme: AppTheme + var chat: Chat? = nil + var tagId: Int64? = nil + var emoji: String? + var name: String = "" + @State private var newEmoji: String? + @State private var newName: String = "" + @State private var isPickerPresented = false + @State private var saving: Bool? + + var body: some View { + VStack { + List { + let isDuplicateEmojiOrName = chatTagsModel.userTags.contains { tag in + tag.chatTagId != tagId && + ((newEmoji != nil && tag.chatTagEmoji == newEmoji) || tag.chatTagText == trimmedName) + } + + Section { + HStack { + Button { + isPickerPresented = true + } label: { + if let newEmoji { + Text(newEmoji) + } else { + Image(systemName: "face.smiling") + .foregroundColor(.secondary) + } + } + TextField("List name...", text: $newName) + } + + Button { + saving = true + if let tId = tagId { + updateChatTag(tagId: tId, chatTagData: ChatTagData(emoji: newEmoji, text: trimmedName)) + } else { + createChatTag() + } + } label: { + Text( + chat != nil + ? "Add to list" + : tagId == nil + ? "Create list" + : "Save list" + ) + } + .disabled(saving != nil || (trimmedName == name && newEmoji == emoji) || trimmedName.isEmpty || isDuplicateEmojiOrName) + } footer: { + if isDuplicateEmojiOrName && saving != false { // if not saved already, to prevent flickering + HStack { + Image(systemName: "exclamationmark.circle") + .foregroundColor(.red) + Text("List name and emoji should be different for all lists.") + .foregroundColor(theme.colors.secondary) + } + } + } + } + + if isPickerPresented { + EmojiPickerView(selectedEmoji: $newEmoji, showingPicker: $isPickerPresented) + } + } + .modifier(ThemedBackground(grouped: true)) + .onAppear { + newEmoji = emoji + newName = name + } + } + + var trimmedName: String { + newName.trimmingCharacters(in: .whitespaces) + } + + private func createChatTag() { + Task { + do { + let text = trimmedName + let userTags = try await apiCreateChatTag( + tag: ChatTagData(emoji: newEmoji , text: text) + ) + await MainActor.run { + saving = false + chatTagsModel.userTags = userTags + } + if let chat, let tag = userTags.first(where: { $0.chatTagText == text && $0.chatTagEmoji == newEmoji}) { + setChatTag(tagId: tag.chatTagId, chat: chat) { dismiss() } + } else { + await MainActor.run { dismiss() } + } + } catch let error { + await MainActor.run { + saving = nil + showAlert( + NSLocalizedString("Error creating list", comment: "alert title"), + message: responseError(error) + ) + } + } + } + } + + private func updateChatTag(tagId: Int64, chatTagData: ChatTagData) { + Task { + do { + try await apiUpdateChatTag(tagId: tagId, tag: chatTagData) + await MainActor.run { + saving = false + for i in 0.. Alert { Alert( title: Text("Reject contact request"), @@ -585,15 +1060,15 @@ struct ChatListNavLink_Previews: PreviewProvider { ChatListNavLink(chat: Chat( chatInfo: ChatInfo.sampleData.direct, chatItems: [ChatItem.getSample(1, .directSnd, .now, "hello")] - )) + ), parentSheet: .constant(nil)) ChatListNavLink(chat: Chat( chatInfo: ChatInfo.sampleData.direct, chatItems: [ChatItem.getSample(1, .directSnd, .now, "hello")] - )) + ), parentSheet: .constant(nil)) ChatListNavLink(chat: Chat( chatInfo: ChatInfo.sampleData.contactRequest, chatItems: [] - )) + ), parentSheet: .constant(nil)) } .previewLayout(.fixed(width: 360, height: 82)) } diff --git a/apps/ios/Shared/Views/ChatList/ChatListView.swift b/apps/ios/Shared/Views/ChatList/ChatListView.swift index b18e9295b9..edf9a3e5d2 100644 --- a/apps/ios/Shared/Views/ChatList/ChatListView.swift +++ b/apps/ios/Shared/Views/ChatList/ChatListView.swift @@ -31,6 +31,29 @@ enum UserPickerSheet: Identifiable { } } +enum PresetTag: Int, Identifiable, CaseIterable, Equatable { + case favorites = 0 + case contacts = 1 + case groups = 2 + case business = 3 + + var id: Int { rawValue } +} + +enum ActiveFilter: Identifiable, Equatable { + case presetTag(PresetTag) + case userTag(ChatTag) + case unread + + var id: String { + switch self { + case let .presetTag(tag): "preset \(tag.id)" + case let .userTag(tag): "user \(tag.chatTagId)" + case .unread: "unread" + } + } +} + class SaveableSettings: ObservableObject { @Published var servers: ServerSettings = ServerSettings(currUserServers: [], userServers: [], serverErrors: []) } @@ -117,13 +140,14 @@ struct ChatListView: View { @State private var searchChatFilteredBySimplexLink: String? = nil @State private var scrollToSearchBar = false @State private var userPickerShown: Bool = false - - @AppStorage(DEFAULT_SHOW_UNREAD_AND_FAVORITES) private var showUnreadAndFavorites = false + @State private var sheet: SomeSheet? = nil + @StateObject private var chatTagsModel = ChatTagsModel.shared + @AppStorage(GROUP_DEFAULT_ONE_HAND_UI, store: groupDefaults) private var oneHandUI = true @AppStorage(DEFAULT_ONE_HAND_UI_CARD_SHOWN) private var oneHandUICardShown = false @AppStorage(DEFAULT_ADDRESS_CREATION_CARD_SHOWN) private var addressCreationCardShown = false @AppStorage(DEFAULT_TOOLBAR_MATERIAL) private var toolbarMaterial = ToolbarMaterial.defaultMaterial - + var body: some View { if #available(iOS 16.0, *) { viewBody.scrollDismissesKeyboard(.immediately) @@ -131,7 +155,7 @@ struct ChatListView: View { viewBody } } - + private var viewBody: some View { ZStack(alignment: oneHandUI ? .bottomLeading : .topLeading) { NavStackCompat( @@ -161,8 +185,9 @@ struct ChatListView: View { } } } + .environmentObject(chatTagsModel) } - + private var chatListView: some View { let tm = ToolbarMaterial.material(toolbarMaterial) return withToolbar(tm) { @@ -197,15 +222,22 @@ struct ChatListView: View { Divider().padding(.bottom, Self.hasHomeIndicator ? 0 : 8).background(tm) } } + .sheet(item: $sheet) { sheet in + if #available(iOS 16.0, *) { + sheet.content.presentationDetents([.fraction(sheet.fraction)]) + } else { + sheet.content + } + } } - + static var hasHomeIndicator: Bool = { if let windowScene = UIApplication.shared.connectedScenes.first as? UIWindowScene, let window = windowScene.windows.first { window.safeAreaInsets.bottom > 0 } else { false } }() - + @ViewBuilder func withToolbar(_ material: Material, content: () -> some View) -> some View { if #available(iOS 16.0, *) { if oneHandUI { @@ -226,13 +258,13 @@ struct ChatListView: View { } } } - + @ToolbarContentBuilder var topToolbar: some ToolbarContent { ToolbarItem(placement: .topBarLeading) { leadingToolbarItem } ToolbarItem(placement: .principal) { SubsStatusIndicator() } ToolbarItem(placement: .topBarTrailing) { trailingToolbarItem } } - + @ToolbarContentBuilder var bottomToolbar: some ToolbarContent { let padding: Double = Self.hasHomeIndicator ? 0 : 14 ToolbarItem(placement: .bottomBar) { @@ -247,7 +279,7 @@ struct ChatListView: View { .onTapGesture { scrollToSearchBar = true } } } - + @ToolbarContentBuilder var bottomToolbarGroup: some ToolbarContent { let padding: Double = Self.hasHomeIndicator ? 0 : 14 ToolbarItemGroup(placement: .bottomBar) { @@ -258,7 +290,7 @@ struct ChatListView: View { trailingToolbarItem.padding(.bottom, padding) } } - + @ViewBuilder var leadingToolbarItem: some View { let user = chatModel.currentUser ?? User.sampleData ZStack(alignment: .topTrailing) { @@ -275,7 +307,7 @@ struct ChatListView: View { userPickerShown = true } } - + @ViewBuilder var trailingToolbarItem: some View { switch chatModel.chatRunning { case .some(true): NewChatMenuButton() @@ -283,7 +315,7 @@ struct ChatListView: View { case .none: EmptyView() } } - + @ViewBuilder private var chatList: some View { let cs = filteredChats() ZStack { @@ -295,7 +327,8 @@ struct ChatListView: View { searchFocussed: $searchFocussed, searchText: $searchText, searchShowingSimplexLink: $searchShowingSimplexLink, - searchChatFilteredBySimplexLink: $searchChatFilteredBySimplexLink + searchChatFilteredBySimplexLink: $searchChatFilteredBySimplexLink, + parentSheet: $sheet ) .scaleEffect(x: 1, y: oneHandUI ? -1 : 1, anchor: .center) .listRowSeparator(.hidden) @@ -306,7 +339,7 @@ struct ChatListView: View { } if #available(iOS 16.0, *) { ForEach(cs, id: \.viewId) { chat in - ChatListNavLink(chat: chat) + ChatListNavLink(chat: chat, parentSheet: $sheet) .scaleEffect(x: 1, y: oneHandUI ? -1 : 1, anchor: .center) .padding(.trailing, -16) .disabled(chatModel.chatRunning != true || chatModel.deletedChats.contains(chat.chatInfo.id)) @@ -318,7 +351,7 @@ struct ChatListView: View { VStack(spacing: .zero) { Divider() .padding(.leading, 16) - ChatListNavLink(chat: chat) + ChatListNavLink(chat: chat, parentSheet: $sheet) .padding(.horizontal, 8) .padding(.vertical, 6) } @@ -363,80 +396,97 @@ struct ChatListView: View { } } if cs.isEmpty && !chatModel.chats.isEmpty { - Text("No filtered chats") + noChatsView() .scaleEffect(x: 1, y: oneHandUI ? -1 : 1, anchor: .center) .foregroundColor(.secondary) } } } + + @ViewBuilder private func noChatsView() -> some View { + if searchString().isEmpty { + switch chatTagsModel.activeFilter { + case .presetTag: Text("No filtered chats") // this should not happen + case let .userTag(tag): Text("No chats in list \(tag.chatTagText)") + case .unread: + Button { + chatTagsModel.activeFilter = nil + } label: { + HStack { + Image(systemName: "line.3.horizontal.decrease") + Text("No unread chats") + } + } + case .none: Text("No chats") + } + } else { + Text("No chats found") + } + } + private func unreadBadge(size: CGFloat = 18) -> some View { Circle() .frame(width: size, height: size) .foregroundColor(theme.colors.primary) } - + @ViewBuilder private func chatView() -> some View { if let chatId = chatModel.chatId, let chat = chatModel.getChat(chatId) { ChatView(chat: chat) } } - + func stopAudioPlayer() { VoiceItemState.smallView.values.forEach { $0.audioPlayer?.stop() } VoiceItemState.smallView = [:] } - + private func filteredChats() -> [Chat] { if let linkChatId = searchChatFilteredBySimplexLink { return chatModel.chats.filter { $0.id == linkChatId } } else { let s = searchString() - return s == "" && !showUnreadAndFavorites + return s == "" ? chatModel.chats.filter { chat in - !chat.chatInfo.chatDeleted && chatContactType(chat: chat) != ContactType.card + !chat.chatInfo.chatDeleted && !chat.chatInfo.contactCard && filtered(chat) } : chatModel.chats.filter { chat in let cInfo = chat.chatInfo - switch cInfo { + return switch cInfo { case let .direct(contact): - return !contact.chatDeleted && chatContactType(chat: chat) != ContactType.card && ( - s == "" - ? filtered(chat) - : (viewNameContains(cInfo, s) || - contact.profile.displayName.localizedLowercase.contains(s) || - contact.fullName.localizedLowercase.contains(s)) + !contact.chatDeleted && !chat.chatInfo.contactCard && ( + ( viewNameContains(cInfo, s) || + contact.profile.displayName.localizedLowercase.contains(s) || + contact.fullName.localizedLowercase.contains(s) + ) ) - case let .group(gInfo): - return s == "" - ? (filtered(chat) || gInfo.membership.memberStatus == .memInvited) - : viewNameContains(cInfo, s) - case .local: - return s == "" || viewNameContains(cInfo, s) - case .contactRequest: - return s == "" || viewNameContains(cInfo, s) - case let .contactConnection(conn): - return s != "" && conn.localAlias.localizedLowercase.contains(s) - case .invalidJSON: - return false + case .group: viewNameContains(cInfo, s) + case .local: viewNameContains(cInfo, s) + case .contactRequest: viewNameContains(cInfo, s) + case let .contactConnection(conn): conn.localAlias.localizedLowercase.contains(s) + case .invalidJSON: false } } } - - func searchString() -> String { - searchShowingSimplexLink ? "" : searchText.trimmingCharacters(in: .whitespaces).localizedLowercase - } - + func filtered(_ chat: Chat) -> Bool { - (chat.chatInfo.chatSettings?.favorite ?? false) || - chat.chatStats.unreadChat || - (chat.chatInfo.ntfsEnabled && chat.chatStats.unreadCount > 0) + switch chatTagsModel.activeFilter { + case let .presetTag(tag): presetTagMatchesChat(tag, chat.chatInfo) + case let .userTag(tag): chat.chatInfo.chatTags?.contains(tag.chatTagId) == true + case .unread: chat.chatStats.unreadChat || chat.chatInfo.ntfsEnabled && chat.chatStats.unreadCount > 0 + case .none: true + } } - + func viewNameContains(_ cInfo: ChatInfo, _ s: String) -> Bool { cInfo.chatViewName.localizedLowercase.contains(s) } } + + func searchString() -> String { + searchShowingSimplexLink ? "" : searchText.trimmingCharacters(in: .whitespaces).localizedLowercase + } } struct SubsStatusIndicator: View { @@ -500,18 +550,20 @@ struct SubsStatusIndicator: View { struct ChatListSearchBar: View { @EnvironmentObject var m: ChatModel @EnvironmentObject var theme: AppTheme + @EnvironmentObject var chatTagsModel: ChatTagsModel @Binding var searchMode: Bool @FocusState.Binding var searchFocussed: Bool @Binding var searchText: String @Binding var searchShowingSimplexLink: Bool @Binding var searchChatFilteredBySimplexLink: String? + @Binding var parentSheet: SomeSheet? @State private var ignoreSearchTextChange = false @State private var alert: PlanAndConnectAlert? @State private var sheet: PlanAndConnectActionSheet? - @AppStorage(DEFAULT_SHOW_UNREAD_AND_FAVORITES) private var showUnreadAndFavorites = false var body: some View { VStack(spacing: 12) { + ScrollView([.horizontal], showsIndicators: false) { ChatTagsView(parentSheet: $parentSheet) } HStack(spacing: 12) { HStack(spacing: 4) { Image(systemName: "magnifyingglass") @@ -578,16 +630,21 @@ struct ChatListSearchBar: View { } private func toggleFilterButton() -> some View { - ZStack { + let showUnread = chatTagsModel.activeFilter == .unread + return ZStack { Color.clear .frame(width: 22, height: 22) - Image(systemName: showUnreadAndFavorites ? "line.3.horizontal.decrease.circle.fill" : "line.3.horizontal.decrease") + Image(systemName: showUnread ? "line.3.horizontal.decrease.circle.fill" : "line.3.horizontal.decrease") .resizable() .scaledToFit() - .foregroundColor(showUnreadAndFavorites ? theme.colors.primary : theme.colors.secondary) - .frame(width: showUnreadAndFavorites ? 22 : 16, height: showUnreadAndFavorites ? 22 : 16) + .foregroundColor(showUnread ? theme.colors.primary : theme.colors.secondary) + .frame(width: showUnread ? 22 : 16, height: showUnread ? 22 : 16) .onTapGesture { - showUnreadAndFavorites = !showUnreadAndFavorites + if chatTagsModel.activeFilter == .unread { + chatTagsModel.activeFilter = nil + } else { + chatTagsModel.activeFilter = .unread + } } } } @@ -605,6 +662,185 @@ struct ChatListSearchBar: View { } } +struct ChatTagsView: View { + @EnvironmentObject var chatTagsModel: ChatTagsModel + @EnvironmentObject var chatModel: ChatModel + @EnvironmentObject var theme: AppTheme + @Binding var parentSheet: SomeSheet? + + var body: some View { + HStack { + tagsView() + } + } + + @ViewBuilder private func tagsView() -> some View { + if chatTagsModel.presetTags.count > 1 { + if chatTagsModel.presetTags.count + chatTagsModel.userTags.count <= 3 { + expandedPresetTagsFiltersView() + } else { + collapsedTagsFilterView() + } + } + let selectedTag: ChatTag? = if case let .userTag(tag) = chatTagsModel.activeFilter { + tag + } else { + nil + } + ForEach(chatTagsModel.userTags, id: \.id) { tag in + let current = tag == selectedTag + let color: Color = current ? .accentColor : .secondary + ZStack { + HStack(spacing: 4) { + if let emoji = tag.chatTagEmoji { + Text(emoji) + } else { + Image(systemName: current ? "tag.fill" : "tag") + .foregroundColor(color) + } + ZStack { + let badge = Text(verbatim: (chatTagsModel.unreadTags[tag.chatTagId] ?? 0) > 0 ? " ●" : "").font(.footnote) + (Text(tag.chatTagText).fontWeight(.semibold) + badge).foregroundColor(.clear) + Text(tag.chatTagText).fontWeight(current ? .semibold : .regular).foregroundColor(color) + badge.foregroundColor(theme.colors.primary) + } + } + .onTapGesture { + setActiveFilter(filter: .userTag(tag)) + } + .onLongPressGesture { + let screenHeight = UIScreen.main.bounds.height + let reservedSpace: Double = 4 * 44 // 2 for padding, 1 for "Create list" and another for extra tag + let tagsSpace = Double(max(chatTagsModel.userTags.count, 3)) * 44 + let fraction = min((reservedSpace + tagsSpace) / screenHeight, 0.62) + + parentSheet = SomeSheet( + content: { + AnyView( + NavigationView { + ChatListTag(chat: nil) + .modifier(ThemedBackground(grouped: true)) + } + ) + }, + id: "tag list", + fraction: fraction + ) + } + } + } + + Button { + parentSheet = SomeSheet( + content: { + AnyView( + NavigationView { + ChatListTagEditor() + } + ) + }, + id: "tag create" + ) + } label: { + if chatTagsModel.userTags.isEmpty { + HStack(spacing: 4) { + Image(systemName: "plus") + Text("Add list") + } + } else { + Image(systemName: "plus") + } + } + .foregroundColor(.secondary) + } + + @ViewBuilder private func expandedPresetTagsFiltersView() -> some View { + let selectedPresetTag: PresetTag? = if case let .presetTag(tag) = chatTagsModel.activeFilter { + tag + } else { + nil + } + ForEach(PresetTag.allCases, id: \.id) { tag in + if (chatTagsModel.presetTags[tag] ?? 0) > 0 { + let active = tag == selectedPresetTag + let (icon, text) = presetTagLabel(tag: tag, active: active) + let color: Color = active ? .accentColor : .secondary + + HStack(spacing: 4) { + Image(systemName: icon) + .foregroundColor(color) + ZStack { + Text(text).fontWeight(.semibold).foregroundColor(.clear) + Text(text).fontWeight(active ? .semibold : .regular).foregroundColor(color) + } + } + .onTapGesture { + setActiveFilter(filter: .presetTag(tag)) + } + } + } + } + + @ViewBuilder private func collapsedTagsFilterView() -> some View { + let selectedPresetTag: PresetTag? = if case let .presetTag(tag) = chatTagsModel.activeFilter { + tag + } else { + nil + } + Menu { + if selectedPresetTag != nil { + Button { + chatTagsModel.activeFilter = nil + } label: { + HStack { + Image(systemName: "list.bullet") + Text("All") + } + } + } + ForEach(PresetTag.allCases, id: \.id) { tag in + if (chatTagsModel.presetTags[tag] ?? 0) > 0 { + Button { + setActiveFilter(filter: .presetTag(tag)) + } label: { + let (systemName, text) = presetTagLabel(tag: tag, active: tag == selectedPresetTag) + HStack { + Image(systemName: systemName) + Text(text) + } + } + } + } + } label: { + if let tag = selectedPresetTag { + let (systemName, _) = presetTagLabel(tag: tag, active: true) + Image(systemName: systemName) + .foregroundColor(.accentColor) + } else { + Image(systemName: "list.bullet") + .foregroundColor(.secondary) + } + } + .frame(minWidth: 28) + } + + private func presetTagLabel(tag: PresetTag, active: Bool) -> (String, LocalizedStringKey) { + switch tag { + case .favorites: (active ? "star.fill" : "star", "Favorites") + case .contacts: (active ? "person.fill" : "person", "Contacts") + case .groups: (active ? "person.2.fill" : "person.2", "Groups") + case .business: (active ? "briefcase.fill" : "briefcase", "Businesses") + } + } + + private func setActiveFilter(filter: ActiveFilter) { + if filter != chatTagsModel.activeFilter { + chatTagsModel.activeFilter = filter + } else { + chatTagsModel.activeFilter = nil + } + } +} + func chatStoppedIcon() -> some View { Button { AlertManager.shared.showAlertMsg( @@ -616,6 +852,28 @@ func chatStoppedIcon() -> some View { } } +func presetTagMatchesChat(_ tag: PresetTag, _ chatInfo: ChatInfo) -> Bool { + switch tag { + case .favorites: + chatInfo.chatSettings?.favorite == true + case .contacts: + switch chatInfo { + case let .direct(contact): !(contact.activeConn == nil && contact.profile.contactLink != nil && contact.active) && !contact.chatDeleted + case .contactRequest: true + case .contactConnection: true + case let .group(groupInfo): groupInfo.businessChat?.chatType == .customer + default: false + } + case .groups: + switch chatInfo { + case let .group(groupInfo): groupInfo.businessChat == nil + default: false + } + case .business: + chatInfo.groupInfo?.businessChat?.chatType == .business + } +} + struct ChatListView_Previews: PreviewProvider { @State static var userPickerSheet: UserPickerSheet? = .none diff --git a/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift b/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift index b87b84ebc0..aa802c1af9 100644 --- a/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift +++ b/apps/ios/Shared/Views/ChatList/ServersSummaryView.swift @@ -587,7 +587,7 @@ struct SMPStatsView: View { } header: { Text("Statistics") } footer: { - Text("Starting from \(localTimestamp(statsStartedAt)).") + Text("\n") + Text("All data is private to your device.") + Text("Starting from \(localTimestamp(statsStartedAt)).") + Text("\n") + Text("All data is kept private on your device.") } } } @@ -703,7 +703,7 @@ struct XFTPStatsView: View { } header: { Text("Statistics") } footer: { - Text("Starting from \(localTimestamp(statsStartedAt)).") + Text("\n") + Text("All data is private to your device.") + Text("Starting from \(localTimestamp(statsStartedAt)).") + Text("\n") + Text("All data is kept private on your device.") } } } diff --git a/apps/ios/Shared/Views/Contacts/ContactListNavLink.swift b/apps/ios/Shared/Views/Contacts/ContactListNavLink.swift index 898a47cc86..242b492e83 100644 --- a/apps/ios/Shared/Views/Contacts/ContactListNavLink.swift +++ b/apps/ios/Shared/Views/Contacts/ContactListNavLink.swift @@ -20,7 +20,7 @@ struct ContactListNavLink: View { @State private var showContactRequestDialog = false var body: some View { - let contactType = chatContactType(chat: chat) + let contactType = chatContactType(chat) Group { switch (chat.chatInfo) { diff --git a/apps/ios/Shared/Views/Database/DatabaseView.swift b/apps/ios/Shared/Views/Database/DatabaseView.swift index 4a367f7722..4c05434eb6 100644 --- a/apps/ios/Shared/Views/Database/DatabaseView.swift +++ b/apps/ios/Shared/Views/Database/DatabaseView.swift @@ -262,8 +262,7 @@ struct DatabaseView: View { message: Text("Your current chat database will be DELETED and REPLACED with the imported one.") + Text("This action cannot be undone - your profile, contacts, messages and files will be irreversibly lost."), primaryButton: .destructive(Text("Import")) { stopChatRunBlockStartChat(m.chatRunning == false, $progressIndicator) { - _ = await DatabaseView.importArchive(fileURL, $progressIndicator, $alert) - return true + await DatabaseView.importArchive(fileURL, $progressIndicator, $alert, false) } }, secondaryButton: .cancel() @@ -467,9 +466,13 @@ struct DatabaseView: View { static func importArchive( _ archivePath: URL, _ progressIndicator: Binding, - _ alert: Binding + _ alert: Binding, + _ migration: Bool ) async -> Bool { if archivePath.startAccessingSecurityScopedResource() { + defer { + archivePath.stopAccessingSecurityScopedResource() + } await MainActor.run { progressIndicator.wrappedValue = true } @@ -483,17 +486,17 @@ struct DatabaseView: View { _ = kcDatabasePassword.remove() if archiveErrors.isEmpty { await operationEnded(.archiveImported, progressIndicator, alert) + return true } else { await operationEnded(.archiveImportedWithErrors(archiveErrors: archiveErrors), progressIndicator, alert) + return migration } - return true } catch let error { await operationEnded(.error(title: "Error importing chat database", error: responseError(error)), progressIndicator, alert) } } catch let error { await operationEnded(.error(title: "Error deleting chat database", error: responseError(error)), progressIndicator, alert) } - archivePath.stopAccessingSecurityScopedResource() } else { showAlert("Error accessing database file") } @@ -542,6 +545,8 @@ struct DatabaseView: View { } else if case .chatDeleted = dbAlert { let (title, message) = chatDeletedAlertText() showAlert(title, message: message, actions: { [okAlertActionWaiting] }) + } else if case let .error(title, error) = dbAlert { + showAlert("\(title)", message: error, actions: { [okAlertActionWaiting] }) } else { alert.wrappedValue = dbAlert cont.resume() @@ -587,13 +592,13 @@ struct DatabaseView: View { } } -private func archiveImportedAlertText() -> (String, String) { +func archiveImportedAlertText() -> (String, String) { ( NSLocalizedString("Chat database imported", comment: ""), NSLocalizedString("Restart the app to use imported chat database", comment: "") ) } -private func archiveImportedWithErrorsAlertText(errs: [ArchiveError]) -> (String, String) { +func archiveImportedWithErrorsAlertText(errs: [ArchiveError]) -> (String, String) { ( NSLocalizedString("Chat database imported", comment: ""), NSLocalizedString("Restart the app to use imported chat database", comment: "") + "\n" + NSLocalizedString("Some non-fatal errors occurred during import:", comment: "") + archiveErrorsText(errs) diff --git a/apps/ios/Shared/Views/Migration/MigrateToDevice.swift b/apps/ios/Shared/Views/Migration/MigrateToDevice.swift index 763cd473fe..2d83cdc7c8 100644 --- a/apps/ios/Shared/Views/Migration/MigrateToDevice.swift +++ b/apps/ios/Shared/Views/Migration/MigrateToDevice.swift @@ -96,6 +96,7 @@ struct MigrateToDevice: View { @Binding var migrationState: MigrationToState? @State private var useKeychain = storeDBPassphraseGroupDefault.get() @State private var alert: MigrateToDeviceViewAlert? + @State private var databaseAlert: DatabaseAlert? = nil private let tempDatabaseUrl = urlForTemporaryDatabase() @State private var chatReceiver: MigrationChatReceiver? = nil // Prevent from hiding the view until migration is finished or app deleted @@ -178,6 +179,20 @@ struct MigrateToDevice: View { return Alert(title: Text(title), message: Text(error)) } } + .alert(item: $databaseAlert) { item in + switch item { + case .archiveImported: + let (title, message) = archiveImportedAlertText() + return Alert(title: Text(title), message: Text(message)) + case let .archiveImportedWithErrors(errs): + let (title, message) = archiveImportedWithErrorsAlertText(errs: errs) + return Alert(title: Text(title), message: Text(message)) + case let .error(title, error): + return Alert(title: Text(title), message: Text(error)) + default: // not expected this branch to be called because this alert is used only for importArchive purpose + return Alert(title: Text("Error")) + } + } .interactiveDismissDisabled(backDisabled) } @@ -243,7 +258,7 @@ struct MigrateToDevice: View { ) { result in if case let .success(files) = result, let fileURL = files.first { Task { - let success = await DatabaseView.importArchive(fileURL, $importingArchiveFromFileProgressIndicator, Binding.constant(nil)) + let success = await DatabaseView.importArchive(fileURL, $importingArchiveFromFileProgressIndicator, $databaseAlert, true) if success { DatabaseView.startChat( Binding.constant(false), diff --git a/apps/ios/Shared/Views/NewChat/NewChatMenuButton.swift b/apps/ios/Shared/Views/NewChat/NewChatMenuButton.swift index 6f973983bf..39656c1534 100644 --- a/apps/ios/Shared/Views/NewChat/NewChatMenuButton.swift +++ b/apps/ios/Shared/Views/NewChat/NewChatMenuButton.swift @@ -186,7 +186,7 @@ struct NewChatSheet: View { } } -func chatContactType(chat: Chat) -> ContactType { +func chatContactType(_ chat: Chat) -> ContactType { switch chat.chatInfo { case .contactRequest: return .request @@ -207,7 +207,7 @@ func chatContactType(chat: Chat) -> ContactType { private func filterContactTypes(chats: [Chat], contactTypes: [ContactType]) -> [Chat] { return chats.filter { chat in - contactTypes.contains(chatContactType(chat: chat)) + contactTypes.contains(chatContactType(chat)) } } @@ -279,8 +279,8 @@ struct ContactsList: View { } private func chatsByTypeComparator(chat1: Chat, chat2: Chat) -> Bool { - let chat1Type = chatContactType(chat: chat1) - let chat2Type = chatContactType(chat: chat2) + let chat1Type = chatContactType(chat1) + let chat2Type = chatContactType(chat2) if chat1Type.rawValue < chat2Type.rawValue { return true diff --git a/apps/ios/Shared/Views/NewChat/NewChatView.swift b/apps/ios/Shared/Views/NewChat/NewChatView.swift index e18d932278..6e898f4cdf 100644 --- a/apps/ios/Shared/Views/NewChat/NewChatView.swift +++ b/apps/ios/Shared/Views/NewChat/NewChatView.swift @@ -25,6 +25,7 @@ struct SomeActionSheet: Identifiable { struct SomeSheet: Identifiable { @ViewBuilder var content: Content var id: String + var fraction = 0.4 } private enum NewChatViewAlert: Identifiable { diff --git a/apps/ios/Shared/Views/Onboarding/AddressCreationCard.swift b/apps/ios/Shared/Views/Onboarding/AddressCreationCard.swift index 2069ca9487..c8d0faafa7 100644 --- a/apps/ios/Shared/Views/Onboarding/AddressCreationCard.swift +++ b/apps/ios/Shared/Views/Onboarding/AddressCreationCard.swift @@ -21,7 +21,7 @@ struct AddressCreationCard: View { var body: some View { let addressExists = chatModel.userAddress != nil let chats = chatModel.chats.filter { chat in - !chat.chatInfo.chatDeleted && chatContactType(chat: chat) != ContactType.card + !chat.chatInfo.chatDeleted && !chat.chatInfo.contactCard } ZStack(alignment: .topTrailing) { HStack(alignment: .top, spacing: 16) { diff --git a/apps/ios/Shared/Views/Onboarding/CreateProfile.swift b/apps/ios/Shared/Views/Onboarding/CreateProfile.swift index 14ad9dfb08..409cb859ea 100644 --- a/apps/ios/Shared/Views/Onboarding/CreateProfile.swift +++ b/apps/ios/Shared/Views/Onboarding/CreateProfile.swift @@ -174,7 +174,6 @@ struct CreateFirstProfile: View { } .onAppear() { focusDisplayName = true - setLastVersionDefault() } .padding(.horizontal, 25) .padding(.top, 10) diff --git a/apps/ios/Shared/Views/Onboarding/SimpleXInfo.swift b/apps/ios/Shared/Views/Onboarding/SimpleXInfo.swift index a8704e964b..40dd29db53 100644 --- a/apps/ios/Shared/Views/Onboarding/SimpleXInfo.swift +++ b/apps/ios/Shared/Views/Onboarding/SimpleXInfo.swift @@ -89,6 +89,9 @@ struct SimpleXInfo: View { ) } } + .onAppear() { + setLastVersionDefault() + } .frame(maxHeight: .infinity) .padding(.horizontal, 25) .padding(.top, 75) diff --git a/apps/ios/Shared/Views/UserSettings/NetworkAndServers/OperatorView.swift b/apps/ios/Shared/Views/UserSettings/NetworkAndServers/OperatorView.swift index cea9dd0635..24da6a94a8 100644 --- a/apps/ios/Shared/Views/UserSettings/NetworkAndServers/OperatorView.swift +++ b/apps/ios/Shared/Views/UserSettings/NetworkAndServers/OperatorView.swift @@ -53,7 +53,7 @@ struct OperatorView: View { ServersErrorView(errStr: errStr) } else { switch (userServers[operatorIndex].operator_.conditionsAcceptance) { - case let .accepted(acceptedAt): + case let .accepted(acceptedAt, _): if let acceptedAt = acceptedAt { Text("Conditions accepted on: \(conditionsTimestamp(acceptedAt)).") .foregroundColor(theme.colors.secondary) diff --git a/apps/ios/SimpleX Localizations/bg.xcloc/Localized Contents/bg.xliff b/apps/ios/SimpleX Localizations/bg.xcloc/Localized Contents/bg.xliff index 9260ac41c0..4aa1f2213f 100644 --- a/apps/ios/SimpleX Localizations/bg.xcloc/Localized Contents/bg.xliff +++ b/apps/ios/SimpleX Localizations/bg.xcloc/Localized Contents/bg.xliff @@ -731,8 +731,8 @@ Всички данни се изтриват при въвеждане. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/cs.xcloc/Localized Contents/cs.xliff b/apps/ios/SimpleX Localizations/cs.xcloc/Localized Contents/cs.xliff index d921471f7f..668888c20e 100644 --- a/apps/ios/SimpleX Localizations/cs.xcloc/Localized Contents/cs.xliff +++ b/apps/ios/SimpleX Localizations/cs.xcloc/Localized Contents/cs.xliff @@ -712,8 +712,8 @@ Všechna data se při zadání vymažou. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/de.xcloc/Localized Contents/de.xliff b/apps/ios/SimpleX Localizations/de.xcloc/Localized Contents/de.xliff index 053a1faf73..e993740f1c 100644 --- a/apps/ios/SimpleX Localizations/de.xcloc/Localized Contents/de.xliff +++ b/apps/ios/SimpleX Localizations/de.xcloc/Localized Contents/de.xliff @@ -579,6 +579,7 @@ About operators + Über Betreiber No comment provided by engineer. @@ -641,6 +642,7 @@ Add friends + Freunde aufnehmen No comment provided by engineer. @@ -660,6 +662,7 @@ Add team members + Team-Mitglieder aufnehmen No comment provided by engineer. @@ -674,6 +677,7 @@ Add your team members to the conversations. + Nehmen Sie Team-Mitglieder in Ihre Unterhaltungen auf. No comment provided by engineer. @@ -756,8 +760,8 @@ Alle Daten werden gelöscht, sobald dieser eingegeben wird. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Alle Daten werden nur auf Ihrem Gerät gespeichert. No comment provided by engineer. @@ -1248,10 +1252,12 @@ Business address + Geschäftliche Adresse No comment provided by engineer. Business chats + Geschäftliche Chats No comment provided by engineer. @@ -1398,14 +1404,17 @@ Chat + Chat No comment provided by engineer. Chat already exists + Chat besteht bereits No comment provided by engineer. Chat already exists! + Chat besteht bereits! No comment provided by engineer. @@ -1485,10 +1494,12 @@ Chat will be deleted for all members - this cannot be undone! + Der Chat wird für alle Mitglieder gelöscht. Dies kann nicht rückgängig gemacht werden! No comment provided by engineer. Chat will be deleted for you - this cannot be undone! + Der Chat wird für Sie gelöscht. Dies kann nicht rückgängig gemacht werden! No comment provided by engineer. @@ -2247,6 +2258,7 @@ Das ist Ihr eigener Einmal-Link! Delete chat + Chat löschen No comment provided by engineer. @@ -2261,6 +2273,7 @@ Das ist Ihr eigener Einmal-Link! Delete chat? + Chat löschen? No comment provided by engineer. @@ -2530,6 +2543,7 @@ Das ist Ihr eigener Einmal-Link! Direct messages between members are prohibited in this chat. + In diesem Chat sind Direktnachrichten zwischen Mitgliedern nicht erlaubt. No comment provided by engineer. @@ -4105,6 +4119,7 @@ Weitere Verbesserungen sind bald verfügbar! Invite to chat + Zum Chat einladen No comment provided by engineer. @@ -4267,10 +4282,12 @@ Das ist Ihr Link für die Gruppe %@! Leave chat + Chat verlassen No comment provided by engineer. Leave chat? + Chat verlassen? No comment provided by engineer. @@ -4405,6 +4422,7 @@ Das ist Ihr Link für die Gruppe %@! Member role will be changed to "%@". All chat members will be notified. + Die Rolle des Mitglieds wird auf "%@" geändert. Alle Chat-Mitglieder werden darüber informiert. No comment provided by engineer. @@ -4419,6 +4437,7 @@ Das ist Ihr Link für die Gruppe %@! Member will be removed from chat - this cannot be undone! + Das Mitglied wird aus dem Chat entfernt. Dies kann nicht rückgängig gemacht werden! No comment provided by engineer. @@ -5036,6 +5055,7 @@ Dies erfordert die Aktivierung eines VPNs. Only chat owners can change preferences. + Nur Chat-Eigentümer können die Präferenzen ändern. No comment provided by engineer. @@ -5170,6 +5190,7 @@ Dies erfordert die Aktivierung eines VPNs. Or import archive file + Oder importieren Sie eine Archiv-Datei No comment provided by engineer. @@ -5435,6 +5456,7 @@ Fehler: %@ Privacy for your customers. + Schutz der Privatsphäre Ihrer Kunden. No comment provided by engineer. @@ -7011,6 +7033,7 @@ Aktivieren Sie es in den *Netzwerk & Server* Einstellungen. Tap Create SimpleX address in the menu to create it later. + Tippen Sie im Menü auf SimpleX-Adresse erstellen, um sie später zu erstellen. No comment provided by engineer. @@ -7212,12 +7235,12 @@ Dies kann passieren, wenn es einen Fehler gegeben hat oder die Verbindung kompro The servers for new connections of your current chat profile **%@**. - Mögliche Server für neue Verbindungen von Ihrem aktuellen Chat-Profil **%@**. + Nachrichten-Server für neue Verbindungen über Ihr aktuelles Chat-Profil **%@**. No comment provided by engineer. The servers for new files of your current chat profile **%@**. - Die Server Deines aktuellen Chat-Profils für neue Dateien **%@**. + Medien- und Datei-Server für neue Daten über Ihr aktuelles Chat-Profil **%@**. No comment provided by engineer. @@ -8061,6 +8084,7 @@ Bitten Sie Ihren Kontakt darum einen weiteren Verbindungs-Link zu erzeugen, um s You are already connected with %@. + Sie sind bereits mit %@ verbunden. No comment provided by engineer. @@ -8339,6 +8363,7 @@ Verbindungsanfrage wiederholen? You will stop receiving messages from this chat. Chat history will be preserved. + Sie werden von diesem Chat keine Nachrichten mehr erhalten. Der Nachrichtenverlauf wird beibehalten. No comment provided by engineer. @@ -8528,6 +8553,7 @@ Verbindungsanfrage wiederholen? accepted invitation + Einladung akzeptiert chat list item title @@ -9214,6 +9240,7 @@ Verbindungsanfrage wiederholen? requested to connect + Zur Verbindung aufgefordert chat list item title diff --git a/apps/ios/SimpleX Localizations/en.xcloc/Localized Contents/en.xliff b/apps/ios/SimpleX Localizations/en.xcloc/Localized Contents/en.xliff index 004d7f0d31..cebd6c90d1 100644 --- a/apps/ios/SimpleX Localizations/en.xcloc/Localized Contents/en.xliff +++ b/apps/ios/SimpleX Localizations/en.xcloc/Localized Contents/en.xliff @@ -760,9 +760,9 @@ All data is erased when it is entered. No comment provided by engineer. - - All data is private to your device. - All data is private to your device. + + All data is kept private on your device. + All data is kept private on your device. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/es.xcloc/Localized Contents/es.xliff b/apps/ios/SimpleX Localizations/es.xcloc/Localized Contents/es.xliff index ea966ea63b..08522cc617 100644 --- a/apps/ios/SimpleX Localizations/es.xcloc/Localized Contents/es.xliff +++ b/apps/ios/SimpleX Localizations/es.xcloc/Localized Contents/es.xliff @@ -579,6 +579,7 @@ About operators + Acerca de los operadores No comment provided by engineer. @@ -641,6 +642,7 @@ Add friends + Añadir amigos No comment provided by engineer. @@ -660,6 +662,7 @@ Add team members + Añadir miembros del equipo No comment provided by engineer. @@ -674,6 +677,7 @@ Add your team members to the conversations. + Añade a los miembros de tu equipo a las conversaciones. No comment provided by engineer. @@ -756,8 +760,8 @@ Al introducirlo todos los datos son eliminados. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Todos los datos son privados y están en tu dispositivo. No comment provided by engineer. @@ -1248,10 +1252,12 @@ Business address + Dirección empresarial No comment provided by engineer. Business chats + Chats empresariales No comment provided by engineer. @@ -1398,14 +1404,17 @@ Chat + Chat No comment provided by engineer. Chat already exists + El chat ya existe No comment provided by engineer. Chat already exists! + ¡El chat ya existe! No comment provided by engineer. @@ -1485,10 +1494,12 @@ Chat will be deleted for all members - this cannot be undone! + El chat será eliminado para todos los miembros. ¡No podrá deshacerse! No comment provided by engineer. Chat will be deleted for you - this cannot be undone! + El chat será eliminado para tí. ¡No podrá deshacerse! No comment provided by engineer. @@ -2247,6 +2258,7 @@ This is your own one-time link! Delete chat + Eliminar chat No comment provided by engineer. @@ -2261,6 +2273,7 @@ This is your own one-time link! Delete chat? + ¿Eliminar chat? No comment provided by engineer. @@ -2295,7 +2308,7 @@ This is your own one-time link! Delete files and media? - Eliminar archivos y multimedia? + ¿Eliminar archivos y multimedia? No comment provided by engineer. @@ -2530,6 +2543,7 @@ This is your own one-time link! Direct messages between members are prohibited in this chat. + Mensajes directos no permitidos entre miembros de este chat. No comment provided by engineer. @@ -2740,7 +2754,7 @@ This is your own one-time link! Enable Flux - Habilitar Flux + Habilita Flux No comment provided by engineer. @@ -4105,6 +4119,7 @@ More improvements are coming soon! Invite to chat + Invitar al chat No comment provided by engineer. @@ -4267,10 +4282,12 @@ This is your link for group %@! Leave chat + Salir del chat No comment provided by engineer. Leave chat? + ¿Salir del chat? No comment provided by engineer. @@ -4405,6 +4422,7 @@ This is your link for group %@! Member role will be changed to "%@". All chat members will be notified. + El rol del miembro cambiará a "%@" y todos serán notificados. No comment provided by engineer. @@ -4419,6 +4437,7 @@ This is your link for group %@! Member will be removed from chat - this cannot be undone! + El miembro será eliminado del chat. ¡No podrá deshacerse! No comment provided by engineer. @@ -5036,6 +5055,7 @@ Requiere activación de la VPN. Only chat owners can change preferences. + Sólo los propietarios del chat pueden cambiar las preferencias. No comment provided by engineer. @@ -5170,6 +5190,7 @@ Requiere activación de la VPN. Or import archive file + O importa desde un archivo No comment provided by engineer. @@ -5410,7 +5431,7 @@ Error: %@ Preset server address - Dirección del servidor predefinida + Dirección predefinida del servidor No comment provided by engineer. @@ -5435,6 +5456,7 @@ Error: %@ Privacy for your customers. + Privacidad para tus clientes. No comment provided by engineer. @@ -5631,7 +5653,7 @@ Actívalo en ajustes de *Servidores y Redes*. Read more - Conoce más + Saber más No comment provided by engineer. @@ -6589,7 +6611,7 @@ Actívalo en ajustes de *Servidores y Redes*. Share SimpleX address on social media. - Compartir dirección SimpleX en redes sociales. + Comparte tu dirección SimpleX en redes sociales. No comment provided by engineer. @@ -6729,12 +6751,12 @@ Actívalo en ajustes de *Servidores y Redes*. SimpleX address and 1-time links are safe to share via any messenger. - Compartir enlaces de un uso y direcciones SimpleX es seguro a través de cualquier medio. + Compartir los enlaces de un uso y las direcciones SimpleX es seguro a través de cualquier medio. No comment provided by engineer. SimpleX address or 1-time link? - Dirección SimpleX o enlace de un uso? + ¿Dirección SimpleX o enlace de un uso? No comment provided by engineer. @@ -7011,6 +7033,7 @@ Actívalo en ajustes de *Servidores y Redes*. Tap Create SimpleX address in the menu to create it later. + Pulsa Crear dirección SimpleX en el menú para crearla más tarde. No comment provided by engineer. @@ -7197,7 +7220,7 @@ Puede ocurrir por algún bug o cuando la conexión está comprometida. The second preset operator in the app! - El segundo operador predefinido! + ¡Segundo operador predefinido! No comment provided by engineer. @@ -7212,7 +7235,7 @@ Puede ocurrir por algún bug o cuando la conexión está comprometida. The servers for new connections of your current chat profile **%@**. - Lista de servidores para las conexiones nuevas de tu perfil actual **%@**. + Lista de servidores para las conexiones nuevas del perfil **%@**. No comment provided by engineer. @@ -8056,11 +8079,12 @@ Para conectarte pide a tu contacto que cree otro enlace y comprueba la conexión You are already connected to %@. - Ya estás conectado a %@. + Ya estás conectado con %@. No comment provided by engineer. You are already connected with %@. + Ya estás conectado con %@. No comment provided by engineer. @@ -8339,6 +8363,7 @@ Repeat connection request? You will stop receiving messages from this chat. Chat history will be preserved. + Dejarás de recibir mensajes de este chat. El historial del chat se conserva. No comment provided by engineer. @@ -8528,6 +8553,7 @@ Repeat connection request? accepted invitation + invitación aceptada chat list item title @@ -8912,7 +8938,7 @@ Repeat connection request? for better metadata privacy. - para mayor privacidad de los metadatos. + para mejorar la privacidad de los metadatos. No comment provided by engineer. @@ -9214,6 +9240,7 @@ Repeat connection request? requested to connect + solicitado para conectar chat list item title diff --git a/apps/ios/SimpleX Localizations/fi.xcloc/Localized Contents/fi.xliff b/apps/ios/SimpleX Localizations/fi.xcloc/Localized Contents/fi.xliff index 2f67ee9d7d..2caa98e25b 100644 --- a/apps/ios/SimpleX Localizations/fi.xcloc/Localized Contents/fi.xliff +++ b/apps/ios/SimpleX Localizations/fi.xcloc/Localized Contents/fi.xliff @@ -707,8 +707,8 @@ Kaikki tiedot poistetaan, kun se syötetään. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/fr.xcloc/Localized Contents/fr.xliff b/apps/ios/SimpleX Localizations/fr.xcloc/Localized Contents/fr.xliff index 74002293d7..148156b07c 100644 --- a/apps/ios/SimpleX Localizations/fr.xcloc/Localized Contents/fr.xliff +++ b/apps/ios/SimpleX Localizations/fr.xcloc/Localized Contents/fr.xliff @@ -745,8 +745,8 @@ Toutes les données sont effacées lorsqu'il est saisi. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Toutes les données restent confinées dans votre appareil. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/hu.xcloc/Localized Contents/hu.xliff b/apps/ios/SimpleX Localizations/hu.xcloc/Localized Contents/hu.xliff index 598bee5485..231c33523d 100644 --- a/apps/ios/SimpleX Localizations/hu.xcloc/Localized Contents/hu.xliff +++ b/apps/ios/SimpleX Localizations/hu.xcloc/Localized Contents/hu.xliff @@ -574,11 +574,12 @@ About SimpleX Chat - A SimpleX Chatről + SimpleX Chat névjegye No comment provided by engineer. About operators + Az üzemeltetőkről No comment provided by engineer. @@ -759,8 +760,8 @@ A jelkód megadása után az összes adat törlésre kerül. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Az összes adat biztonságban van az eszközén. No comment provided by engineer. @@ -1352,7 +1353,7 @@ Change chat profiles - Felhasználói profilok megváltoztatása + Csevegési profilok megváltoztatása authentication reason @@ -3525,7 +3526,7 @@ Ez az Ön egyszer használható meghívó-hivatkozása! For example, if your contact receives messages via a SimpleX Chat server, your app will deliver them via a Flux server. - Ha például az ismerőse a SimpleX Chat kiszolgálón keresztül fogadja az üzeneteket, az Ön alkalmazása a Flux egyik kiszolgálóját használja a kézbesítéshez. + Például, ha az Ön ismerőse egy SimpleX Chat-kiszolgálón keresztül fogadja az üzeneteket, az Ön alkalmazása egy Flux-kiszolgálón keresztül fogja azokat kézbesíteni. No comment provided by engineer. @@ -5570,7 +5571,7 @@ Hiba: %@ Protect IP address - IP-cím védelem + IP-cím védelme No comment provided by engineer. @@ -6715,6 +6716,7 @@ Engedélyezze a „Beállítások -> Hálózat és kiszolgálók” menüben. SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app. + A SimpleX Chat és a Flux megállapodást kötött arról, hogy a Flux által üzemeltetett kiszolgálókat beépítik az alkalmazásba. No comment provided by engineer. @@ -7208,7 +7210,7 @@ Ez valamilyen hiba, vagy sérült kapcsolat esetén fordulhat elő. The same conditions will apply to operator **%@**. - Ugyanezek a feltételek vonatkoznak a következő üzemeltetőre is: **%@**. + Ugyanezek a feltételek lesznek elfogadva a következő üzemeltetőre is: **%@**. No comment provided by engineer. @@ -8154,7 +8156,7 @@ Csatlakozáskérés megismétlése? You can configure servers via settings. - A kiszolgálókat a beállításokon keresztül konfigurálhatja. + A kiszolgálókat a „Hálózat és kiszolgálók” menüben konfigurálhatja. No comment provided by engineer. @@ -8204,7 +8206,7 @@ Csatlakozáskérés megismétlése? You can set lock screen notification preview via settings. - A beállításokon keresztül beállíthatja a lezárási képernyő értesítési előnézetét. + A lezárási képernyő értesítési előnézetét az „Értesítések” menüben állíthatja be. No comment provided by engineer. @@ -8551,6 +8553,7 @@ Kapcsolatkérés megismétlése? accepted invitation + elfogadott meghívó chat list item title @@ -9237,6 +9240,7 @@ Kapcsolatkérés megismétlése? requested to connect + kérelmezve a kapcsolódáshoz chat list item title diff --git a/apps/ios/SimpleX Localizations/it.xcloc/Localized Contents/it.xliff b/apps/ios/SimpleX Localizations/it.xcloc/Localized Contents/it.xliff index 67633b7ae8..d785acda81 100644 --- a/apps/ios/SimpleX Localizations/it.xcloc/Localized Contents/it.xliff +++ b/apps/ios/SimpleX Localizations/it.xcloc/Localized Contents/it.xliff @@ -759,8 +759,8 @@ Tutti i dati vengono cancellati quando inserito. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Tutti i dati sono privati, nel tuo dispositivo. No comment provided by engineer. @@ -1091,12 +1091,12 @@ Auto-accept contact requests - Auto-accetta richieste di contatto + Auto-accetta le richieste di contatto No comment provided by engineer. Auto-accept images - Auto-accetta immagini + Auto-accetta le immagini No comment provided by engineer. @@ -1216,7 +1216,7 @@ Blur media - Sfocatura file multimediali + Sfocatura dei file multimediali No comment provided by engineer. @@ -4501,7 +4501,7 @@ Questo è il tuo link per il gruppo %@! Message draft - Bozza dei messaggi + Bozza del messaggio No comment provided by engineer. @@ -5988,12 +5988,12 @@ Attivalo nelle impostazioni *Rete e server*. Review conditions - Esamina le condizioni + Leggi le condizioni No comment provided by engineer. Review later - Esamina più tardi + Leggi più tardi No comment provided by engineer. @@ -6289,7 +6289,7 @@ Attivalo nelle impostazioni *Rete e server*. Send link previews - Invia anteprime dei link + Invia le anteprime dei link No comment provided by engineer. @@ -6610,7 +6610,7 @@ Attivalo nelle impostazioni *Rete e server*. Share SimpleX address on social media. - Condividi indirizzo SimpleX sui social media. + Condividi l'indirizzo SimpleX sui social media. No comment provided by engineer. @@ -6715,6 +6715,7 @@ Attivalo nelle impostazioni *Rete e server*. SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app. + SimpleX Chat e Flux hanno concluso un accordo per includere server gestiti da Flux nell'app No comment provided by engineer. @@ -7031,7 +7032,7 @@ Attivalo nelle impostazioni *Rete e server*. Tap Create SimpleX address in the menu to create it later. - Tocca "Crea indirizzo SimpleX" nel menu per crearlo più tardi. + Tocca Crea indirizzo SimpleX nel menu per crearlo più tardi. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/ja.xcloc/Localized Contents/ja.xliff b/apps/ios/SimpleX Localizations/ja.xcloc/Localized Contents/ja.xliff index 43e6f24cf7..72e68cff48 100644 --- a/apps/ios/SimpleX Localizations/ja.xcloc/Localized Contents/ja.xliff +++ b/apps/ios/SimpleX Localizations/ja.xcloc/Localized Contents/ja.xliff @@ -724,8 +724,8 @@ 入力するとすべてのデータが消去されます。 No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/nl.xcloc/Localized Contents/nl.xliff b/apps/ios/SimpleX Localizations/nl.xcloc/Localized Contents/nl.xliff index c30370fc5a..ab3499a4dc 100644 --- a/apps/ios/SimpleX Localizations/nl.xcloc/Localized Contents/nl.xliff +++ b/apps/ios/SimpleX Localizations/nl.xcloc/Localized Contents/nl.xliff @@ -579,6 +579,7 @@ About operators + Over operatoren No comment provided by engineer. @@ -759,8 +760,8 @@ Alle gegevens worden bij het invoeren gewist. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Alle gegevens zijn privé op uw apparaat. No comment provided by engineer. @@ -8552,6 +8553,7 @@ Verbindingsverzoek herhalen? accepted invitation + geaccepteerde uitnodiging chat list item title @@ -9238,6 +9240,7 @@ Verbindingsverzoek herhalen? requested to connect + gevraagd om verbinding te maken chat list item title diff --git a/apps/ios/SimpleX Localizations/pl.xcloc/Localized Contents/pl.xliff b/apps/ios/SimpleX Localizations/pl.xcloc/Localized Contents/pl.xliff index e7c9863152..8cfdf56f66 100644 --- a/apps/ios/SimpleX Localizations/pl.xcloc/Localized Contents/pl.xliff +++ b/apps/ios/SimpleX Localizations/pl.xcloc/Localized Contents/pl.xliff @@ -745,8 +745,8 @@ Wszystkie dane są usuwane po jego wprowadzeniu. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Wszystkie dane są prywatne na Twoim urządzeniu. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/pt-BR.xcloc/Localized Contents/pt-BR.xliff b/apps/ios/SimpleX Localizations/pt-BR.xcloc/Localized Contents/pt-BR.xliff index 9badf9c2e4..93ba6f357b 100644 --- a/apps/ios/SimpleX Localizations/pt-BR.xcloc/Localized Contents/pt-BR.xliff +++ b/apps/ios/SimpleX Localizations/pt-BR.xcloc/Localized Contents/pt-BR.xliff @@ -5425,8 +5425,8 @@ Isso pode acontecer por causa de algum bug ou quando a conexão está comprometi Advanced settings Configurações avançadas - - All data is private to your device. + + All data is kept private on your device. Toda informação é privada em seu dispositivo. diff --git a/apps/ios/SimpleX Localizations/ru.xcloc/Localized Contents/ru.xliff b/apps/ios/SimpleX Localizations/ru.xcloc/Localized Contents/ru.xliff index 943ea67ef4..5809c65216 100644 --- a/apps/ios/SimpleX Localizations/ru.xcloc/Localized Contents/ru.xliff +++ b/apps/ios/SimpleX Localizations/ru.xcloc/Localized Contents/ru.xliff @@ -384,7 +384,7 @@ **Scan / Paste link**: to connect via a link you received. - **Сканировать / Вставить ссылку**: чтобы соединится через полученную ссылку. + **Сканировать / Вставить ссылку**: чтобы соединиться через полученную ссылку. No comment provided by engineer. @@ -760,8 +760,8 @@ Все данные удаляются при его вводе. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Все данные хранятся только на вашем устройстве. No comment provided by engineer. @@ -5582,7 +5582,7 @@ Error: %@ Protect your IP address from the messaging relays chosen by your contacts. Enable in *Network & servers* settings. Защитите ваш IP адрес от серверов сообщений, выбранных Вашими контактами. -Включите в настройках *Сеть и серверы*. +Включите в настройках *Сети и серверов*. No comment provided by engineer. @@ -8150,7 +8150,7 @@ Repeat join request? You can configure operators in Network & servers settings. - Вы можете настроить операторов в настройках Сеть и серверы. + Вы можете настроить операторов в настройках Сети и серверов. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/th.xcloc/Localized Contents/th.xliff b/apps/ios/SimpleX Localizations/th.xcloc/Localized Contents/th.xliff index 177f426c1a..4317787f67 100644 --- a/apps/ios/SimpleX Localizations/th.xcloc/Localized Contents/th.xliff +++ b/apps/ios/SimpleX Localizations/th.xcloc/Localized Contents/th.xliff @@ -699,8 +699,8 @@ ข้อมูลทั้งหมดจะถูกลบเมื่อถูกป้อน No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/tr.xcloc/Localized Contents/tr.xliff b/apps/ios/SimpleX Localizations/tr.xcloc/Localized Contents/tr.xliff index d88adc3235..261752aefc 100644 --- a/apps/ios/SimpleX Localizations/tr.xcloc/Localized Contents/tr.xliff +++ b/apps/ios/SimpleX Localizations/tr.xcloc/Localized Contents/tr.xliff @@ -745,8 +745,8 @@ Kullanıldığında bütün veriler silinir. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Tüm veriler cihazınıza özeldir. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/uk.xcloc/Localized Contents/uk.xliff b/apps/ios/SimpleX Localizations/uk.xcloc/Localized Contents/uk.xliff index d68b5abbe1..d7dcc58dcd 100644 --- a/apps/ios/SimpleX Localizations/uk.xcloc/Localized Contents/uk.xliff +++ b/apps/ios/SimpleX Localizations/uk.xcloc/Localized Contents/uk.xliff @@ -756,8 +756,8 @@ Всі дані стираються при введенні. No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. Всі дані є приватними для вашого пристрою. No comment provided by engineer. diff --git a/apps/ios/SimpleX Localizations/zh-Hans.xcloc/Localized Contents/zh-Hans.xliff b/apps/ios/SimpleX Localizations/zh-Hans.xcloc/Localized Contents/zh-Hans.xliff index 99d4a5077f..d6e548c6be 100644 --- a/apps/ios/SimpleX Localizations/zh-Hans.xcloc/Localized Contents/zh-Hans.xliff +++ b/apps/ios/SimpleX Localizations/zh-Hans.xcloc/Localized Contents/zh-Hans.xliff @@ -739,8 +739,8 @@ 所有数据在输入后将被删除。 No comment provided by engineer. - - All data is private to your device. + + All data is kept private on your device. 所有数据都是您设备的私有数据. No comment provided by engineer. diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj index d48df1189d..6ac638ee84 100644 --- a/apps/ios/SimpleX.xcodeproj/project.pbxproj +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -172,9 +172,9 @@ 648010AB281ADD15009009B9 /* CIFileView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 648010AA281ADD15009009B9 /* CIFileView.swift */; }; 648679AB2BC96A74006456E7 /* ChatItemForwardingView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 648679AA2BC96A74006456E7 /* ChatItemForwardingView.swift */; }; 649B28DD2CFE07CF00536B68 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28D82CFE07CF00536B68 /* libffi.a */; }; - 649B28DE2CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28D92CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo-ghc9.6.3.a */; }; + 649B28DE2CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28D92CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8-ghc9.6.3.a */; }; 649B28DF2CFE07CF00536B68 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28DA2CFE07CF00536B68 /* libgmpxx.a */; }; - 649B28E02CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28DB2CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo.a */; }; + 649B28E02CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28DB2CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8.a */; }; 649B28E12CFE07CF00536B68 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 649B28DC2CFE07CF00536B68 /* libgmp.a */; }; 649BCDA0280460FD00C3A862 /* ComposeImageView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 649BCD9F280460FD00C3A862 /* ComposeImageView.swift */; }; 649BCDA22805D6EF00C3A862 /* CIImageView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 649BCDA12805D6EF00C3A862 /* CIImageView.swift */; }; @@ -208,6 +208,7 @@ 8CC4ED902BD7B8530078AEE8 /* CallAudioDeviceManager.swift in Sources */ = {isa = PBXBuildFile; fileRef = 8CC4ED8F2BD7B8530078AEE8 /* CallAudioDeviceManager.swift */; }; 8CC956EE2BC0041000412A11 /* NetworkObserver.swift in Sources */ = {isa = PBXBuildFile; fileRef = 8CC956ED2BC0041000412A11 /* NetworkObserver.swift */; }; 8CE848A32C5A0FA000D5C7C8 /* SelectableChatItemToolbars.swift in Sources */ = {isa = PBXBuildFile; fileRef = 8CE848A22C5A0FA000D5C7C8 /* SelectableChatItemToolbars.swift */; }; + B728945B2D0C62BF00F7A19A /* ElegantEmojiPicker in Frameworks */ = {isa = PBXBuildFile; productRef = B728945A2D0C62BF00F7A19A /* ElegantEmojiPicker */; }; B73EFE532CE5FA3500C778EA /* CreateSimpleXAddress.swift in Sources */ = {isa = PBXBuildFile; fileRef = B73EFE522CE5FA3500C778EA /* CreateSimpleXAddress.swift */; }; B76E6C312C5C41D900EC11AA /* ContactListNavLink.swift in Sources */ = {isa = PBXBuildFile; fileRef = B76E6C302C5C41D900EC11AA /* ContactListNavLink.swift */; }; B79ADAFF2CE4EF930083DFFD /* AddressCreationCard.swift in Sources */ = {isa = PBXBuildFile; fileRef = B79ADAFE2CE4EF930083DFFD /* AddressCreationCard.swift */; }; @@ -526,9 +527,9 @@ 648679AA2BC96A74006456E7 /* ChatItemForwardingView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatItemForwardingView.swift; sourceTree = ""; }; 6493D667280ED77F007A76FB /* en */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = en; path = en.lproj/Localizable.strings; sourceTree = ""; }; 649B28D82CFE07CF00536B68 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; - 649B28D92CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo-ghc9.6.3.a"; sourceTree = ""; }; + 649B28D92CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8-ghc9.6.3.a"; sourceTree = ""; }; 649B28DA2CFE07CF00536B68 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; - 649B28DB2CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo.a"; sourceTree = ""; }; + 649B28DB2CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8.a"; sourceTree = ""; }; 649B28DC2CFE07CF00536B68 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; 649BCD9F280460FD00C3A862 /* ComposeImageView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeImageView.swift; sourceTree = ""; }; 649BCDA12805D6EF00C3A862 /* CIImageView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIImageView.swift; sourceTree = ""; }; @@ -646,6 +647,7 @@ buildActionMask = 2147483647; files = ( 5CE2BA702845308900EC33A6 /* SimpleXChat.framework in Frameworks */, + B728945B2D0C62BF00F7A19A /* ElegantEmojiPicker in Frameworks */, 8C8118722C220B5B00E6FC94 /* Yams in Frameworks */, 8CB3476C2CF5CFFA006787A5 /* Ink in Frameworks */, D741547829AF89AF0022400A /* StoreKit.framework in Frameworks */, @@ -681,9 +683,9 @@ 5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */, 649B28E12CFE07CF00536B68 /* libgmp.a in Frameworks */, 5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */, - 649B28E02CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo.a in Frameworks */, + 649B28E02CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8.a in Frameworks */, CE38A29C2C3FCD72005ED185 /* SwiftyGif in Frameworks */, - 649B28DE2CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo-ghc9.6.3.a in Frameworks */, + 649B28DE2CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8-ghc9.6.3.a in Frameworks */, 649B28DD2CFE07CF00536B68 /* libffi.a in Frameworks */, ); runOnlyForDeploymentPostprocessing = 0; @@ -764,8 +766,8 @@ 649B28D82CFE07CF00536B68 /* libffi.a */, 649B28DC2CFE07CF00536B68 /* libgmp.a */, 649B28DA2CFE07CF00536B68 /* libgmpxx.a */, - 649B28D92CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo-ghc9.6.3.a */, - 649B28DB2CFE07CF00536B68 /* libHSsimplex-chat-6.2.0.6-5lGV6gtq9gSDlEsE8DHXYo.a */, + 649B28D92CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8-ghc9.6.3.a */, + 649B28DB2CFE07CF00536B68 /* libHSsimplex-chat-6.2.2.0-D2oDit4btfV544uCfkkET8.a */, ); path = Libraries; sourceTree = ""; @@ -1196,6 +1198,7 @@ D7197A1729AE89660055C05A /* WebRTC */, 8C8118712C220B5B00E6FC94 /* Yams */, 8CB3476B2CF5CFFA006787A5 /* Ink */, + B728945A2D0C62BF00F7A19A /* ElegantEmojiPicker */, ); productName = "SimpleX (iOS)"; productReference = 5CA059CA279559F40002BEB4 /* SimpleX.app */; @@ -1340,6 +1343,7 @@ D7197A1629AE89660055C05A /* XCRemoteSwiftPackageReference "WebRTC" */, 8C73C1162C21E17B00892670 /* XCRemoteSwiftPackageReference "Yams" */, 8CB3476A2CF5CFFA006787A5 /* XCRemoteSwiftPackageReference "ink" */, + B72894592D0C62BF00F7A19A /* XCRemoteSwiftPackageReference "Elegant-Emoji-Picker" */, ); productRefGroup = 5CA059CB279559F40002BEB4 /* Products */; projectDirPath = ""; @@ -1941,7 +1945,7 @@ CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES; CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEAD_CODE_STRIPPING = YES; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; @@ -1966,7 +1970,7 @@ "@executable_path/Frameworks", ); LLVM_LTO = YES_THIN; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.app; PRODUCT_NAME = SimpleX; SDKROOT = iphoneos; @@ -1990,7 +1994,7 @@ CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES; CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEAD_CODE_STRIPPING = YES; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; @@ -2015,7 +2019,7 @@ "@executable_path/Frameworks", ); LLVM_LTO = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.app; PRODUCT_NAME = SimpleX; SDKROOT = iphoneos; @@ -2031,11 +2035,11 @@ buildSettings = { ALWAYS_EMBED_SWIFT_STANDARD_LIBRARIES = YES; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEVELOPMENT_TEAM = 5NN7GUYB6T; GENERATE_INFOPLIST_FILE = YES; IPHONEOS_DEPLOYMENT_TARGET = 15.0; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.Tests-iOS"; PRODUCT_NAME = "$(TARGET_NAME)"; SDKROOT = iphoneos; @@ -2051,11 +2055,11 @@ buildSettings = { ALWAYS_EMBED_SWIFT_STANDARD_LIBRARIES = YES; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEVELOPMENT_TEAM = 5NN7GUYB6T; GENERATE_INFOPLIST_FILE = YES; IPHONEOS_DEPLOYMENT_TARGET = 15.0; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.Tests-iOS"; PRODUCT_NAME = "$(TARGET_NAME)"; SDKROOT = iphoneos; @@ -2076,7 +2080,7 @@ CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements"; CODE_SIGN_IDENTITY = "Apple Development"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; GCC_OPTIMIZATION_LEVEL = s; @@ -2091,7 +2095,7 @@ "@executable_path/../../Frameworks", ); LLVM_LTO = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-NSE"; PRODUCT_NAME = "$(TARGET_NAME)"; PROVISIONING_PROFILE_SPECIFIER = ""; @@ -2113,7 +2117,7 @@ CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements"; CODE_SIGN_IDENTITY = "Apple Development"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; ENABLE_CODE_COVERAGE = NO; @@ -2128,7 +2132,7 @@ "@executable_path/../../Frameworks", ); LLVM_LTO = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-NSE"; PRODUCT_NAME = "$(TARGET_NAME)"; PROVISIONING_PROFILE_SPECIFIER = ""; @@ -2150,7 +2154,7 @@ CLANG_TIDY_BUGPRONE_REDUNDANT_BRANCH_CONDITION = YES; CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEFINES_MODULE = YES; DEVELOPMENT_TEAM = 5NN7GUYB6T; DYLIB_COMPATIBILITY_VERSION = 1; @@ -2176,7 +2180,7 @@ "$(PROJECT_DIR)/Libraries/sim", ); LLVM_LTO = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleXChat; PRODUCT_NAME = "$(TARGET_NAME:c99extidentifier)"; SDKROOT = iphoneos; @@ -2201,7 +2205,7 @@ CLANG_TIDY_BUGPRONE_REDUNDANT_BRANCH_CONDITION = YES; CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEFINES_MODULE = YES; DEVELOPMENT_TEAM = 5NN7GUYB6T; DYLIB_COMPATIBILITY_VERSION = 1; @@ -2227,7 +2231,7 @@ "$(PROJECT_DIR)/Libraries/sim", ); LLVM_LTO = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleXChat; PRODUCT_NAME = "$(TARGET_NAME:c99extidentifier)"; SDKROOT = iphoneos; @@ -2252,7 +2256,7 @@ CLANG_CXX_LANGUAGE_STANDARD = "gnu++20"; CODE_SIGN_ENTITLEMENTS = "SimpleX SE/SimpleX SE.entitlements"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_USER_SCRIPT_SANDBOXING = YES; GCC_C_LANGUAGE_STANDARD = gnu17; @@ -2267,7 +2271,7 @@ "@executable_path/../../Frameworks", ); LOCALIZATION_PREFERS_STRING_CATALOGS = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-SE"; PRODUCT_NAME = "$(TARGET_NAME)"; SDKROOT = iphoneos; @@ -2286,7 +2290,7 @@ CLANG_CXX_LANGUAGE_STANDARD = "gnu++20"; CODE_SIGN_ENTITLEMENTS = "SimpleX SE/SimpleX SE.entitlements"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 253; + CURRENT_PROJECT_VERSION = 257; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_USER_SCRIPT_SANDBOXING = YES; GCC_C_LANGUAGE_STANDARD = gnu17; @@ -2301,7 +2305,7 @@ "@executable_path/../../Frameworks", ); LOCALIZATION_PREFERS_STRING_CATALOGS = YES; - MARKETING_VERSION = 6.2; + MARKETING_VERSION = 6.2.3; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-SE"; PRODUCT_NAME = "$(TARGET_NAME)"; SDKROOT = iphoneos; @@ -2397,6 +2401,14 @@ version = 0.6.0; }; }; + B72894592D0C62BF00F7A19A /* XCRemoteSwiftPackageReference "Elegant-Emoji-Picker" */ = { + isa = XCRemoteSwiftPackageReference; + repositoryURL = "https://github.com/Finalet/Elegant-Emoji-Picker"; + requirement = { + branch = main; + kind = branch; + }; + }; D7197A1629AE89660055C05A /* XCRemoteSwiftPackageReference "WebRTC" */ = { isa = XCRemoteSwiftPackageReference; repositoryURL = "https://github.com/simplex-chat/WebRTC.git"; @@ -2439,6 +2451,11 @@ package = 8CB3476A2CF5CFFA006787A5 /* XCRemoteSwiftPackageReference "ink" */; productName = Ink; }; + B728945A2D0C62BF00F7A19A /* ElegantEmojiPicker */ = { + isa = XCSwiftPackageProductDependency; + package = B72894592D0C62BF00F7A19A /* XCRemoteSwiftPackageReference "Elegant-Emoji-Picker" */; + productName = ElegantEmojiPicker; + }; CE38A29B2C3FCD72005ED185 /* SwiftyGif */ = { isa = XCSwiftPackageProductDependency; package = D77B92DA2952372200A5A1CC /* XCRemoteSwiftPackageReference "SwiftyGif" */; diff --git a/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/swiftpm/Package.resolved b/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/swiftpm/Package.resolved index 7fdbff38af..2bddf5b5b8 100644 --- a/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/swiftpm/Package.resolved +++ b/apps/ios/SimpleX.xcodeproj/project.xcworkspace/xcshareddata/swiftpm/Package.resolved @@ -1,5 +1,5 @@ { - "originHash" : "33afc44be5f4225325b3cb940ed71b6cbf3ef97290d348d7b6803697bcd0637d", + "originHash" : "07434ae88cbf078ce3d27c91c1f605836aaebff0e0cef5f25317795151c77db1", "pins" : [ { "identity" : "codescanner", @@ -10,6 +10,15 @@ "version" : "2.5.0" } }, + { + "identity" : "elegant-emoji-picker", + "kind" : "remoteSourceControl", + "location" : "https://github.com/Finalet/Elegant-Emoji-Picker", + "state" : { + "branch" : "main", + "revision" : "71d2d46092b4d550cc593614efc06438f845f6e6" + } + }, { "identity" : "ink", "kind" : "remoteSourceControl", diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index 884993f542..7459afe4f9 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -40,10 +40,16 @@ public enum ChatCommand { case testStorageEncryption(key: String) case apiSaveSettings(settings: AppSettings) case apiGetSettings(settings: AppSettings) + case apiGetChatTags(userId: Int64) case apiGetChats(userId: Int64) case apiGetChat(type: ChatType, id: Int64, pagination: ChatPagination, search: String) case apiGetChatItemInfo(type: ChatType, id: Int64, itemId: Int64) case apiSendMessages(type: ChatType, id: Int64, live: Bool, ttl: Int?, composedMessages: [ComposedMessage]) + case apiCreateChatTag(tag: ChatTagData) + case apiSetChatTags(type: ChatType, id: Int64, tagIds: [Int64]) + case apiDeleteChatTag(tagId: Int64) + case apiUpdateChatTag(tagId: Int64, tagData: ChatTagData) + case apiReorderChatTags(tagIds: [Int64]) case apiCreateChatItems(noteFolderId: Int64, composedMessages: [ComposedMessage]) case apiUpdateChatItem(type: ChatType, id: Int64, itemId: Int64, msg: MsgContent, live: Bool) case apiDeleteChatItem(type: ChatType, id: Int64, itemIds: [Int64], mode: CIDeleteMode) @@ -198,6 +204,7 @@ public enum ChatCommand { case let .testStorageEncryption(key): return "/db test key \(key)" case let .apiSaveSettings(settings): return "/_save app settings \(encodeJSON(settings))" case let .apiGetSettings(settings): return "/_get app settings \(encodeJSON(settings))" + case let .apiGetChatTags(userId): return "/_get tags \(userId)" case let .apiGetChats(userId): return "/_get chats \(userId) pcc=on" case let .apiGetChat(type, id, pagination, search): return "/_get chat \(ref(type, id)) \(pagination.cmdString)" + (search == "" ? "" : " search=\(search)") @@ -206,6 +213,11 @@ public enum ChatCommand { let msgs = encodeJSON(composedMessages) let ttlStr = ttl != nil ? "\(ttl!)" : "default" return "/_send \(ref(type, id)) live=\(onOff(live)) ttl=\(ttlStr) json \(msgs)" + case let .apiCreateChatTag(tag): return "/_create tag \(encodeJSON(tag))" + case let .apiSetChatTags(type, id, tagIds): return "/_tags \(ref(type, id)) \(tagIds.map({ "\($0)" }).joined(separator: ","))" + case let .apiDeleteChatTag(tagId): return "/_delete tag \(tagId)" + case let .apiUpdateChatTag(tagId, tagData): return "/_update tag \(tagId) \(encodeJSON(tagData))" + case let .apiReorderChatTags(tagIds): return "/_reorder tags \(tagIds.map({ "\($0)" }).joined(separator: ","))" case let .apiCreateChatItems(noteFolderId, composedMessages): let msgs = encodeJSON(composedMessages) return "/_create *\(noteFolderId) json \(msgs)" @@ -367,10 +379,16 @@ public enum ChatCommand { case .testStorageEncryption: return "testStorageEncryption" case .apiSaveSettings: return "apiSaveSettings" case .apiGetSettings: return "apiGetSettings" + case .apiGetChatTags: return "apiGetChatTags" case .apiGetChats: return "apiGetChats" case .apiGetChat: return "apiGetChat" case .apiGetChatItemInfo: return "apiGetChatItemInfo" case .apiSendMessages: return "apiSendMessages" + case .apiCreateChatTag: return "apiCreateChatTag" + case .apiSetChatTags: return "apiSetChatTags" + case .apiDeleteChatTag: return "apiDeleteChatTag" + case .apiUpdateChatTag: return "apiUpdateChatTag" + case .apiReorderChatTags: return "apiReorderChatTags" case .apiCreateChatItems: return "apiCreateChatItems" case .apiUpdateChatItem: return "apiUpdateChatItem" case .apiDeleteChatItem: return "apiDeleteChatItem" @@ -564,6 +582,7 @@ public enum ChatResponse: Decodable, Error { case chatSuspended case apiChats(user: UserRef, chats: [ChatData]) case apiChat(user: UserRef, chat: ChatData) + case chatTags(user: UserRef, userTags: [ChatTag]) case chatItemInfo(user: UserRef, chatItem: AChatItem, chatItemInfo: ChatItemInfo) case serverTestResult(user: UserRef, testServer: String, testFailure: ProtocolTestFailure?) case serverOperatorConditions(conditions: ServerOperatorConditions) @@ -590,6 +609,7 @@ public enum ChatResponse: Decodable, Error { case contactCode(user: UserRef, contact: Contact, connectionCode: String) case groupMemberCode(user: UserRef, groupInfo: GroupInfo, member: GroupMember, connectionCode: String) case connectionVerified(user: UserRef, verified: Bool, expectedCode: String) + case tagsUpdated(user: UserRef, userTags: [ChatTag], chatTags: [Int64]) case invitation(user: UserRef, connReqInvitation: String, connection: PendingContactConnection) case connectionIncognitoUpdated(user: UserRef, toConnection: PendingContactConnection) case connectionUserChanged(user: UserRef, fromConnection: PendingContactConnection, toConnection: PendingContactConnection, newUser: UserRef) @@ -741,6 +761,7 @@ public enum ChatResponse: Decodable, Error { case .chatSuspended: return "chatSuspended" case .apiChats: return "apiChats" case .apiChat: return "apiChat" + case .chatTags: return "chatTags" case .chatItemInfo: return "chatItemInfo" case .serverTestResult: return "serverTestResult" case .serverOperatorConditions: return "serverOperators" @@ -767,6 +788,7 @@ public enum ChatResponse: Decodable, Error { case .contactCode: return "contactCode" case .groupMemberCode: return "groupMemberCode" case .connectionVerified: return "connectionVerified" + case .tagsUpdated: return "tagsUpdated" case .invitation: return "invitation" case .connectionIncognitoUpdated: return "connectionIncognitoUpdated" case .connectionUserChanged: return "connectionUserChanged" @@ -914,6 +936,7 @@ public enum ChatResponse: Decodable, Error { case .chatSuspended: return noDetails case let .apiChats(u, chats): return withUser(u, String(describing: chats)) case let .apiChat(u, chat): return withUser(u, String(describing: chat)) + case let .chatTags(u, userTags): return withUser(u, "userTags: \(String(describing: userTags))") case let .chatItemInfo(u, chatItem, chatItemInfo): return withUser(u, "chatItem: \(String(describing: chatItem))\nchatItemInfo: \(String(describing: chatItemInfo))") case let .serverTestResult(u, server, testFailure): return withUser(u, "server: \(server)\nresult: \(String(describing: testFailure))") case let .serverOperatorConditions(conditions): return "conditions: \(String(describing: conditions))" @@ -942,6 +965,7 @@ public enum ChatResponse: Decodable, Error { case let .contactCode(u, contact, connectionCode): return withUser(u, "contact: \(String(describing: contact))\nconnectionCode: \(connectionCode)") case let .groupMemberCode(u, groupInfo, member, connectionCode): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nconnectionCode: \(connectionCode)") case let .connectionVerified(u, verified, expectedCode): return withUser(u, "verified: \(verified)\nconnectionCode: \(expectedCode)") + case let .tagsUpdated(u, userTags, chatTags): return withUser(u, "userTags: \(String(describing: userTags))\nchatTags: \(String(describing: chatTags))") case let .invitation(u, connReqInvitation, connection): return withUser(u, "connReqInvitation: \(connReqInvitation)\nconnection: \(connection)") case let .connectionIncognitoUpdated(u, toConnection): return withUser(u, String(describing: toConnection)) case let .connectionUserChanged(u, fromConnection, toConnection, newUser): return withUser(u, "fromConnection: \(String(describing: fromConnection))\ntoConnection: \(String(describing: toConnection))\newUserId: \(String(describing: newUser.userId))") @@ -1172,6 +1196,16 @@ public enum ChatPagination { } } +public struct ChatTagData: Encodable { + public var emoji: String? + public var text: String + + public init(emoji: String?, text: String) { + self.emoji = emoji + self.text = text + } +} + public struct ComposedMessage: Encodable { public var fileSource: CryptoFile? var quotedItemId: Int64? @@ -1290,7 +1324,7 @@ public struct ServerOperatorConditions: Decodable { } public enum ConditionsAcceptance: Equatable, Codable, Hashable { - case accepted(acceptedAt: Date?) + case accepted(acceptedAt: Date?, autoAccepted: Bool) // If deadline is present, it means there's a grace period to review and accept conditions during which user can continue to use the operator. // No deadline indicates it's required to accept conditions for the operator to start using it. case required(deadline: Date?) @@ -1364,7 +1398,7 @@ public struct ServerOperator: Identifiable, Equatable, Codable { tradeName: "SimpleX Chat", legalName: "SimpleX Chat Ltd", serverDomains: ["simplex.im"], - conditionsAcceptance: .accepted(acceptedAt: nil), + conditionsAcceptance: .accepted(acceptedAt: nil, autoAccepted: false), enabled: true, smpRoles: ServerRoles(storage: true, proxy: true), xftpRoles: ServerRoles(storage: true, proxy: true) @@ -1397,7 +1431,7 @@ public struct UserOperatorServers: Identifiable, Equatable, Codable { tradeName: "", legalName: "", serverDomains: [], - conditionsAcceptance: .accepted(acceptedAt: nil), + conditionsAcceptance: .accepted(acceptedAt: nil, autoAccepted: false), enabled: false, smpRoles: ServerRoles(storage: true, proxy: true), xftpRoles: ServerRoles(storage: true, proxy: true) @@ -2000,6 +2034,10 @@ public struct ConnectionStats: Decodable, Hashable { public var ratchetSyncSendProhibited: Bool { [.required, .started, .agreed].contains(ratchetSyncState) } + + public var ratchetSyncInProgress: Bool { + [.started, .agreed].contains(ratchetSyncState) + } } public struct RcvQueueInfo: Codable, Hashable { diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index da1ce24b73..b1a318c896 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -1334,6 +1334,13 @@ public enum ChatInfo: Identifiable, Decodable, NamedChat, Hashable { } } + public var contactCard: Bool { + switch self { + case let .direct(contact): contact.activeConn == nil && contact.profile.contactLink != nil && contact.active + default: false + } + } + public var groupInfo: GroupInfo? { switch self { case let .group(groupInfo): return groupInfo @@ -1444,6 +1451,14 @@ public enum ChatInfo: Identifiable, Decodable, NamedChat, Hashable { default: return nil } } + + public var chatTags: [Int64]? { + switch self { + case let .direct(contact): return contact.chatTags + case let .group(groupInfo): return groupInfo.chatTags + default: return nil + } + } var createdAt: Date { switch self { @@ -1545,6 +1560,7 @@ public struct Contact: Identifiable, Decodable, NamedChat, Hashable { var chatTs: Date? var contactGroupMemberId: Int64? var contactGrpInvSent: Bool + public var chatTags: [Int64] public var uiThemes: ThemeModeOverrides? public var chatDeleted: Bool @@ -1615,6 +1631,7 @@ public struct Contact: Identifiable, Decodable, NamedChat, Hashable { createdAt: .now, updatedAt: .now, contactGrpInvSent: false, + chatTags: [], chatDeleted: false ) } @@ -1910,6 +1927,7 @@ public struct GroupInfo: Identifiable, Decodable, NamedChat, Hashable { public var fullName: String { get { groupProfile.fullName } } public var image: String? { get { groupProfile.image } } public var localAlias: String { "" } + public var chatTags: [Int64] public var isOwner: Bool { return membership.memberRole == .owner && membership.memberCurrent @@ -1932,7 +1950,8 @@ public struct GroupInfo: Identifiable, Decodable, NamedChat, Hashable { hostConnCustomUserProfileId: nil, chatSettings: ChatSettings.defaults, createdAt: .now, - updatedAt: .now + updatedAt: .now, + chatTags: [] ) } @@ -1991,6 +2010,14 @@ public struct GroupMember: Identifiable, Decodable, Hashable { public var activeConn: Connection? public var id: String { "#\(groupId) @\(groupMemberId)" } + public var ready: Bool { get { activeConn?.connStatus == .ready } } + public var sndReady: Bool { get { ready || activeConn?.connStatus == .sndReady } } + public var sendMsgEnabled: Bool { get { + sndReady + && memberCurrent + && !(activeConn?.connectionStats?.ratchetSyncSendProhibited ?? false) + && !(activeConn?.connDisabled ?? true) + } } public var displayName: String { get { let p = memberProfile @@ -4210,6 +4237,20 @@ public enum ChatItemTTL: Identifiable, Comparable, Hashable { } } +public struct ChatTag: Decodable, Hashable { + public var chatTagId: Int64 + public var chatTagText: String + public var chatTagEmoji: String? + + public var id: Int64 { chatTagId } + + public init(chatTagId: Int64, chatTagText: String, chatTagEmoji: String?) { + self.chatTagId = chatTagId + self.chatTagText = chatTagText + self.chatTagEmoji = chatTagEmoji + } +} + public struct ChatItemInfo: Decodable, Hashable { public var itemVersions: [ChatItemVersion] public var memberDeliveryStatuses: [MemberDeliveryStatus]? diff --git a/apps/ios/de.lproj/Localizable.strings b/apps/ios/de.lproj/Localizable.strings index a510b30477..cad89ed29a 100644 --- a/apps/ios/de.lproj/Localizable.strings +++ b/apps/ios/de.lproj/Localizable.strings @@ -343,6 +343,9 @@ /* No comment provided by engineer. */ "Abort changing address?" = "Wechsel der Empfängeradresse beenden?"; +/* No comment provided by engineer. */ +"About operators" = "Über Betreiber"; + /* No comment provided by engineer. */ "About SimpleX Chat" = "Über SimpleX Chat"; @@ -376,6 +379,9 @@ /* No comment provided by engineer. */ "Accepted conditions" = "Akzeptierte Nutzungsbedingungen"; +/* chat list item title */ +"accepted invitation" = "Einladung akzeptiert"; + /* No comment provided by engineer. */ "Acknowledged" = "Bestätigt"; @@ -388,6 +394,9 @@ /* No comment provided by engineer. */ "Add address to your profile, so that your contacts can share it with other people. Profile update will be sent to your contacts." = "Fügen Sie die Adresse Ihrem Profil hinzu, damit Ihre Kontakte sie mit anderen Personen teilen können. Es wird eine Profilaktualisierung an Ihre Kontakte gesendet."; +/* No comment provided by engineer. */ +"Add friends" = "Freunde aufnehmen"; + /* No comment provided by engineer. */ "Add profile" = "Profil hinzufügen"; @@ -397,12 +406,18 @@ /* No comment provided by engineer. */ "Add servers by scanning QR codes." = "Fügen Sie Server durch Scannen der QR Codes hinzu."; +/* No comment provided by engineer. */ +"Add team members" = "Team-Mitglieder aufnehmen"; + /* No comment provided by engineer. */ "Add to another device" = "Einem anderen Gerät hinzufügen"; /* No comment provided by engineer. */ "Add welcome message" = "Begrüßungsmeldung hinzufügen"; +/* No comment provided by engineer. */ +"Add your team members to the conversations." = "Nehmen Sie Team-Mitglieder in Ihre Unterhaltungen auf."; + /* No comment provided by engineer. */ "Added media & file servers" = "Medien- und Dateiserver hinzugefügt"; @@ -464,7 +479,7 @@ "All data is erased when it is entered." = "Alle Daten werden gelöscht, sobald dieser eingegeben wird."; /* No comment provided by engineer. */ -"All data is private to your device." = "Alle Daten werden nur auf Ihrem Gerät gespeichert."; +"All data is kept private on your device." = "Alle Daten werden nur auf Ihrem Gerät gespeichert."; /* No comment provided by engineer. */ "All group members will remain connected." = "Alle Gruppenmitglieder bleiben verbunden."; @@ -793,6 +808,12 @@ /* No comment provided by engineer. */ "Bulgarian, Finnish, Thai and Ukrainian - thanks to the users and [Weblate](https://github.com/simplex-chat/simplex-chat/tree/stable#help-translating-simplex-chat)!" = "Bulgarisch, Finnisch, Thailändisch und Ukrainisch - Dank der Nutzer und [Weblate](https://github.com/simplex-chat/simplex-chat/tree/stable#help-translating-simplex-chat)!"; +/* No comment provided by engineer. */ +"Business address" = "Geschäftliche Adresse"; + +/* No comment provided by engineer. */ +"Business chats" = "Geschäftliche Chats"; + /* No comment provided by engineer. */ "By chat profile (default) or [by connection](https://simplex.chat/blog/20230204-simplex-chat-v4-5-user-chat-profiles.html#transport-isolation) (BETA)." = "Per Chat-Profil (Voreinstellung) oder [per Verbindung](https://simplex.chat/blog/20230204-simplex-chat-v4-5-user-chat-profiles.html#transport-isolation) (BETA)."; @@ -909,6 +930,15 @@ /* chat item text */ "changing address…" = "Wechsel der Empfängeradresse wurde gestartet…"; +/* No comment provided by engineer. */ +"Chat" = "Chat"; + +/* No comment provided by engineer. */ +"Chat already exists" = "Chat besteht bereits"; + +/* No comment provided by engineer. */ +"Chat already exists!" = "Chat besteht bereits!"; + /* No comment provided by engineer. */ "Chat colors" = "Chat-Farben"; @@ -954,6 +984,12 @@ /* No comment provided by engineer. */ "Chat theme" = "Chat-Design"; +/* No comment provided by engineer. */ +"Chat will be deleted for all members - this cannot be undone!" = "Der Chat wird für alle Mitglieder gelöscht. Dies kann nicht rückgängig gemacht werden!"; + +/* No comment provided by engineer. */ +"Chat will be deleted for you - this cannot be undone!" = "Der Chat wird für Sie gelöscht. Dies kann nicht rückgängig gemacht werden!"; + /* No comment provided by engineer. */ "Chats" = "Chats"; @@ -1475,12 +1511,18 @@ /* No comment provided by engineer. */ "Delete and notify contact" = "Kontakt löschen und benachrichtigen"; +/* No comment provided by engineer. */ +"Delete chat" = "Chat löschen"; + /* No comment provided by engineer. */ "Delete chat profile" = "Chat-Profil löschen"; /* No comment provided by engineer. */ "Delete chat profile?" = "Chat-Profil löschen?"; +/* No comment provided by engineer. */ +"Delete chat?" = "Chat löschen?"; + /* No comment provided by engineer. */ "Delete connection" = "Verbindung löschen"; @@ -1655,6 +1697,9 @@ /* chat feature */ "Direct messages" = "Direkte Nachrichten"; +/* No comment provided by engineer. */ +"Direct messages between members are prohibited in this chat." = "In diesem Chat sind Direktnachrichten zwischen Mitgliedern nicht erlaubt."; + /* No comment provided by engineer. */ "Direct messages between members are prohibited." = "In dieser Gruppe sind Direktnachrichten zwischen Mitgliedern nicht erlaubt."; @@ -2694,6 +2739,9 @@ /* No comment provided by engineer. */ "Invite members" = "Mitglieder einladen"; +/* No comment provided by engineer. */ +"Invite to chat" = "Zum Chat einladen"; + /* No comment provided by engineer. */ "Invite to group" = "In Gruppe einladen"; @@ -2808,6 +2856,12 @@ /* swipe action */ "Leave" = "Verlassen"; +/* No comment provided by engineer. */ +"Leave chat" = "Chat verlassen"; + +/* No comment provided by engineer. */ +"Leave chat?" = "Chat verlassen?"; + /* No comment provided by engineer. */ "Leave group" = "Gruppe verlassen"; @@ -2904,12 +2958,18 @@ /* item status text */ "Member inactive" = "Mitglied inaktiv"; +/* No comment provided by engineer. */ +"Member role will be changed to \"%@\". All chat members will be notified." = "Die Rolle des Mitglieds wird auf \"%@\" geändert. Alle Chat-Mitglieder werden darüber informiert."; + /* No comment provided by engineer. */ "Member role will be changed to \"%@\". All group members will be notified." = "Die Mitgliederrolle wird auf \"%@\" geändert. Alle Mitglieder der Gruppe werden benachrichtigt."; /* No comment provided by engineer. */ "Member role will be changed to \"%@\". The member will receive a new invitation." = "Die Mitgliederrolle wird auf \"%@\" geändert. Das Mitglied wird eine neue Einladung erhalten."; +/* No comment provided by engineer. */ +"Member will be removed from chat - this cannot be undone!" = "Das Mitglied wird aus dem Chat entfernt. Dies kann nicht rückgängig gemacht werden!"; + /* No comment provided by engineer. */ "Member will be removed from group - this cannot be undone!" = "Das Mitglied wird aus der Gruppe entfernt. Dies kann nicht rückgängig gemacht werden!"; @@ -3329,6 +3389,9 @@ /* No comment provided by engineer. */ "Onion hosts will not be used." = "Onion-Hosts werden nicht verwendet."; +/* No comment provided by engineer. */ +"Only chat owners can change preferences." = "Nur Chat-Eigentümer können die Präferenzen ändern."; + /* No comment provided by engineer. */ "Only client devices store user profiles, contacts, groups, and messages." = "Nur die Endgeräte speichern die Benutzerprofile, Kontakte, Gruppen und Nachrichten, welche über eine **2-Schichten Ende-zu-Ende-Verschlüsselung** gesendet werden."; @@ -3407,6 +3470,9 @@ /* alert title */ "Operator server" = "Betreiber-Server"; +/* No comment provided by engineer. */ +"Or import archive file" = "Oder importieren Sie eine Archiv-Datei"; + /* No comment provided by engineer. */ "Or paste archive link" = "Oder fügen Sie den Archiv-Link ein"; @@ -3575,6 +3641,9 @@ /* No comment provided by engineer. */ "Privacy & security" = "Datenschutz & Sicherheit"; +/* No comment provided by engineer. */ +"Privacy for your customers." = "Schutz der Privatsphäre Ihrer Kunden."; + /* No comment provided by engineer. */ "Privacy redefined" = "Datenschutz neu definiert"; @@ -3867,6 +3936,9 @@ /* chat item action */ "Reply" = "Antwort"; +/* chat list item title */ +"requested to connect" = "Zur Verbindung aufgefordert"; + /* No comment provided by engineer. */ "Required" = "Erforderlich"; @@ -4574,6 +4646,9 @@ /* No comment provided by engineer. */ "Tap button " = "Schaltfläche antippen "; +/* No comment provided by engineer. */ +"Tap Create SimpleX address in the menu to create it later." = "Tippen Sie im Menü auf SimpleX-Adresse erstellen, um sie später zu erstellen."; + /* No comment provided by engineer. */ "Tap to activate profile." = "Zum Aktivieren des Profils tippen."; @@ -4704,10 +4779,10 @@ "The sender will NOT be notified" = "Der Absender wird NICHT benachrichtigt"; /* No comment provided by engineer. */ -"The servers for new connections of your current chat profile **%@**." = "Mögliche Server für neue Verbindungen von Ihrem aktuellen Chat-Profil **%@**."; +"The servers for new connections of your current chat profile **%@**." = "Nachrichten-Server für neue Verbindungen über Ihr aktuelles Chat-Profil **%@**."; /* No comment provided by engineer. */ -"The servers for new files of your current chat profile **%@**." = "Die Server Deines aktuellen Chat-Profils für neue Dateien **%@**."; +"The servers for new files of your current chat profile **%@**." = "Medien- und Datei-Server für neue Daten über Ihr aktuelles Chat-Profil **%@**."; /* No comment provided by engineer. */ "The text you pasted is not a SimpleX link." = "Der von Ihnen eingefügte Text ist kein SimpleX-Link."; @@ -5282,6 +5357,9 @@ /* No comment provided by engineer. */ "You are already connected to %@." = "Sie sind bereits mit %@ verbunden."; +/* No comment provided by engineer. */ +"You are already connected with %@." = "Sie sind bereits mit %@ verbunden."; + /* No comment provided by engineer. */ "You are already connecting to %@." = "Sie sind bereits mit %@ verbunden."; @@ -5480,6 +5558,9 @@ /* No comment provided by engineer. */ "You will still receive calls and notifications from muted profiles when they are active." = "Sie können Anrufe und Benachrichtigungen auch von stummgeschalteten Profilen empfangen, solange diese aktiv sind."; +/* No comment provided by engineer. */ +"You will stop receiving messages from this chat. Chat history will be preserved." = "Sie werden von diesem Chat keine Nachrichten mehr erhalten. Der Nachrichtenverlauf wird beibehalten."; + /* No comment provided by engineer. */ "You will stop receiving messages from this group. Chat history will be preserved." = "Sie werden von dieser Gruppe keine Nachrichten mehr erhalten. Der Nachrichtenverlauf wird beibehalten."; diff --git a/apps/ios/es.lproj/Localizable.strings b/apps/ios/es.lproj/Localizable.strings index 9c0b815ad4..e7570f177e 100644 --- a/apps/ios/es.lproj/Localizable.strings +++ b/apps/ios/es.lproj/Localizable.strings @@ -343,6 +343,9 @@ /* No comment provided by engineer. */ "Abort changing address?" = "¿Cancelar el cambio de servidor?"; +/* No comment provided by engineer. */ +"About operators" = "Acerca de los operadores"; + /* No comment provided by engineer. */ "About SimpleX Chat" = "Sobre SimpleX Chat"; @@ -376,6 +379,9 @@ /* No comment provided by engineer. */ "Accepted conditions" = "Condiciones aceptadas"; +/* chat list item title */ +"accepted invitation" = "invitación aceptada"; + /* No comment provided by engineer. */ "Acknowledged" = "Confirmaciones"; @@ -388,6 +394,9 @@ /* No comment provided by engineer. */ "Add address to your profile, so that your contacts can share it with other people. Profile update will be sent to your contacts." = "Añade la dirección a tu perfil para que tus contactos puedan compartirla con otros. La actualización del perfil se enviará a tus contactos."; +/* No comment provided by engineer. */ +"Add friends" = "Añadir amigos"; + /* No comment provided by engineer. */ "Add profile" = "Añadir perfil"; @@ -397,12 +406,18 @@ /* No comment provided by engineer. */ "Add servers by scanning QR codes." = "Añadir servidores mediante el escaneo de códigos QR."; +/* No comment provided by engineer. */ +"Add team members" = "Añadir miembros del equipo"; + /* No comment provided by engineer. */ "Add to another device" = "Añadir a otro dispositivo"; /* No comment provided by engineer. */ "Add welcome message" = "Añadir mensaje de bienvenida"; +/* No comment provided by engineer. */ +"Add your team members to the conversations." = "Añade a los miembros de tu equipo a las conversaciones."; + /* No comment provided by engineer. */ "Added media & file servers" = "Servidores de archivos y multimedia añadidos"; @@ -464,7 +479,7 @@ "All data is erased when it is entered." = "Al introducirlo todos los datos son eliminados."; /* No comment provided by engineer. */ -"All data is private to your device." = "Todos los datos son privados y están en tu dispositivo."; +"All data is kept private on your device." = "Todos los datos son privados y están en tu dispositivo."; /* No comment provided by engineer. */ "All group members will remain connected." = "Todos los miembros del grupo permanecerán conectados."; @@ -793,6 +808,12 @@ /* No comment provided by engineer. */ "Bulgarian, Finnish, Thai and Ukrainian - thanks to the users and [Weblate](https://github.com/simplex-chat/simplex-chat/tree/stable#help-translating-simplex-chat)!" = "Búlgaro, Finlandés, Tailandés y Ucraniano - gracias a los usuarios y [Weblate](https://github.com/simplex-chat/simplex-chat/tree/stable#help-translating-simplex-chat)!"; +/* No comment provided by engineer. */ +"Business address" = "Dirección empresarial"; + +/* No comment provided by engineer. */ +"Business chats" = "Chats empresariales"; + /* No comment provided by engineer. */ "By chat profile (default) or [by connection](https://simplex.chat/blog/20230204-simplex-chat-v4-5-user-chat-profiles.html#transport-isolation) (BETA)." = "Mediante perfil (predeterminado) o [por conexión](https://simplex.chat/blog/20230204-simplex-chat-v4-5-user-chat-profiles.html#transport-isolation) (BETA)."; @@ -909,6 +930,15 @@ /* chat item text */ "changing address…" = "cambiando de servidor…"; +/* No comment provided by engineer. */ +"Chat" = "Chat"; + +/* No comment provided by engineer. */ +"Chat already exists" = "El chat ya existe"; + +/* No comment provided by engineer. */ +"Chat already exists!" = "¡El chat ya existe!"; + /* No comment provided by engineer. */ "Chat colors" = "Colores del chat"; @@ -954,6 +984,12 @@ /* No comment provided by engineer. */ "Chat theme" = "Tema de chat"; +/* No comment provided by engineer. */ +"Chat will be deleted for all members - this cannot be undone!" = "El chat será eliminado para todos los miembros. ¡No podrá deshacerse!"; + +/* No comment provided by engineer. */ +"Chat will be deleted for you - this cannot be undone!" = "El chat será eliminado para tí. ¡No podrá deshacerse!"; + /* No comment provided by engineer. */ "Chats" = "Chats"; @@ -1475,12 +1511,18 @@ /* No comment provided by engineer. */ "Delete and notify contact" = "Eliminar y notificar contacto"; +/* No comment provided by engineer. */ +"Delete chat" = "Eliminar chat"; + /* No comment provided by engineer. */ "Delete chat profile" = "Eliminar perfil"; /* No comment provided by engineer. */ "Delete chat profile?" = "¿Eliminar perfil?"; +/* No comment provided by engineer. */ +"Delete chat?" = "¿Eliminar chat?"; + /* No comment provided by engineer. */ "Delete connection" = "Eliminar conexión"; @@ -1500,7 +1542,7 @@ "Delete file" = "Eliminar archivo"; /* No comment provided by engineer. */ -"Delete files and media?" = "Eliminar archivos y multimedia?"; +"Delete files and media?" = "¿Eliminar archivos y multimedia?"; /* No comment provided by engineer. */ "Delete files for all chat profiles" = "Eliminar archivos de todos los perfiles"; @@ -1655,6 +1697,9 @@ /* chat feature */ "Direct messages" = "Mensajes directos"; +/* No comment provided by engineer. */ +"Direct messages between members are prohibited in this chat." = "Mensajes directos no permitidos entre miembros de este chat."; + /* No comment provided by engineer. */ "Direct messages between members are prohibited." = "Los mensajes directos entre miembros del grupo no están permitidos."; @@ -1798,7 +1843,7 @@ "Enable camera access" = "Permitir acceso a la cámara"; /* No comment provided by engineer. */ -"Enable Flux" = "Habilitar Flux"; +"Enable Flux" = "Habilita Flux"; /* No comment provided by engineer. */ "Enable for all" = "Activar para todos"; @@ -2296,7 +2341,7 @@ "Fix not supported by group member" = "Corrección no compatible con miembro del grupo"; /* No comment provided by engineer. */ -"for better metadata privacy." = "para mayor privacidad de los metadatos."; +"for better metadata privacy." = "para mejorar la privacidad de los metadatos."; /* servers error */ "For chat profile %@:" = "Para el perfil de chat %@:"; @@ -2694,6 +2739,9 @@ /* No comment provided by engineer. */ "Invite members" = "Invitar miembros"; +/* No comment provided by engineer. */ +"Invite to chat" = "Invitar al chat"; + /* No comment provided by engineer. */ "Invite to group" = "Invitar al grupo"; @@ -2808,6 +2856,12 @@ /* swipe action */ "Leave" = "Salir"; +/* No comment provided by engineer. */ +"Leave chat" = "Salir del chat"; + +/* No comment provided by engineer. */ +"Leave chat?" = "¿Salir del chat?"; + /* No comment provided by engineer. */ "Leave group" = "Salir del grupo"; @@ -2904,12 +2958,18 @@ /* item status text */ "Member inactive" = "Miembro inactivo"; +/* No comment provided by engineer. */ +"Member role will be changed to \"%@\". All chat members will be notified." = "El rol del miembro cambiará a \"%@\" y todos serán notificados."; + /* No comment provided by engineer. */ "Member role will be changed to \"%@\". All group members will be notified." = "El rol del miembro cambiará a \"%@\" y se notificará al grupo."; /* No comment provided by engineer. */ "Member role will be changed to \"%@\". The member will receive a new invitation." = "El rol del miembro cambiará a \"%@\" y recibirá una invitación nueva."; +/* No comment provided by engineer. */ +"Member will be removed from chat - this cannot be undone!" = "El miembro será eliminado del chat. ¡No podrá deshacerse!"; + /* No comment provided by engineer. */ "Member will be removed from group - this cannot be undone!" = "El miembro será expulsado del grupo. ¡No podrá deshacerse!"; @@ -3329,6 +3389,9 @@ /* No comment provided by engineer. */ "Onion hosts will not be used." = "No se usarán hosts .onion."; +/* No comment provided by engineer. */ +"Only chat owners can change preferences." = "Sólo los propietarios del chat pueden cambiar las preferencias."; + /* No comment provided by engineer. */ "Only client devices store user profiles, contacts, groups, and messages." = "Sólo los dispositivos cliente almacenan perfiles de usuario, contactos, grupos y mensajes enviados con **cifrado de extremo a extremo de 2 capas**."; @@ -3407,6 +3470,9 @@ /* alert title */ "Operator server" = "Servidor del operador"; +/* No comment provided by engineer. */ +"Or import archive file" = "O importa desde un archivo"; + /* No comment provided by engineer. */ "Or paste archive link" = "O pegar enlace del archivo"; @@ -3561,7 +3627,7 @@ "Preserve the last message draft, with attachments." = "Conserva el último borrador del mensaje con los datos adjuntos."; /* No comment provided by engineer. */ -"Preset server address" = "Dirección del servidor predefinida"; +"Preset server address" = "Dirección predefinida del servidor"; /* No comment provided by engineer. */ "Preset servers" = "Servidores predefinidos"; @@ -3575,6 +3641,9 @@ /* No comment provided by engineer. */ "Privacy & security" = "Seguridad y Privacidad"; +/* No comment provided by engineer. */ +"Privacy for your customers." = "Privacidad para tus clientes."; + /* No comment provided by engineer. */ "Privacy redefined" = "Privacidad redefinida"; @@ -3693,7 +3762,7 @@ "Read" = "Leer"; /* No comment provided by engineer. */ -"Read more" = "Conoce más"; +"Read more" = "Saber más"; /* No comment provided by engineer. */ "Read more in [User Guide](https://simplex.chat/docs/guide/chat-profiles.html#incognito-mode)." = "Conoce más en la [Guía del Usuario](https://simplex.chat/docs/guide/chat-profiles.html#incognito-mode)."; @@ -3867,6 +3936,9 @@ /* chat item action */ "Reply" = "Responder"; +/* chat list item title */ +"requested to connect" = "solicitado para conectar"; + /* No comment provided by engineer. */ "Required" = "Obligatorio"; @@ -4338,7 +4410,7 @@ "Share profile" = "Comparte perfil"; /* No comment provided by engineer. */ -"Share SimpleX address on social media." = "Compartir dirección SimpleX en redes sociales."; +"Share SimpleX address on social media." = "Comparte tu dirección SimpleX en redes sociales."; /* No comment provided by engineer. */ "Share this 1-time invite link" = "Comparte este enlace de un solo uso"; @@ -4386,10 +4458,10 @@ "SimpleX Address" = "Dirección SimpleX"; /* No comment provided by engineer. */ -"SimpleX address and 1-time links are safe to share via any messenger." = "Compartir enlaces de un uso y direcciones SimpleX es seguro a través de cualquier medio."; +"SimpleX address and 1-time links are safe to share via any messenger." = "Compartir los enlaces de un uso y las direcciones SimpleX es seguro a través de cualquier medio."; /* No comment provided by engineer. */ -"SimpleX address or 1-time link?" = "Dirección SimpleX o enlace de un uso?"; +"SimpleX address or 1-time link?" = "¿Dirección SimpleX o enlace de un uso?"; /* No comment provided by engineer. */ "SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app." = "Simplex Chat y Flux han acordado incluir servidores operados por Flux en la aplicación"; @@ -4574,6 +4646,9 @@ /* No comment provided by engineer. */ "Tap button " = "Pulsa el botón "; +/* No comment provided by engineer. */ +"Tap Create SimpleX address in the menu to create it later." = "Pulsa Crear dirección SimpleX en el menú para crearla más tarde."; + /* No comment provided by engineer. */ "Tap to activate profile." = "Pulsa sobre un perfil para activarlo."; @@ -4695,7 +4770,7 @@ "The same conditions will apply to operator(s): **%@**." = "Las mismas condiciones se aplicarán a el/los operador(es) **%@**."; /* No comment provided by engineer. */ -"The second preset operator in the app!" = "El segundo operador predefinido!"; +"The second preset operator in the app!" = "¡Segundo operador predefinido!"; /* No comment provided by engineer. */ "The second tick we missed! ✅" = "¡El doble check que nos faltaba! ✅"; @@ -4704,7 +4779,7 @@ "The sender will NOT be notified" = "El remitente NO será notificado"; /* No comment provided by engineer. */ -"The servers for new connections of your current chat profile **%@**." = "Lista de servidores para las conexiones nuevas de tu perfil actual **%@**."; +"The servers for new connections of your current chat profile **%@**." = "Lista de servidores para las conexiones nuevas del perfil **%@**."; /* No comment provided by engineer. */ "The servers for new files of your current chat profile **%@**." = "Los servidores para archivos nuevos en tu perfil actual **%@**."; @@ -5280,7 +5355,10 @@ "You already have a chat profile with the same display name. Please choose another name." = "Ya tienes un perfil con este nombre mostrado. Por favor, elige otro nombre."; /* No comment provided by engineer. */ -"You are already connected to %@." = "Ya estás conectado a %@."; +"You are already connected to %@." = "Ya estás conectado con %@."; + +/* No comment provided by engineer. */ +"You are already connected with %@." = "Ya estás conectado con %@."; /* No comment provided by engineer. */ "You are already connecting to %@." = "Ya estás conectando con %@."; @@ -5480,6 +5558,9 @@ /* No comment provided by engineer. */ "You will still receive calls and notifications from muted profiles when they are active." = "Seguirás recibiendo llamadas y notificaciones de los perfiles silenciados cuando estén activos."; +/* No comment provided by engineer. */ +"You will stop receiving messages from this chat. Chat history will be preserved." = "Dejarás de recibir mensajes de este chat. El historial del chat se conserva."; + /* No comment provided by engineer. */ "You will stop receiving messages from this group. Chat history will be preserved." = "Dejarás de recibir mensajes de este grupo. El historial del chat se conservará."; diff --git a/apps/ios/fr.lproj/Localizable.strings b/apps/ios/fr.lproj/Localizable.strings index 2de5997f07..6b973e75d0 100644 --- a/apps/ios/fr.lproj/Localizable.strings +++ b/apps/ios/fr.lproj/Localizable.strings @@ -431,7 +431,7 @@ "All data is erased when it is entered." = "Toutes les données sont effacées lorsqu'il est saisi."; /* No comment provided by engineer. */ -"All data is private to your device." = "Toutes les données restent confinées dans votre appareil."; +"All data is kept private on your device." = "Toutes les données restent confinées dans votre appareil."; /* No comment provided by engineer. */ "All group members will remain connected." = "Tous les membres du groupe resteront connectés."; diff --git a/apps/ios/hu.lproj/Localizable.strings b/apps/ios/hu.lproj/Localizable.strings index 58d28cd8ed..2ba51d1e13 100644 --- a/apps/ios/hu.lproj/Localizable.strings +++ b/apps/ios/hu.lproj/Localizable.strings @@ -344,7 +344,10 @@ "Abort changing address?" = "Címváltoztatás megszakítása??"; /* No comment provided by engineer. */ -"About SimpleX Chat" = "A SimpleX Chatről"; +"About operators" = "Az üzemeltetőkről"; + +/* No comment provided by engineer. */ +"About SimpleX Chat" = "SimpleX Chat névjegye"; /* No comment provided by engineer. */ "above, then choose:" = "gombra fent, majd válassza ki:"; @@ -376,6 +379,9 @@ /* No comment provided by engineer. */ "Accepted conditions" = "Elfogadott feltételek"; +/* chat list item title */ +"accepted invitation" = "elfogadott meghívó"; + /* No comment provided by engineer. */ "Acknowledged" = "Nyugtázva"; @@ -473,7 +479,7 @@ "All data is erased when it is entered." = "A jelkód megadása után az összes adat törlésre kerül."; /* No comment provided by engineer. */ -"All data is private to your device." = "Az összes adat biztonságban van az eszközén."; +"All data is kept private on your device." = "Az összes adat biztonságban van az eszközén."; /* No comment provided by engineer. */ "All group members will remain connected." = "Az összes csoporttag kapcsolatban marad."; @@ -879,7 +885,7 @@ "Change" = "Változtatás"; /* authentication reason */ -"Change chat profiles" = "Felhasználói profilok megváltoztatása"; +"Change chat profiles" = "Csevegési profilok megváltoztatása"; /* No comment provided by engineer. */ "Change database passphrase?" = "Adatbázis-jelmondat megváltoztatása?"; @@ -2344,7 +2350,7 @@ "For console" = "Konzolhoz"; /* No comment provided by engineer. */ -"For example, if your contact receives messages via a SimpleX Chat server, your app will deliver them via a Flux server." = "Ha például az ismerőse a SimpleX Chat kiszolgálón keresztül fogadja az üzeneteket, az Ön alkalmazása a Flux egyik kiszolgálóját használja a kézbesítéshez."; +"For example, if your contact receives messages via a SimpleX Chat server, your app will deliver them via a Flux server." = "Például, ha az Ön ismerőse egy SimpleX Chat-kiszolgálón keresztül fogadja az üzeneteket, az Ön alkalmazása egy Flux-kiszolgálón keresztül fogja azokat kézbesíteni."; /* No comment provided by engineer. */ "For private routing" = "A privát útválasztáshoz"; @@ -3708,7 +3714,7 @@ "Protect app screen" = "Alkalmazás képernyőjének védelme"; /* No comment provided by engineer. */ -"Protect IP address" = "IP-cím védelem"; +"Protect IP address" = "IP-cím védelme"; /* No comment provided by engineer. */ "Protect your chat profiles with a password!" = "Védje meg a csevegési profiljait egy jelszóval!"; @@ -3930,6 +3936,9 @@ /* chat item action */ "Reply" = "Válasz"; +/* chat list item title */ +"requested to connect" = "kérelmezve a kapcsolódáshoz"; + /* No comment provided by engineer. */ "Required" = "Szükséges"; @@ -4454,6 +4463,9 @@ /* No comment provided by engineer. */ "SimpleX address or 1-time link?" = "SimpleX-cím vagy egyszer használható meghívó-hivatkozás?"; +/* No comment provided by engineer. */ +"SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app." = "A SimpleX Chat és a Flux megállapodást kötött arról, hogy a Flux által üzemeltetett kiszolgálókat beépítik az alkalmazásba."; + /* No comment provided by engineer. */ "SimpleX Chat security was audited by Trail of Bits." = "A SimpleX Chat biztonsága a Trail of Bits által lett auditálva."; @@ -4752,7 +4764,7 @@ "The profile is only shared with your contacts." = "A profilja csak az ismerőseivel kerül megosztásra."; /* No comment provided by engineer. */ -"The same conditions will apply to operator **%@**." = "Ugyanezek a feltételek vonatkoznak a következő üzemeltetőre is: **%@**."; +"The same conditions will apply to operator **%@**." = "Ugyanezek a feltételek lesznek elfogadva a következő üzemeltetőre is: **%@**."; /* No comment provided by engineer. */ "The same conditions will apply to operator(s): **%@**." = "Ugyanezek a feltételek lesznek elfogadva a következő üzemeltető(k)re is: **%@**."; @@ -5397,7 +5409,7 @@ "You can configure operators in Network & servers settings." = "Az üzemeltetőket a „Hálózat és kiszolgálók” beállításaban konfigurálhatja."; /* No comment provided by engineer. */ -"You can configure servers via settings." = "A kiszolgálókat a beállításokon keresztül konfigurálhatja."; +"You can configure servers via settings." = "A kiszolgálókat a „Hálózat és kiszolgálók” menüben konfigurálhatja."; /* No comment provided by engineer. */ "You can create it later" = "Létrehozás később"; @@ -5427,7 +5439,7 @@ "You can set connection name, to remember who the link was shared with." = "Beállíthatja az ismerős nevét, hogy emlékezzen arra, hogy kivel osztotta meg a hivatkozást."; /* No comment provided by engineer. */ -"You can set lock screen notification preview via settings." = "A beállításokon keresztül beállíthatja a lezárási képernyő értesítési előnézetét."; +"You can set lock screen notification preview via settings." = "A lezárási képernyő értesítési előnézetét az „Értesítések” menüben állíthatja be."; /* No comment provided by engineer. */ "You can share a link or a QR code - anybody will be able to join the group. You won't lose members of the group if you later delete it." = "Megoszthat egy hivatkozást vagy QR-kódot - így bárki csatlakozhat a csoporthoz. Ha a csoport később törlésre kerül, akkor nem fogja elveszíteni annak tagjait."; diff --git a/apps/ios/it.lproj/Localizable.strings b/apps/ios/it.lproj/Localizable.strings index 25a672da26..7c3a7e05de 100644 --- a/apps/ios/it.lproj/Localizable.strings +++ b/apps/ios/it.lproj/Localizable.strings @@ -473,7 +473,7 @@ "All data is erased when it is entered." = "Tutti i dati vengono cancellati quando inserito."; /* No comment provided by engineer. */ -"All data is private to your device." = "Tutti i dati sono privati, nel tuo dispositivo."; +"All data is kept private on your device." = "Tutti i dati sono privati, nel tuo dispositivo."; /* No comment provided by engineer. */ "All group members will remain connected." = "Tutti i membri del gruppo resteranno connessi."; @@ -689,10 +689,10 @@ "Auto-accept" = "Accetta automaticamente"; /* No comment provided by engineer. */ -"Auto-accept contact requests" = "Auto-accetta richieste di contatto"; +"Auto-accept contact requests" = "Auto-accetta le richieste di contatto"; /* No comment provided by engineer. */ -"Auto-accept images" = "Auto-accetta immagini"; +"Auto-accept images" = "Auto-accetta le immagini"; /* alert title */ "Auto-accept settings" = "Accetta automaticamente le impostazioni"; @@ -779,7 +779,7 @@ "Blur for better privacy." = "Sfoca per una privacy maggiore."; /* No comment provided by engineer. */ -"Blur media" = "Sfocatura file multimediali"; +"Blur media" = "Sfocatura dei file multimediali"; /* No comment provided by engineer. */ "bold" = "grassetto"; @@ -3004,7 +3004,7 @@ "Message delivery warning" = "Avviso di consegna del messaggio"; /* No comment provided by engineer. */ -"Message draft" = "Bozza dei messaggi"; +"Message draft" = "Bozza del messaggio"; /* item status text */ "Message forwarded" = "Messaggio inoltrato"; @@ -3982,10 +3982,10 @@ "Reveal" = "Rivela"; /* No comment provided by engineer. */ -"Review conditions" = "Esamina le condizioni"; +"Review conditions" = "Leggi le condizioni"; /* No comment provided by engineer. */ -"Review later" = "Esamina più tardi"; +"Review later" = "Leggi più tardi"; /* No comment provided by engineer. */ "Revoke" = "Revoca"; @@ -4181,7 +4181,7 @@ "Send errors" = "Errori di invio"; /* No comment provided by engineer. */ -"Send link previews" = "Invia anteprime dei link"; +"Send link previews" = "Invia le anteprime dei link"; /* No comment provided by engineer. */ "Send live message" = "Invia messaggio in diretta"; @@ -4401,7 +4401,7 @@ "Share profile" = "Condividi il profilo"; /* No comment provided by engineer. */ -"Share SimpleX address on social media." = "Condividi indirizzo SimpleX sui social media."; +"Share SimpleX address on social media." = "Condividi l'indirizzo SimpleX sui social media."; /* No comment provided by engineer. */ "Share this 1-time invite link" = "Condividi questo link di invito una tantum"; @@ -4454,6 +4454,9 @@ /* No comment provided by engineer. */ "SimpleX address or 1-time link?" = "Indirizzo SimpleX o link una tantum?"; +/* No comment provided by engineer. */ +"SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app." = "SimpleX Chat e Flux hanno concluso un accordo per includere server gestiti da Flux nell'app"; + /* No comment provided by engineer. */ "SimpleX Chat security was audited by Trail of Bits." = "La sicurezza di SimpleX Chat è stata verificata da Trail of Bits."; @@ -4635,7 +4638,7 @@ "Tap button " = "Tocca il pulsante "; /* No comment provided by engineer. */ -"Tap Create SimpleX address in the menu to create it later." = "Tocca \"Crea indirizzo SimpleX\" nel menu per crearlo più tardi."; +"Tap Create SimpleX address in the menu to create it later." = "Tocca Crea indirizzo SimpleX nel menu per crearlo più tardi."; /* No comment provided by engineer. */ "Tap to activate profile." = "Tocca per attivare il profilo."; diff --git a/apps/ios/nl.lproj/Localizable.strings b/apps/ios/nl.lproj/Localizable.strings index ba28bd1f59..7004d0d124 100644 --- a/apps/ios/nl.lproj/Localizable.strings +++ b/apps/ios/nl.lproj/Localizable.strings @@ -343,6 +343,9 @@ /* No comment provided by engineer. */ "Abort changing address?" = "Adres wijziging afbreken?"; +/* No comment provided by engineer. */ +"About operators" = "Over operatoren"; + /* No comment provided by engineer. */ "About SimpleX Chat" = "Over SimpleX Chat"; @@ -376,6 +379,9 @@ /* No comment provided by engineer. */ "Accepted conditions" = "Geaccepteerde voorwaarden"; +/* chat list item title */ +"accepted invitation" = "geaccepteerde uitnodiging"; + /* No comment provided by engineer. */ "Acknowledged" = "Erkend"; @@ -473,7 +479,7 @@ "All data is erased when it is entered." = "Alle gegevens worden bij het invoeren gewist."; /* No comment provided by engineer. */ -"All data is private to your device." = "Alle gegevens zijn privé op uw apparaat."; +"All data is kept private on your device." = "Alle gegevens zijn privé op uw apparaat."; /* No comment provided by engineer. */ "All group members will remain connected." = "Alle groepsleden blijven verbonden."; @@ -3930,6 +3936,9 @@ /* chat item action */ "Reply" = "Antwoord"; +/* chat list item title */ +"requested to connect" = "gevraagd om verbinding te maken"; + /* No comment provided by engineer. */ "Required" = "Vereist"; diff --git a/apps/ios/pl.lproj/Localizable.strings b/apps/ios/pl.lproj/Localizable.strings index e48e9f2ed8..cc3bd228f9 100644 --- a/apps/ios/pl.lproj/Localizable.strings +++ b/apps/ios/pl.lproj/Localizable.strings @@ -431,7 +431,7 @@ "All data is erased when it is entered." = "Wszystkie dane są usuwane po jego wprowadzeniu."; /* No comment provided by engineer. */ -"All data is private to your device." = "Wszystkie dane są prywatne na Twoim urządzeniu."; +"All data is kept private on your device." = "Wszystkie dane są prywatne na Twoim urządzeniu."; /* No comment provided by engineer. */ "All group members will remain connected." = "Wszyscy członkowie grupy pozostaną połączeni."; diff --git a/apps/ios/ru.lproj/Localizable.strings b/apps/ios/ru.lproj/Localizable.strings index 09c95d4203..dcd3de19d1 100644 --- a/apps/ios/ru.lproj/Localizable.strings +++ b/apps/ios/ru.lproj/Localizable.strings @@ -83,7 +83,7 @@ "**Recommended**: device token and end-to-end encrypted notifications are sent to SimpleX Chat push server, but it does not see the message content, size or who it is from." = "**Рекомендовано**: токен устройства и уведомления отправляются на сервер SimpleX Chat, но сервер не получает сами сообщения, их размер или от кого они."; /* No comment provided by engineer. */ -"**Scan / Paste link**: to connect via a link you received." = "**Сканировать / Вставить ссылку**: чтобы соединится через полученную ссылку."; +"**Scan / Paste link**: to connect via a link you received." = "**Сканировать / Вставить ссылку**: чтобы соединиться через полученную ссылку."; /* No comment provided by engineer. */ "**Warning**: Instant push notifications require passphrase saved in Keychain." = "**Внимание**: для работы мгновенных уведомлений пароль должен быть сохранен в Keychain."; @@ -479,7 +479,7 @@ "All data is erased when it is entered." = "Все данные удаляются при его вводе."; /* No comment provided by engineer. */ -"All data is private to your device." = "Все данные хранятся только на вашем устройстве."; +"All data is kept private on your device." = "Все данные хранятся только на вашем устройстве."; /* No comment provided by engineer. */ "All group members will remain connected." = "Все члены группы, которые соединились через эту ссылку, останутся в группе."; @@ -3720,7 +3720,7 @@ "Protect your chat profiles with a password!" = "Защитите Ваши профили чата паролем!"; /* No comment provided by engineer. */ -"Protect your IP address from the messaging relays chosen by your contacts.\nEnable in *Network & servers* settings." = "Защитите ваш IP адрес от серверов сообщений, выбранных Вашими контактами.\nВключите в настройках *Сеть и серверы*."; +"Protect your IP address from the messaging relays chosen by your contacts.\nEnable in *Network & servers* settings." = "Защитите ваш IP адрес от серверов сообщений, выбранных Вашими контактами.\nВключите в настройках *Сети и серверов*."; /* No comment provided by engineer. */ "Protocol timeout" = "Таймаут протокола"; @@ -5406,7 +5406,7 @@ "You can change it in Appearance settings." = "Вы можете изменить это в настройках Интерфейса."; /* No comment provided by engineer. */ -"You can configure operators in Network & servers settings." = "Вы можете настроить операторов в настройках Сеть и серверы."; +"You can configure operators in Network & servers settings." = "Вы можете настроить операторов в настройках Сети и серверов."; /* No comment provided by engineer. */ "You can configure servers via settings." = "Вы можете настроить серверы позже."; diff --git a/apps/ios/tr.lproj/Localizable.strings b/apps/ios/tr.lproj/Localizable.strings index 3670e57955..b3eb5d426a 100644 --- a/apps/ios/tr.lproj/Localizable.strings +++ b/apps/ios/tr.lproj/Localizable.strings @@ -431,7 +431,7 @@ "All data is erased when it is entered." = "Kullanıldığında bütün veriler silinir."; /* No comment provided by engineer. */ -"All data is private to your device." = "Tüm veriler cihazınıza özeldir."; +"All data is kept private on your device." = "Tüm veriler cihazınıza özeldir."; /* No comment provided by engineer. */ "All group members will remain connected." = "Tüm grup üyeleri bağlı kalacaktır."; diff --git a/apps/ios/uk.lproj/Localizable.strings b/apps/ios/uk.lproj/Localizable.strings index 4e2b1680fd..ce8184272d 100644 --- a/apps/ios/uk.lproj/Localizable.strings +++ b/apps/ios/uk.lproj/Localizable.strings @@ -464,7 +464,7 @@ "All data is erased when it is entered." = "Всі дані стираються при введенні."; /* No comment provided by engineer. */ -"All data is private to your device." = "Всі дані є приватними для вашого пристрою."; +"All data is kept private on your device." = "Всі дані є приватними для вашого пристрою."; /* No comment provided by engineer. */ "All group members will remain connected." = "Всі учасники групи залишаться на зв'язку."; diff --git a/apps/ios/zh-Hans.lproj/Localizable.strings b/apps/ios/zh-Hans.lproj/Localizable.strings index c40833b67b..62ff2088c2 100644 --- a/apps/ios/zh-Hans.lproj/Localizable.strings +++ b/apps/ios/zh-Hans.lproj/Localizable.strings @@ -413,7 +413,7 @@ "All data is erased when it is entered." = "所有数据在输入后将被删除。"; /* No comment provided by engineer. */ -"All data is private to your device." = "所有数据都是您设备的私有数据."; +"All data is kept private on your device." = "所有数据都是您设备的私有数据."; /* No comment provided by engineer. */ "All group members will remain connected." = "所有群组成员将保持连接。"; diff --git a/apps/multiplatform/android/src/main/AndroidManifest.xml b/apps/multiplatform/android/src/main/AndroidManifest.xml index deb5d83e5f..bb6a6f8f8a 100644 --- a/apps/multiplatform/android/src/main/AndroidManifest.xml +++ b/apps/multiplatform/android/src/main/AndroidManifest.xml @@ -27,6 +27,14 @@ + + + + + + + + = if (Build.VERSION.SDK_INT >= 33) { +// pm.queryIntentActivities(openIntent, PackageManager.ResolveInfoFlags.of((PackageManager.MATCH_DEFAULT_ONLY).toLong())) +// } else { +// pm.queryIntentActivities(openIntent, PackageManager.MATCH_DEFAULT_ONLY) +// }.sortedBy { it.priority } +// val first = resInfoList.firstOrNull { it.isDefault } ?: resInfoList.firstOrNull() ?: return null + val act = pm.resolveActivity(openIntent, PackageManager.MATCH_DEFAULT_ONLY) ?: return null +// Log.d(TAG, "Default launch action ${act} ${act.loadLabel(pm)} ${act.activityInfo?.name}") + val label = act.loadLabel(pm).toString() + val icon = act.loadIcon(pm).toBitmap().asImageBitmap() + val chooser = act.activityInfo?.name?.endsWith("ResolverActivity") == true + return OpenDefaultApp(label, icon, chooser) } actual fun shareFile(text: String, fileSource: CryptoFile) { diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallAudioDeviceManager.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallAudioDeviceManager.kt index ec0fd9fea8..0c23e95285 100644 --- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallAudioDeviceManager.kt +++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallAudioDeviceManager.kt @@ -71,8 +71,12 @@ class PostSCallAudioDeviceManager: CallAudioDeviceManagerInterface { } override fun stop() { - am.unregisterAudioDeviceCallback(audioCallback) - am.removeOnCommunicationDeviceChangedListener(listener) + try { + am.unregisterAudioDeviceCallback(audioCallback) + am.removeOnCommunicationDeviceChangedListener(listener) + } catch (e: Exception) { + Log.e(TAG, e.stackTraceToString()) + } } override fun selectLastExternalDeviceOrDefault(speaker: Boolean, keepAnyExternal: Boolean) { diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt index 601b907902..166f4ec355 100644 --- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt +++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/call/CallView.android.kt @@ -6,12 +6,12 @@ import android.Manifest import android.annotation.SuppressLint import android.app.Activity import android.content.* -import android.content.pm.ActivityInfo import android.content.pm.PackageManager import android.media.* import android.os.Build import android.os.PowerManager import android.os.PowerManager.PROXIMITY_SCREEN_OFF_WAKE_LOCK +import android.os.PowerManager.WakeLock import android.view.View import android.view.ViewGroup import android.webkit.* @@ -23,7 +23,6 @@ import androidx.compose.foundation.shape.CircleShape import androidx.compose.foundation.shape.RoundedCornerShape import androidx.compose.material.* import androidx.compose.runtime.* -import androidx.compose.runtime.saveable.rememberSaveable import androidx.compose.runtime.snapshots.SnapshotStateList import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier @@ -47,7 +46,6 @@ import chat.simplex.common.model.ChatController.appPrefs import chat.simplex.common.platform.* import chat.simplex.common.ui.theme.* import chat.simplex.common.views.helpers.* -import chat.simplex.common.views.onboarding.OnboardingStage import chat.simplex.res.MR import com.google.accompanist.permissions.* import dev.icerock.moko.resources.StringResource @@ -58,6 +56,7 @@ import kotlinx.coroutines.flow.distinctUntilChanged import kotlinx.coroutines.flow.filterNotNull import kotlinx.datetime.Clock import kotlinx.serialization.encodeToString +import java.io.Closeable // Should be destroy()'ed and set as null when call is ended. Otherwise, it will be a leak @SuppressLint("StaticFieldLeak") @@ -72,49 +71,62 @@ fun activeCallDestroyWebView() = withApi { Log.d(TAG, "CallView: webview was destroyed") } -@SuppressLint("SourceLockedOrientationActivity") -@Composable -actual fun ActiveCallView() { - val call = remember { chatModel.activeCall }.value - val scope = rememberCoroutineScope() - val proximityLock = remember { +class ActiveCallState: Closeable { + val proximityLock: WakeLock? = screenOffWakeLock() + var wasConnected = false + val callAudioDeviceManager = CallAudioDeviceManagerInterface.new() + private var closed = false + + init { + if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S) { + callAudioDeviceManager.start() + } + } + + override fun close() { + if (closed) return + closed = true + CallSoundsPlayer.stop() + if (wasConnected) { + CallSoundsPlayer.vibrate() + } + callAudioDeviceManager.stop() + dropAudioManagerOverrides() + if (proximityLock?.isHeld == true) { + proximityLock.release() + } + } + + private fun screenOffWakeLock(): WakeLock? { val pm = (androidAppContext.getSystemService(Context.POWER_SERVICE) as PowerManager) - if (pm.isWakeLockLevelSupported(PROXIMITY_SCREEN_OFF_WAKE_LOCK)) { + return if (pm.isWakeLockLevelSupported(PROXIMITY_SCREEN_OFF_WAKE_LOCK)) { pm.newWakeLock(PROXIMITY_SCREEN_OFF_WAKE_LOCK, androidAppContext.packageName + ":proximityLock") } else { null } } - val wasConnected = rememberSaveable { mutableStateOf(false) } +} + + +@SuppressLint("SourceLockedOrientationActivity") +@Composable +actual fun ActiveCallView() { + val call = remember { chatModel.activeCall }.value + val callState = call?.androidCallState as ActiveCallState? + val scope = rememberCoroutineScope() LaunchedEffect(call) { - if (call?.callState == CallState.Connected && !wasConnected.value) { + if (call?.callState == CallState.Connected && callState != null && !callState.wasConnected) { CallSoundsPlayer.vibrate(2) - wasConnected.value = true + callState.wasConnected = true } } - val callAudioDeviceManager = remember { CallAudioDeviceManagerInterface.new() } - DisposableEffect(Unit) { - if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S) { - callAudioDeviceManager.start() - } - onDispose { - CallSoundsPlayer.stop() - if (wasConnected.value) { - CallSoundsPlayer.vibrate() - } - callAudioDeviceManager.stop() - dropAudioManagerOverrides() - if (proximityLock?.isHeld == true) { - proximityLock.release() - } - } - } - LaunchedEffect(chatModel.activeCallViewIsCollapsed.value) { + LaunchedEffect(callState, chatModel.activeCallViewIsCollapsed.value) { + callState ?: return@LaunchedEffect if (chatModel.activeCallViewIsCollapsed.value) { - if (proximityLock?.isHeld == true) proximityLock.release() + if (callState.proximityLock?.isHeld == true) callState.proximityLock.release() } else { delay(1000) - if (proximityLock?.isHeld == false) proximityLock.acquire() + if (callState.proximityLock?.isHeld == false) callState.proximityLock.acquire() } } Box(Modifier.fillMaxSize()) { @@ -122,6 +134,7 @@ actual fun ActiveCallView() { Log.d(TAG, "received from WebRTCView: $apiMsg") val call = chatModel.activeCall.value if (call != null) { + val callState = call.androidCallState as ActiveCallState Log.d(TAG, "has active call $call") val callRh = call.remoteHostId when (val r = apiMsg.resp) { @@ -131,9 +144,9 @@ actual fun ActiveCallView() { updateActiveCall(call) { it.copy(callState = CallState.InvitationSent, localCapabilities = r.capabilities) } if (Build.VERSION.SDK_INT < Build.VERSION_CODES.S) { // Starting is delayed to make Android <= 11 working good with Bluetooth - callAudioDeviceManager.start() + callState.callAudioDeviceManager.start() } else { - callAudioDeviceManager.selectLastExternalDeviceOrDefault(call.hasVideo, true) + callState.callAudioDeviceManager.selectLastExternalDeviceOrDefault(call.hasVideo, true) } CallSoundsPlayer.startConnectingCallSound(scope) activeCallWaitDeliveryReceipt(scope) @@ -143,9 +156,9 @@ actual fun ActiveCallView() { updateActiveCall(call) { it.copy(callState = CallState.OfferSent, localCapabilities = r.capabilities) } if (Build.VERSION.SDK_INT < Build.VERSION_CODES.S) { // Starting is delayed to make Android <= 11 working good with Bluetooth - callAudioDeviceManager.start() + callState.callAudioDeviceManager.start() } else { - callAudioDeviceManager.selectLastExternalDeviceOrDefault(call.hasVideo, true) + callState.callAudioDeviceManager.selectLastExternalDeviceOrDefault(call.hasVideo, true) } } is WCallResponse.Answer -> withBGApi { @@ -228,14 +241,14 @@ actual fun ActiveCallView() { !chatModel.activeCallViewIsCollapsed.value -> true else -> false } - if (call != null && showOverlay) { - ActiveCallOverlay(call, chatModel, callAudioDeviceManager) + if (call != null && showOverlay && callState != null) { + ActiveCallOverlay(call, chatModel, callState.callAudioDeviceManager) } } - KeyChangeEffect(call?.localMediaSources?.hasVideo) { - if (call != null && call.hasVideo && callAudioDeviceManager.currentDevice.value?.type == AudioDeviceInfo.TYPE_BUILTIN_EARPIECE) { + KeyChangeEffect(callState, call?.localMediaSources?.hasVideo) { + if (call != null && call.hasVideo && callState != null && callState.callAudioDeviceManager.currentDevice.value?.type == AudioDeviceInfo.TYPE_BUILTIN_EARPIECE) { // enabling speaker on user action (peer action ignored) and not disabling it again - callAudioDeviceManager.selectLastExternalDeviceOrDefault(call.hasVideo, true) + callState.callAudioDeviceManager.selectLastExternalDeviceOrDefault(call.hasVideo, true) } } val context = LocalContext.current @@ -243,16 +256,12 @@ actual fun ActiveCallView() { val activity = context as? Activity ?: return@DisposableEffect onDispose {} val prevVolumeControlStream = activity.volumeControlStream activity.volumeControlStream = AudioManager.STREAM_VOICE_CALL - // Lock orientation to portrait in order to have good experience with calls - activity.requestedOrientation = ActivityInfo.SCREEN_ORIENTATION_PORTRAIT chatModel.activeCallViewIsVisible.value = true // After the first call, End command gets added to the list which prevents making another calls chatModel.callCommand.removeAll { it is WCallCommand.End } keepScreenOn(true) onDispose { activity.volumeControlStream = prevVolumeControlStream - // Unlock orientation - activity.requestedOrientation = ActivityInfo.SCREEN_ORIENTATION_UNSPECIFIED chatModel.activeCallViewIsVisible.value = false chatModel.callCommand.clear() keepScreenOn(false) @@ -264,8 +273,8 @@ actual fun ActiveCallView() { private fun ActiveCallOverlay(call: Call, chatModel: ChatModel, callAudioDeviceManager: CallAudioDeviceManagerInterface) { ActiveCallOverlayLayout( call = call, - devices = remember { callAudioDeviceManager.devices }.value, - currentDevice = remember { callAudioDeviceManager.currentDevice }, + devices = remember(callAudioDeviceManager) { callAudioDeviceManager.devices }.value, + currentDevice = remember(callAudioDeviceManager) { callAudioDeviceManager.currentDevice }, dismiss = { withBGApi { chatModel.callManager.endCall(call) } }, toggleAudio = { chatModel.callCommand.add(WCallCommand.Media(CallMediaSource.Mic, enable = !call.localMediaSources.mic)) }, selectDevice = { callAudioDeviceManager.selectDevice(it.id) }, @@ -832,7 +841,8 @@ fun PreviewActiveCallOverlayVideo() { connectionInfo = ConnectionInfo( RTCIceCandidate(RTCIceCandidateType.Host, "tcp"), RTCIceCandidate(RTCIceCandidateType.Host, "tcp") - ) + ), + androidCallState = {} ), devices = emptyList(), currentDevice = remember { mutableStateOf(null) }, @@ -841,7 +851,7 @@ fun PreviewActiveCallOverlayVideo() { selectDevice = {}, toggleVideo = {}, toggleSound = {}, - flipCamera = {} + flipCamera = {}, ) } } @@ -862,7 +872,8 @@ fun PreviewActiveCallOverlayAudio() { connectionInfo = ConnectionInfo( RTCIceCandidate(RTCIceCandidateType.Host, "udp"), RTCIceCandidate(RTCIceCandidateType.Host, "udp") - ) + ), + androidCallState = {} ), devices = emptyList(), currentDevice = remember { mutableStateOf(null) }, diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.android.kt new file mode 100644 index 0000000000..b24150ed24 --- /dev/null +++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.android.kt @@ -0,0 +1,57 @@ +package chat.simplex.common.views.chat.item + +import androidx.compose.material.MaterialTheme +import androidx.compose.runtime.* +import chat.simplex.common.model.CryptoFile +import chat.simplex.common.platform.* +import chat.simplex.common.views.helpers.DefaultDropdownMenu +import chat.simplex.res.MR +import dev.icerock.moko.resources.compose.painterResource +import dev.icerock.moko.resources.compose.stringResource +import java.net.URI + +@Composable +actual fun SaveOrOpenFileMenu( + showMenu: MutableState, + encrypted: Boolean, + ext: String?, + encryptedUri: URI, + fileSource: CryptoFile, + saveFile: () -> Unit +) { + val defaultApp = remember(encryptedUri.toString()) { if (ext != null) queryDefaultAppForExtension(ext, encryptedUri) else null } + DefaultDropdownMenu(showMenu) { + if (defaultApp != null) { + if (!defaultApp.isSystemChooser) { + ItemAction( + stringResource(MR.strings.open_with_app).format(defaultApp.name), + defaultApp.icon, + textColor = MaterialTheme.colors.primary, + onClick = { + openOrShareFile("", fileSource, justOpen = true, useChooser = false) + showMenu.value = false + } + ) + } else { + ItemAction( + stringResource(MR.strings.open_with_app).format("…"), + painterResource(MR.images.ic_open_in_new), + color = MaterialTheme.colors.primary, + onClick = { + openOrShareFile("", fileSource, justOpen = true, useChooser = false) + showMenu.value = false + } + ) + } + } + ItemAction( + stringResource(MR.strings.save_verb), + painterResource(if (encrypted) MR.images.ic_lock_open_right else MR.images.ic_download), + color = MaterialTheme.colors.primary, + onClick = { + saveFile() + showMenu.value = false + } + ) + } +} diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chatlist/TagListView.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chatlist/TagListView.android.kt new file mode 100644 index 0000000000..ab6d375d75 --- /dev/null +++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chatlist/TagListView.android.kt @@ -0,0 +1,81 @@ +package chat.simplex.common.views.chatlist + +import SectionItemView +import android.view.ViewGroup +import androidx.compose.foundation.* +import androidx.compose.foundation.layout.* +import androidx.compose.foundation.shape.CircleShape +import androidx.compose.material.* +import androidx.compose.runtime.* +import androidx.compose.ui.Modifier +import androidx.compose.ui.draw.clip +import androidx.compose.ui.unit.dp +import androidx.compose.ui.viewinterop.AndroidView +import androidx.emoji2.emojipicker.EmojiPickerView +import chat.simplex.common.model.ChatController.appPrefs +import chat.simplex.common.ui.theme.DEFAULT_PADDING_HALF +import chat.simplex.common.views.chat.topPaddingToContent +import chat.simplex.common.views.helpers.* +import chat.simplex.res.MR +import dev.icerock.moko.resources.compose.painterResource + +@Composable +actual fun ChatTagInput(name: MutableState, showError: State, emoji: MutableState) { + SectionItemView(padding = PaddingValues(horizontal = DEFAULT_PADDING_HALF)) { + Box(Modifier + .clip(shape = CircleShape) + .clickable { + ModalManager.start.showModalCloseable { close -> + EmojiPicker(close = { + close() + emoji.value = it + }) + } + } + .padding(4.dp) + ) { + val emojiValue = emoji.value + if (emojiValue != null) { + Text(emojiValue) + } else { + Icon( + painter = painterResource(MR.images.ic_add_reaction), + contentDescription = null, + tint = MaterialTheme.colors.secondary + ) + } + } + Spacer(Modifier.width(8.dp)) + TagListNameTextField(name, showError = showError) + } +} + +@Composable +private fun EmojiPicker(close: (String?) -> Unit) { + val oneHandUI = remember { appPrefs.oneHandUI.state } + val topPaddingToContent = topPaddingToContent(false) + + Column ( + modifier = Modifier.fillMaxSize().navigationBarsPadding().padding( + start = DEFAULT_PADDING_HALF, + end = DEFAULT_PADDING_HALF, + top = if (oneHandUI.value) WindowInsets.statusBars.asPaddingValues().calculateTopPadding() else topPaddingToContent, + bottom = if (oneHandUI.value) WindowInsets.navigationBars.asPaddingValues().calculateBottomPadding() + AppBarHeight * fontSizeSqrtMultiplier else 0.dp + ), + ) { + AndroidView( + factory = { context -> + EmojiPickerView(context).apply { + emojiGridColumns = 10 + layoutParams = ViewGroup.LayoutParams( + ViewGroup.LayoutParams.MATCH_PARENT, + ViewGroup.LayoutParams.MATCH_PARENT + ) + setOnEmojiPickedListener { pickedEmoji -> + close(pickedEmoji.emoji) + } + } + } + ) + } +} diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/onboarding/SetNotificationsMode.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/onboarding/SetNotificationsMode.android.kt index a39e71947d..0378fcbd7a 100644 --- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/onboarding/SetNotificationsMode.android.kt +++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/onboarding/SetNotificationsMode.android.kt @@ -4,19 +4,31 @@ import android.Manifest import android.os.Build import androidx.compose.runtime.Composable import androidx.compose.runtime.LaunchedEffect -import chat.simplex.common.platform.ntfManager -import com.google.accompanist.permissions.PermissionStatus -import com.google.accompanist.permissions.rememberPermissionState +import chat.simplex.common.model.ChatController.appPrefs +import chat.simplex.common.platform.* +import com.google.accompanist.permissions.* @Composable actual fun SetNotificationsModeAdditions() { if (Build.VERSION.SDK_INT >= 33) { val notificationsPermissionState = rememberPermissionState(Manifest.permission.POST_NOTIFICATIONS) LaunchedEffect(notificationsPermissionState.status == PermissionStatus.Granted) { - if (notificationsPermissionState.status == PermissionStatus.Granted) { - ntfManager.androidCreateNtfChannelsMaybeShowAlert() + val canAsk = appPrefs.canAskToEnableNotifications.get() + if (notificationsPermissionState.status is PermissionStatus.Denied) { + if (notificationsPermissionState.status.shouldShowRationale || !canAsk) { + if (canAsk) { + appPrefs.canAskToEnableNotifications.set(false) + } + Log.w(TAG, "Notifications are disabled and nobody will ask to enable them") + } else { + notificationsPermissionState.launchPermissionRequest() + } } else { - notificationsPermissionState.launchPermissionRequest() + if (!canAsk) { + // the user allowed notifications in system alert or manually in settings, allow to ask him next time if needed + appPrefs.canAskToEnableNotifications.set(true) + } + ntfManager.androidCreateNtfChannelsMaybeShowAlert() } } } else { diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt index d407174e52..e2fe96e178 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt @@ -13,6 +13,7 @@ import chat.simplex.common.platform.* import chat.simplex.common.ui.theme.* import chat.simplex.common.views.call.* import chat.simplex.common.views.chat.* +import chat.simplex.common.views.chatlist.* import chat.simplex.common.views.helpers.* import chat.simplex.common.views.migration.MigrationToDeviceState import chat.simplex.common.views.migration.MigrationToState @@ -81,6 +82,12 @@ object ChatModel { val groupMembers = mutableStateListOf() val groupMembersIndexes = mutableStateMapOf() + // Chat Tags + val userTags = mutableStateOf(emptyList()) + val activeChatTagFilter = mutableStateOf(null) + val presetTags = mutableStateMapOf() + val unreadTags = mutableStateMapOf() + // false: default placement, true: floating window. // Used for deciding to add terminal items on main thread or not. Floating means appPrefs.terminalAlwaysVisible var terminalsVisible = setOf() @@ -196,6 +203,116 @@ object ChatModel { } } + fun updateChatTags(rhId: Long?) { + val newPresetTags = mutableMapOf() + val newUnreadTags = mutableMapOf() + + for (chat in chats.value.filter { it.remoteHostId == rhId }) { + for (tag in PresetTagKind.entries) { + if (presetTagMatchesChat(tag, chat.chatInfo)) { + newPresetTags[tag] = (newPresetTags[tag] ?: 0) + 1 + } + } + if (chat.unreadTag) { + val chatTags: List = when (val cInfo = chat.chatInfo) { + is ChatInfo.Direct -> cInfo.contact.chatTags + is ChatInfo.Group -> cInfo.groupInfo.chatTags + else -> emptyList() + } + chatTags.forEach { tag -> + newUnreadTags[tag] = (newUnreadTags[tag] ?: 0) + 1 + } + } + } + + if (activeChatTagFilter.value is ActiveFilter.PresetTag && + (newPresetTags[(activeChatTagFilter.value as ActiveFilter.PresetTag).tag] ?: 0) == 0) { + activeChatTagFilter.value = null + } + + presetTags.clear() + presetTags.putAll(newPresetTags) + unreadTags.clear() + unreadTags.putAll(newUnreadTags) + } + + fun updateChatFavorite(favorite: Boolean, wasFavorite: Boolean) { + val count = presetTags[PresetTagKind.FAVORITES] + + if (favorite && !wasFavorite) { + presetTags[PresetTagKind.FAVORITES] = (count ?: 0) + 1 + } else if (!favorite && wasFavorite && count != null) { + presetTags[PresetTagKind.FAVORITES] = maxOf(0, count - 1) + if (activeChatTagFilter.value == ActiveFilter.PresetTag(PresetTagKind.FAVORITES) && (presetTags[PresetTagKind.FAVORITES] ?: 0) == 0) { + activeChatTagFilter.value = null + } + } + } + + fun addPresetChatTags(chatInfo: ChatInfo) { + for (tag in PresetTagKind.entries) { + if (presetTagMatchesChat(tag, chatInfo)) { + presetTags[tag] = (presetTags[tag] ?: 0) + 1 + } + } + } + + fun removePresetChatTags(chatInfo: ChatInfo) { + for (tag in PresetTagKind.entries) { + if (presetTagMatchesChat(tag, chatInfo)) { + val count = presetTags[tag] + if (count != null) { + presetTags[tag] = maxOf(0, count - 1) + } + } + } + } + + fun markChatTagRead(chat: Chat) { + if (chat.unreadTag) { + chat.chatInfo.chatTags?.let { tags -> + markChatTagRead_(chat, tags) + } + } + } + + fun updateChatTagRead(chat: Chat, wasUnread: Boolean) { + val tags = chat.chatInfo.chatTags ?: return + val nowUnread = chat.unreadTag + + if (nowUnread && !wasUnread) { + tags.forEach { tag -> + unreadTags[tag] = (unreadTags[tag] ?: 0) + 1 + } + } else if (!nowUnread && wasUnread) { + markChatTagRead_(chat, tags) + } + } + + fun moveChatTagUnread(chat: Chat, oldTags: List?, newTags: List) { + if (chat.unreadTag) { + oldTags?.forEach { t -> + val oldCount = unreadTags[t] + if (oldCount != null) { + unreadTags[t] = maxOf(0, oldCount - 1) + } + } + + newTags.forEach { t -> + unreadTags[t] = (unreadTags[t] ?: 0) + 1 + } + } + } + + private fun markChatTagRead_(chat: Chat, tags: List) { + for (tag in tags) { + val count = unreadTags[tag] + if (count != null) { + unreadTags[tag] = maxOf(0, count - 1) + } + } + } + // toList() here is to prevent ConcurrentModificationException that is rarely happens but happens fun hasChat(rhId: Long?, id: String): Boolean = chats.value.firstOrNull { it.id == id && it.remoteHostId == rhId } != null // TODO pass rhId? @@ -280,6 +397,7 @@ object ChatModel { updateChatInfo(rhId, cInfo) } else if (addMissing) { addChat(Chat(remoteHostId = rhId, chatInfo = cInfo, chatItems = arrayListOf())) + addPresetChatTags(cInfo) } } @@ -329,6 +447,7 @@ object ChatModel { } else -> cItem } + val wasUnread = chat.unreadTag chats[i] = chat.copy( chatItems = arrayListOf(newPreviewItem), chatStats = @@ -339,6 +458,8 @@ object ChatModel { else chat.chatStats ) + updateChatTagRead(chats[i], wasUnread) + if (appPlatform.isDesktop && cItem.chatDir.sent) { reorderChat(chats[i], 0) } else { @@ -455,6 +576,7 @@ object ChatModel { if (i >= 0) { decreaseUnreadCounter(rhId, currentUser.value!!, chats[i].chatStats.unreadCount) chats[i] = chats[i].copy(chatItems = arrayListOf(), chatStats = Chat.ChatStats(), chatInfo = cInfo) + markChatTagRead(chats[i]) } // clear current chat if (chatId.value == cInfo.id) { @@ -522,11 +644,13 @@ object ChatModel { val chat = chats[chatIdx] val lastId = chat.chatItems.lastOrNull()?.id if (lastId != null) { + val wasUnread = chat.unreadTag val unreadCount = if (itemIds != null) chat.chatStats.unreadCount - markedRead else 0 decreaseUnreadCounter(remoteHostId, currentUser.value!!, chat.chatStats.unreadCount - unreadCount) chats[chatIdx] = chat.copy( chatStats = chat.chatStats.copy(unreadCount = unreadCount) ) + updateChatTagRead(chats[chatIdx], wasUnread) } } } @@ -537,16 +661,29 @@ object ChatModel { val chat = chats[chatIndex] val unreadCount = kotlin.math.max(chat.chatStats.unreadCount - 1, 0) + val wasUnread = chat.unreadTag decreaseUnreadCounter(rhId, currentUser.value!!, chat.chatStats.unreadCount - unreadCount) chats[chatIndex] = chat.copy( chatStats = chat.chatStats.copy( unreadCount = unreadCount, ) ) + updateChatTagRead(chats[chatIndex], wasUnread) } fun removeChat(rhId: Long?, id: String) { - chats.removeAll { it.id == id && it.remoteHostId == rhId } + var removed: ChatInfo? = null + chats.removeAll { + val found = it.id == id && it.remoteHostId == rhId + if (found) { + removed = it.chatInfo + } + found + } + + removed?.let { + removePresetChatTags(it) + } } suspend fun upsertGroupMember(rhId: Long?, groupInfo: GroupInfo, member: GroupMember): Boolean { @@ -977,6 +1114,8 @@ data class Chat( else -> false } + val unreadTag: Boolean get() = chatInfo.ntfsEnabled && (chatStats.unreadCount > 0 || chatStats.unreadChat) + val id: String get() = chatInfo.id fun groupFeatureEnabled(feature: GroupFeature): Boolean = @@ -1189,6 +1328,12 @@ sealed class ChatInfo: SomeChat, NamedChat { else -> false } + val chatTags: List? + get() = when (this) { + is Direct -> contact.chatTags + is Group -> groupInfo.chatTags + else -> null + } } @Serializable @@ -1232,6 +1377,7 @@ data class Contact( val chatTs: Instant?, val contactGroupMemberId: Long? = null, val contactGrpInvSent: Boolean, + val chatTags: List, override val chatDeleted: Boolean, val uiThemes: ThemeModeOverrides? = null, ): SomeChat, NamedChat { @@ -1315,6 +1461,7 @@ data class Contact( contactGrpInvSent = false, chatDeleted = false, uiThemes = null, + chatTags = emptyList() ) } } @@ -1476,6 +1623,7 @@ data class GroupInfo ( override val updatedAt: Instant, val chatTs: Instant?, val uiThemes: ThemeModeOverrides? = null, + val chatTags: List ): SomeChat, NamedChat { override val chatType get() = ChatType.Group override val id get() = "#$groupId" @@ -1520,6 +1668,7 @@ data class GroupInfo ( updatedAt = Clock.System.now(), chatTs = Clock.System.now(), uiThemes = null, + chatTags = emptyList() ) } } @@ -1575,6 +1724,13 @@ data class GroupMember ( var activeConn: Connection? = null ): NamedChat { val id: String get() = "#$groupId @$groupMemberId" + val ready get() = activeConn?.connStatus == ConnStatus.Ready + val sndReady get() = ready || activeConn?.connStatus == ConnStatus.SndReady + val sendMsgEnabled get() = + sndReady + && memberCurrent + && !(activeConn?.connectionStats?.ratchetSyncSendProhibited ?: false) + && !(activeConn?.connDisabled ?: true) override val displayName: String get() { val p = memberProfile @@ -3843,6 +3999,13 @@ sealed class ChatItemTTL: Comparable { } } +@Serializable +data class ChatTag( + val chatTagId: Long, + val chatTagText: String, + val chatTagEmoji: String? +) + @Serializable class ChatItemInfo( val itemVersions: List, diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 6d13ff191f..a86be622b9 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -80,6 +80,7 @@ class AppPreferences { if (!runServiceInBackground.get()) NotificationsMode.OFF else NotificationsMode.default ) { NotificationsMode.values().firstOrNull { it.name == this } } val notificationPreviewMode = mkStrPreference(SHARED_PREFS_NOTIFICATION_PREVIEW_MODE, NotificationPreviewMode.default.name) + val canAskToEnableNotifications = mkBoolPreference(SHARED_PREFS_CAN_ASK_TO_ENABLE_NOTIFICATIONS, true) val backgroundServiceNoticeShown = mkBoolPreference(SHARED_PREFS_SERVICE_NOTICE_SHOWN, false) val backgroundServiceBatteryNoticeShown = mkBoolPreference(SHARED_PREFS_SERVICE_BATTERY_NOTICE_SHOWN, false) val autoRestartWorkerVersion = mkIntPreference(SHARED_PREFS_AUTO_RESTART_WORKER_VERSION, 0) @@ -132,6 +133,7 @@ class AppPreferences { val chatLastStart = mkDatePreference(SHARED_PREFS_CHAT_LAST_START, null) val chatStopped = mkBoolPreference(SHARED_PREFS_CHAT_STOPPED, false) val developerTools = mkBoolPreference(SHARED_PREFS_DEVELOPER_TOOLS, false) + val logLevel = mkEnumPreference(SHARED_PREFS_LOG_LEVEL, LogLevel.WARNING) { LogLevel.entries.firstOrNull { it.name == this } } val showInternalErrors = mkBoolPreference(SHARED_PREFS_SHOW_INTERNAL_ERRORS, false) val showSlowApiCalls = mkBoolPreference(SHARED_PREFS_SHOW_SLOW_API_CALLS, false) val terminalAlwaysVisible = mkBoolPreference(SHARED_PREFS_TERMINAL_ALWAYS_VISIBLE, false) @@ -357,6 +359,7 @@ class AppPreferences { private const val SHARED_PREFS_RUN_SERVICE_IN_BACKGROUND = "RunServiceInBackground" private const val SHARED_PREFS_NOTIFICATIONS_MODE = "NotificationsMode" private const val SHARED_PREFS_NOTIFICATION_PREVIEW_MODE = "NotificationPreviewMode" + private const val SHARED_PREFS_CAN_ASK_TO_ENABLE_NOTIFICATIONS = "CanAskToEnableNotifications" private const val SHARED_PREFS_SERVICE_NOTICE_SHOWN = "BackgroundServiceNoticeShown" private const val SHARED_PREFS_SERVICE_BATTERY_NOTICE_SHOWN = "BackgroundServiceBatteryNoticeShown" private const val SHARED_PREFS_WEBRTC_POLICY_RELAY = "WebrtcPolicyRelay" @@ -393,6 +396,7 @@ class AppPreferences { private const val SHARED_PREFS_CHAT_LAST_START = "ChatLastStart" private const val SHARED_PREFS_CHAT_STOPPED = "ChatStopped" private const val SHARED_PREFS_DEVELOPER_TOOLS = "DeveloperTools" + private const val SHARED_PREFS_LOG_LEVEL = "LogLevel" private const val SHARED_PREFS_SHOW_INTERNAL_ERRORS = "ShowInternalErrors" private const val SHARED_PREFS_SHOW_SLOW_API_CALLS = "ShowSlowApiCalls" private const val SHARED_PREFS_TERMINAL_ALWAYS_VISIBLE = "TerminalAlwaysVisible" @@ -622,6 +626,9 @@ object ChatController { val chats = apiGetChats(rhId) updateChats(chats) } + chatModel.userTags.value = apiGetChatTags(rhId).takeIf { hasUser } ?: emptyList() + chatModel.activeChatTagFilter.value = null + chatModel.updateChatTags(rhId) } private fun startReceiver() { @@ -877,6 +884,16 @@ object ChatController { return emptyList() } + private suspend fun apiGetChatTags(rh: Long?): List?{ + val userId = currentUserId("apiGetChatTags") + val r = sendCmd(rh, CC.ApiGetChatTags(userId)) + + if (r is CR.ChatTags) return r.userTags + Log.e(TAG, "apiGetChatTags bad response: ${r.responseType} ${r.details}") + AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_loading_chat_tags), "${r.responseType}: ${r.details}") + return null + } + suspend fun apiGetChat(rh: Long?, type: ChatType, id: Long, pagination: ChatPagination, search: String = ""): Pair? { val r = sendCmd(rh, CC.ApiGetChat(type, id, pagination, search)) if (r is CR.ApiChat) return if (rh == null) r.chat to r.navInfo else r.chat.copy(remoteHostId = rh) to r.navInfo @@ -889,6 +906,28 @@ object ChatController { return null } + suspend fun apiCreateChatTag(rh: Long?, tag: ChatTagData): List? { + val r = sendCmd(rh, CC.ApiCreateChatTag(tag)) + if (r is CR.ChatTags) return r.userTags + Log.e(TAG, "apiCreateChatTag bad response: ${r.responseType} ${r.details}") + AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_creating_chat_tags), "${r.responseType}: ${r.details}") + return null + } + + suspend fun apiSetChatTags(rh: Long?, type: ChatType, id: Long, tagIds: List): Pair, List>? { + val r = sendCmd(rh, CC.ApiSetChatTags(type, id, tagIds)) + if (r is CR.TagsUpdated) return r.userTags to r.chatTags + Log.e(TAG, "apiSetChatTags bad response: ${r.responseType} ${r.details}") + AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_updating_chat_tags), "${r.responseType}: ${r.details}") + return null + } + + suspend fun apiDeleteChatTag(rh: Long?, tagId: Long) = sendCommandOkResp(rh, CC.ApiDeleteChatTag(tagId)) + + suspend fun apiUpdateChatTag(rh: Long?, tagId: Long, tag: ChatTagData) = sendCommandOkResp(rh, CC.ApiUpdateChatTag(tagId, tag)) + + suspend fun apiReorderChatTags(rh: Long?, tagIds: List) = sendCommandOkResp(rh, CC.ApiReorderChatTags(tagIds)) + suspend fun apiSendMessages(rh: Long?, type: ChatType, id: Long, live: Boolean = false, ttl: Int? = null, composedMessages: List): List? { val cmd = CC.ApiSendMessages(type, id, live, ttl, composedMessages) return processSendMessageCmd(rh, cmd) @@ -966,6 +1005,7 @@ object ChatController { val r = sendCmd(rh, CC.ApiUpdateChatItem(type, id, itemId, mc, live)) when { r is CR.ChatItemUpdated -> return r.chatItem + r is CR.ChatItemNotChanged -> return r.chatItem r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore && r.chatError.storeError is StoreError.LargeMsg -> { AlertManager.shared.showAlertMsg( generalGetString(MR.strings.maximum_message_size_title), @@ -3149,10 +3189,16 @@ sealed class CC { class TestStorageEncryption(val key: String): CC() class ApiSaveSettings(val settings: AppSettings): CC() class ApiGetSettings(val settings: AppSettings): CC() + class ApiGetChatTags(val userId: Long): CC() class ApiGetChats(val userId: Long): CC() class ApiGetChat(val type: ChatType, val id: Long, val pagination: ChatPagination, val search: String = ""): CC() class ApiGetChatItemInfo(val type: ChatType, val id: Long, val itemId: Long): CC() class ApiSendMessages(val type: ChatType, val id: Long, val live: Boolean, val ttl: Int?, val composedMessages: List): CC() + class ApiCreateChatTag(val tag: ChatTagData): CC() + class ApiSetChatTags(val type: ChatType, val id: Long, val tagIds: List): CC() + class ApiDeleteChatTag(val tagId: Long): CC() + class ApiUpdateChatTag(val tagId: Long, val tagData: ChatTagData): CC() + class ApiReorderChatTags(val tagIds: List): CC() class ApiCreateChatItems(val noteFolderId: Long, val composedMessages: List): CC() class ApiUpdateChatItem(val type: ChatType, val id: Long, val itemId: Long, val mc: MsgContent, val live: Boolean): CC() class ApiDeleteChatItem(val type: ChatType, val id: Long, val itemIds: List, val mode: CIDeleteMode): CC() @@ -3304,6 +3350,7 @@ sealed class CC { is TestStorageEncryption -> "/db test key $key" is ApiSaveSettings -> "/_save app settings ${json.encodeToString(settings)}" is ApiGetSettings -> "/_get app settings ${json.encodeToString(settings)}" + is ApiGetChatTags -> "/_get tags $userId" is ApiGetChats -> "/_get chats $userId pcc=on" is ApiGetChat -> "/_get chat ${chatRef(type, id)} ${pagination.cmdString}" + (if (search == "") "" else " search=$search") is ApiGetChatItemInfo -> "/_get item info ${chatRef(type, id)} $itemId" @@ -3312,6 +3359,11 @@ sealed class CC { val ttlStr = if (ttl != null) "$ttl" else "default" "/_send ${chatRef(type, id)} live=${onOff(live)} ttl=${ttlStr} json $msgs" } + is ApiCreateChatTag -> "/_create tag ${json.encodeToString(tag)}" + is ApiSetChatTags -> "/_tags ${chatRef(type, id)} ${tagIds.joinToString(",")}" + is ApiDeleteChatTag -> "/_delete tag $tagId" + is ApiUpdateChatTag -> "/_update tag $tagId ${json.encodeToString(tagData)}" + is ApiReorderChatTags -> "/_reorder tags ${tagIds.joinToString(",")}" is ApiCreateChatItems -> { val msgs = json.encodeToString(composedMessages) "/_create *$noteFolderId json $msgs" @@ -3468,10 +3520,16 @@ sealed class CC { is TestStorageEncryption -> "testStorageEncryption" is ApiSaveSettings -> "apiSaveSettings" is ApiGetSettings -> "apiGetSettings" + is ApiGetChatTags -> "apiGetChatTags" is ApiGetChats -> "apiGetChats" is ApiGetChat -> "apiGetChat" is ApiGetChatItemInfo -> "apiGetChatItemInfo" is ApiSendMessages -> "apiSendMessages" + is ApiCreateChatTag -> "apiCreateChatTag" + is ApiSetChatTags -> "apiSetChatTags" + is ApiDeleteChatTag -> "apiDeleteChatTag" + is ApiUpdateChatTag -> "apiUpdateChatTag" + is ApiReorderChatTags -> "apiReorderChatTags" is ApiCreateChatItems -> "apiCreateChatItems" is ApiUpdateChatItem -> "apiUpdateChatItem" is ApiDeleteChatItem -> "apiDeleteChatItem" @@ -3654,6 +3712,9 @@ sealed class ChatPagination { @Serializable class ComposedMessage(val fileSource: CryptoFile?, val quotedItemId: Long?, val msgContent: MsgContent) +@Serializable +class ChatTagData(val emoji: String?, val text: String) + @Serializable class ArchiveConfig(val archivePath: String, val disableCompression: Boolean? = null, val parentTempDirectory: String? = null) @@ -3754,7 +3815,7 @@ data class ServerOperatorConditionsDetail( @Serializable() sealed class ConditionsAcceptance { - @Serializable @SerialName("accepted") data class Accepted(val acceptedAt: Instant?) : ConditionsAcceptance() + @Serializable @SerialName("accepted") data class Accepted(val acceptedAt: Instant?, val autoAccepted: Boolean) : ConditionsAcceptance() @Serializable @SerialName("required") data class Required(val deadline: Instant?) : ConditionsAcceptance() val conditionsAccepted: Boolean @@ -3798,7 +3859,7 @@ data class ServerOperator( tradeName = "SimpleX Chat", legalName = "SimpleX Chat Ltd", serverDomains = listOf("simplex.im"), - conditionsAcceptance = ConditionsAcceptance.Accepted(acceptedAt = null), + conditionsAcceptance = ConditionsAcceptance.Accepted(acceptedAt = null, autoAccepted = false), enabled = true, smpRoles = ServerRoles(storage = true, proxy = true), xftpRoles = ServerRoles(storage = true, proxy = true) @@ -3880,7 +3941,7 @@ data class UserOperatorServers( tradeName = "", legalName = null, serverDomains = emptyList(), - conditionsAcceptance = ConditionsAcceptance.Accepted(null), + conditionsAcceptance = ConditionsAcceptance.Accepted(null, autoAccepted = false), enabled = false, smpRoles = ServerRoles(storage = true, proxy = true), xftpRoles = ServerRoles(storage = true, proxy = true) @@ -5387,6 +5448,7 @@ sealed class CR { @Serializable @SerialName("chatStopped") class ChatStopped: CR() @Serializable @SerialName("apiChats") class ApiChats(val user: UserRef, val chats: List): CR() @Serializable @SerialName("apiChat") class ApiChat(val user: UserRef, val chat: Chat, val navInfo: NavigationInfo = NavigationInfo()): CR() + @Serializable @SerialName("chatTags") class ChatTags(val user: UserRef, val userTags: List): CR() @Serializable @SerialName("chatItemInfo") class ApiChatItemInfo(val user: UserRef, val chatItem: AChatItem, val chatItemInfo: ChatItemInfo): CR() @Serializable @SerialName("serverTestResult") class ServerTestResult(val user: UserRef, val testServer: String, val testFailure: ProtocolTestFailure? = null): CR() @Serializable @SerialName("serverOperatorConditions") class ServerOperatorConditions(val conditions: ServerOperatorConditionsDetail): CR() @@ -5413,6 +5475,7 @@ sealed class CR { @Serializable @SerialName("contactCode") class ContactCode(val user: UserRef, val contact: Contact, val connectionCode: String): CR() @Serializable @SerialName("groupMemberCode") class GroupMemberCode(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember, val connectionCode: String): CR() @Serializable @SerialName("connectionVerified") class ConnectionVerified(val user: UserRef, val verified: Boolean, val expectedCode: String): CR() + @Serializable @SerialName("tagsUpdated") class TagsUpdated(val user: UserRef, val userTags: List, val chatTags: List): CR() @Serializable @SerialName("invitation") class Invitation(val user: UserRef, val connReqInvitation: String, val connection: PendingContactConnection): CR() @Serializable @SerialName("connectionIncognitoUpdated") class ConnectionIncognitoUpdated(val user: UserRef, val toConnection: PendingContactConnection): CR() @Serializable @SerialName("connectionUserChanged") class ConnectionUserChanged(val user: UserRef, val fromConnection: PendingContactConnection, val toConnection: PendingContactConnection, val newUser: UserRef): CR() @@ -5571,6 +5634,7 @@ sealed class CR { is ChatStopped -> "chatStopped" is ApiChats -> "apiChats" is ApiChat -> "apiChat" + is ChatTags -> "chatTags" is ApiChatItemInfo -> "chatItemInfo" is ServerTestResult -> "serverTestResult" is ServerOperatorConditions -> "serverOperatorConditions" @@ -5597,6 +5661,7 @@ sealed class CR { is ContactCode -> "contactCode" is GroupMemberCode -> "groupMemberCode" is ConnectionVerified -> "connectionVerified" + is TagsUpdated -> "tagsUpdated" is Invitation -> "invitation" is ConnectionIncognitoUpdated -> "connectionIncognitoUpdated" is ConnectionUserChanged -> "ConnectionUserChanged" @@ -5745,6 +5810,7 @@ sealed class CR { is ChatStopped -> noDetails() is ApiChats -> withUser(user, json.encodeToString(chats)) is ApiChat -> withUser(user, "chat: ${json.encodeToString(chat)}\nnavInfo: ${navInfo}") + is ChatTags -> withUser(user, "userTags: ${json.encodeToString(userTags)}") is ApiChatItemInfo -> withUser(user, "chatItem: ${json.encodeToString(chatItem)}\n${json.encodeToString(chatItemInfo)}") is ServerTestResult -> withUser(user, "server: $testServer\nresult: ${json.encodeToString(testFailure)}") is ServerOperatorConditions -> "conditions: ${json.encodeToString(conditions)}" @@ -5771,6 +5837,7 @@ sealed class CR { is ContactCode -> withUser(user, "contact: ${json.encodeToString(contact)}\nconnectionCode: $connectionCode") is GroupMemberCode -> withUser(user, "groupInfo: ${json.encodeToString(groupInfo)}\nmember: ${json.encodeToString(member)}\nconnectionCode: $connectionCode") is ConnectionVerified -> withUser(user, "verified: $verified\nconnectionCode: $expectedCode") + is TagsUpdated -> withUser(user, "userTags: ${json.encodeToString(userTags)}\nchatTags: ${json.encodeToString(chatTags)}") is Invitation -> withUser(user, "connReqInvitation: $connReqInvitation\nconnection: $connection") is ConnectionIncognitoUpdated -> withUser(user, json.encodeToString(toConnection)) is ConnectionUserChanged -> withUser(user, "fromConnection: ${json.encodeToString(fromConnection)}\ntoConnection: ${json.encodeToString(toConnection)}\nnewUser: ${json.encodeToString(newUser)}" ) @@ -6030,6 +6097,9 @@ class ConnectionStats( val ratchetSyncSendProhibited: Boolean get() = listOf(RatchetSyncState.Required, RatchetSyncState.Started, RatchetSyncState.Agreed).contains(ratchetSyncState) + + val ratchetSyncInProgress: Boolean get() = + listOf(RatchetSyncState.Started, RatchetSyncState.Agreed).contains(ratchetSyncState) } @Serializable diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Log.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Log.kt index a1b39527d1..1c393d19ed 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Log.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Log.kt @@ -2,6 +2,10 @@ package chat.simplex.common.platform const val TAG = "SIMPLEX" +enum class LogLevel { + DEBUG, INFO, WARNING, ERROR +} + expect object Log { fun d(tag: String, text: String) fun e(tag: String, text: String) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Platform.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Platform.kt index e0a9e22f71..448100bc17 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Platform.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Platform.kt @@ -10,6 +10,7 @@ import chat.simplex.common.model.ChatId import chat.simplex.common.model.NotificationsMode import chat.simplex.common.ui.theme.CurrentColors import kotlinx.coroutines.Job +import java.io.Closeable interface PlatformInterface { suspend fun androidServiceStart() {} @@ -26,6 +27,7 @@ interface PlatformInterface { fun androidPictureInPictureAllowed(): Boolean = true fun androidCallEnded() {} fun androidRestartNetworkObserver() {} + fun androidCreateActiveCallState(): Closeable = Closeable { } fun androidIsXiaomiDevice(): Boolean = false val androidApiLevel: Int? get() = null @Composable fun androidLockPortraitOrientation() {} diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt index 405094f72a..d6ab57a70d 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/CallManager.kt @@ -43,6 +43,7 @@ class CallManager(val chatModel: ChatModel) { private fun justAcceptIncomingCall(invitation: RcvCallInvitation, userProfile: Profile) { with (chatModel) { + activeCall.value?.androidCallState?.close() activeCall.value = Call( remoteHostId = invitation.remoteHostId, userProfile = userProfile, @@ -51,6 +52,7 @@ class CallManager(val chatModel: ChatModel) { callState = CallState.InvitationAccepted, initialCallType = invitation.callType.media, sharedKey = invitation.sharedKey, + androidCallState = platform.androidCreateActiveCallState() ) showCallView.value = true val useRelay = controller.appPrefs.webrtcPolicyRelay.get() @@ -78,6 +80,7 @@ class CallManager(val chatModel: ChatModel) { // Don't destroy WebView if you plan to accept next call right after this one if (!switchingCall.value) { showCallView.value = false + activeCall.value?.androidCallState?.close() activeCall.value = null activeCallViewIsCollapsed.value = false platform.androidCallEnded() diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt index bbf860b39c..705fc6a28f 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/call/WebRTC.kt @@ -7,6 +7,7 @@ import chat.simplex.res.MR import kotlinx.datetime.Instant import kotlinx.serialization.SerialName import kotlinx.serialization.Serializable +import java.io.Closeable import java.net.URI import kotlin.collections.ArrayList @@ -27,7 +28,9 @@ data class Call( // When a user has audio call, and then he wants to enable camera but didn't grant permissions for using camera yet, // we show permissions view without enabling camera before permissions are granted. After they are granted, enabling camera - val wantsToEnableCamera: Boolean = false + val wantsToEnableCamera: Boolean = false, + + val androidCallState: Closeable ) { val encrypted: Boolean get() = localEncrypted && sharedKey != null private val localEncrypted: Boolean get() = localCapabilities?.encryption ?: false diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt index df13368900..9b580edb62 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt @@ -131,26 +131,14 @@ fun ChatInfoView( }, syncContactConnection = { withBGApi { - val cStats = chatModel.controller.apiSyncContactRatchet(chatRh, contact.contactId, force = false) - connStats.value = cStats - if (cStats != null) { - withChats { - updateContactConnectionStats(chatRh, contact, cStats) - } - } + syncContactConnection(chatRh, contact, connStats, force = false) close.invoke() } }, syncContactConnectionForce = { showSyncConnectionForceAlert(syncConnectionForce = { withBGApi { - val cStats = chatModel.controller.apiSyncContactRatchet(chatRh, contact.contactId, force = true) - connStats.value = cStats - if (cStats != null) { - withChats { - updateContactConnectionStats(chatRh, contact, cStats) - } - } + syncContactConnection(chatRh, contact, connStats, force = true) close.invoke() } }) @@ -189,6 +177,16 @@ fun ChatInfoView( } } +suspend fun syncContactConnection(rhId: Long?, contact: Contact, connectionStats: MutableState, force: Boolean) { + val cStats = chatModel.controller.apiSyncContactRatchet(rhId, contact.contactId, force = force) + connectionStats.value = cStats + if (cStats != null) { + withChats { + updateContactConnectionStats(rhId, contact, cStats) + } + } +} + sealed class SendReceipts { object Yes: SendReceipts() object No: SendReceipts() @@ -505,7 +503,7 @@ fun ChatInfoLayout( currentUser: User, sendReceipts: State, setSendReceipts: (SendReceipts) -> Unit, - connStats: State, + connStats: MutableState, contactNetworkStatus: NetworkStatus, customUserProfile: Profile?, localAlias: String, @@ -553,8 +551,8 @@ fun ChatInfoLayout( verticalAlignment = Alignment.CenterVertically ) { SearchButton(modifier = Modifier.fillMaxWidth(0.25f), chat, contact, close, onSearchClicked) - AudioCallButton(modifier = Modifier.fillMaxWidth(0.33f), chat, contact) - VideoButton(modifier = Modifier.fillMaxWidth(0.5f), chat, contact) + AudioCallButton(modifier = Modifier.fillMaxWidth(0.33f), chat, contact, connStats) + VideoButton(modifier = Modifier.fillMaxWidth(0.5f), chat, contact, connStats) MuteButton(modifier = Modifier.fillMaxWidth(1f), chat, contact) } } @@ -699,13 +697,19 @@ fun ChatInfoHeader(cInfo: ChatInfo, contact: Contact) { Icon(painterResource(MR.images.ic_verified_user), null, tint = MaterialTheme.colors.secondary) } ) + val clipboard = LocalClipboardManager.current + val copyNameToClipboard = { + clipboard.setText(AnnotatedString(contact.profile.displayName)) + showToast(generalGetString(MR.strings.copied)) + } Text( text, inlineContent = inlineContent, style = MaterialTheme.typography.h1.copy(fontWeight = FontWeight.Normal), textAlign = TextAlign.Center, maxLines = 3, - overflow = TextOverflow.Ellipsis + overflow = TextOverflow.Ellipsis, + modifier = Modifier.combinedClickable(onClick = copyNameToClipboard, onLongClick = copyNameToClipboard).onRightClick(copyNameToClipboard) ) if (cInfo.fullName != "" && cInfo.fullName != cInfo.displayName && cInfo.fullName != contact.profile.displayName) { Text( @@ -713,7 +717,8 @@ fun ChatInfoHeader(cInfo: ChatInfo, contact: Contact) { color = MaterialTheme.colors.onBackground, textAlign = TextAlign.Center, maxLines = 4, - overflow = TextOverflow.Ellipsis + overflow = TextOverflow.Ellipsis, + modifier = Modifier.combinedClickable(onClick = copyNameToClipboard, onLongClick = copyNameToClipboard).onRightClick(copyNameToClipboard) ) } } @@ -825,12 +830,14 @@ fun MuteButton( fun AudioCallButton( modifier: Modifier, chat: Chat, - contact: Contact + contact: Contact, + connectionStats: MutableState ) { CallButton( modifier = modifier, chat, contact, + connectionStats, icon = painterResource(MR.images.ic_call), title = generalGetString(MR.strings.info_view_call_button), mediaType = CallMediaType.Audio @@ -841,12 +848,14 @@ fun AudioCallButton( fun VideoButton( modifier: Modifier, chat: Chat, - contact: Contact + contact: Contact, + connectionStats: MutableState ) { CallButton( modifier = modifier, chat, contact, + connectionStats, icon = painterResource(MR.images.ic_videocam), title = generalGetString(MR.strings.info_view_video_button), mediaType = CallMediaType.Video @@ -858,6 +867,7 @@ fun CallButton( modifier: Modifier, chat: Chat, contact: Contact, + connectionStats: MutableState, icon: Painter, title: String, mediaType: CallMediaType @@ -879,7 +889,23 @@ fun CallButton( disabledLook = !canCall, onClick = when { - canCall -> { { startChatCall(chat.remoteHostId, chat.chatInfo, mediaType) } } + canCall -> { { + val connStats = connectionStats.value + if (connStats != null) { + if (connStats.ratchetSyncState == RatchetSyncState.Ok) { + startChatCall(chat.remoteHostId, chat.chatInfo, mediaType) + } else if (connStats.ratchetSyncAllowed) { + showFixConnectionAlert(syncConnection = { + withBGApi { syncContactConnection(chat.remoteHostId, contact, connectionStats, force = false) } + }) + } else { + AlertManager.shared.showAlertMsg( + generalGetString(MR.strings.cant_call_contact_alert_title), + generalGetString(MR.strings.encryption_renegotiation_in_progress) + ) + } + } + } } contact.nextSendGrpInv -> { { showCantCallContactSendMessageAlert() } } !contact.active -> { { showCantCallContactDeletedAlert() } } !contact.ready -> { { showCantCallContactConnectingAlert() } } @@ -1265,6 +1291,15 @@ fun showSyncConnectionForceAlert(syncConnectionForce: () -> Unit) { ) } +fun showFixConnectionAlert(syncConnection: () -> Unit) { + AlertManager.shared.showAlertDialog( + title = generalGetString(MR.strings.sync_connection_question), + text = generalGetString(MR.strings.sync_connection_desc), + confirmText = generalGetString(MR.strings.sync_connection_confirm), + onConfirm = syncConnection, + ) +} + fun queueInfoText(info: Pair): String { val (rcvMsgInfo, qInfo) = info val msgInfo: String = if (rcvMsgInfo != null) json.encodeToString(rcvMsgInfo) else generalGetString(MR.strings.message_queue_info_none) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatItemInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatItemInfoView.kt index d6744a0a0d..e62235bd7c 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatItemInfoView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatItemInfoView.kt @@ -296,6 +296,7 @@ fun ChatItemInfoView(chatRh: Long?, ci: ChatItem, ciInfo: ChatItemInfo, devTools } } SectionBottomSpacer() + SectionBottomSpacer() } } @@ -309,6 +310,7 @@ fun ChatItemInfoView(chatRh: Long?, ci: ChatItem, ciInfo: ChatItemInfo, devTools QuotedMsgView(qi) } SectionBottomSpacer() + SectionBottomSpacer() } } @@ -324,6 +326,7 @@ fun ChatItemInfoView(chatRh: Long?, ci: ChatItem, ciInfo: ChatItemInfo, devTools ForwardedFromView(forwardedFromItem) } SectionBottomSpacer() + SectionBottomSpacer() } } @@ -395,6 +398,7 @@ fun ChatItemInfoView(chatRh: Long?, ci: ChatItem, ciInfo: ChatItemInfo, devTools } } SectionBottomSpacer() + SectionBottomSpacer() } } @@ -433,12 +437,11 @@ fun ChatItemInfoView(chatRh: Long?, ci: ChatItem, ciInfo: ChatItemInfo, devTools Column { if (numTabs() > 1) { - Column( + Box( Modifier - .fillMaxHeight(), - verticalArrangement = Arrangement.SpaceBetween + .fillMaxHeight() ) { - Column(Modifier.weight(1f)) { + Column { when (val sel = selection.value) { is CIInfoTab.Delivery -> { DeliveryTab(sel.memberDeliveryStatuses) @@ -479,7 +482,7 @@ fun ChatItemInfoView(chatRh: Long?, ci: ChatItem, ciInfo: ChatItemInfo, devTools } } val oneHandUI = remember { appPrefs.oneHandUI.state } - Box(Modifier.offset(x = 0.dp, y = if (oneHandUI.value) -AppBarHeight * fontSizeSqrtMultiplier else 0.dp)) { + Box(Modifier.align(Alignment.BottomCenter).navigationBarsPadding().offset(x = 0.dp, y = if (oneHandUI.value) -AppBarHeight * fontSizeSqrtMultiplier else 0.dp)) { TabRow( selectedTabIndex = availableTabs.indexOfFirst { it::class == selection.value::class }, Modifier.height(AppBarHeight * fontSizeSqrtMultiplier), diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt index ddf25a6e3b..c58561718e 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt @@ -29,7 +29,9 @@ import androidx.compose.ui.unit.* import chat.simplex.common.model.* import chat.simplex.common.model.CIDirection.GroupRcv import chat.simplex.common.model.ChatController.appPrefs +import chat.simplex.common.model.ChatModel.activeCall import chat.simplex.common.model.ChatModel.controller +import chat.simplex.common.model.ChatModel.markChatTagRead import chat.simplex.common.model.ChatModel.withChats import chat.simplex.common.ui.theme.* import chat.simplex.common.views.call.* @@ -573,7 +575,8 @@ fun startChatCall(remoteHostId: Long?, chatInfo: ChatInfo, media: CallMediaType) if (chatInfo is ChatInfo.Direct) { val contactInfo = chatModel.controller.apiContactInfo(remoteHostId, chatInfo.contact.contactId) val profile = contactInfo?.second ?: chatModel.currentUser.value?.profile?.toProfile() ?: return@withBGApi - chatModel.activeCall.value = Call(remoteHostId = remoteHostId, contact = chatInfo.contact, callUUID = null, callState = CallState.WaitCapabilities, initialCallType = media, userProfile = profile) + activeCall.value?.androidCallState?.close() + chatModel.activeCall.value = Call(remoteHostId = remoteHostId, contact = chatInfo.contact, callUUID = null, callState = CallState.WaitCapabilities, initialCallType = media, userProfile = profile, androidCallState = platform.androidCreateActiveCallState()) chatModel.showCallView.value = true chatModel.callCommand.add(WCallCommand.Capabilities(media)) } @@ -663,13 +666,18 @@ fun ChatLayout( AdaptingBottomPaddingLayout(Modifier, CHAT_COMPOSE_LAYOUT_ID, composeViewHeight) { if (chatInfo != null) { Box(Modifier.fillMaxSize()) { - ChatItemsList( - remoteHostId, chatInfo, unreadCount, composeState, composeViewHeight, searchValue, - useLinkPreviews, linkMode, selectedChatItems, showMemberInfo, loadMessages, deleteMessage, deleteMessages, - receiveFile, cancelFile, joinGroup, acceptCall, acceptFeature, openDirectChat, forwardItem, - updateContactStats, updateMemberStats, syncContactConnection, syncMemberConnection, findModelChat, findModelMember, - setReaction, showItemDetails, markItemsRead, markChatRead, remember { { onComposed(it) } }, developerTools, showViaProxy, - ) + // disables scrolling to top of chat item on click inside the bubble + CompositionLocalProvider(LocalBringIntoViewSpec provides object : BringIntoViewSpec { + override fun calculateScrollDistance(offset: Float, size: Float, containerSize: Float): Float = 0f + }) { + ChatItemsList( + remoteHostId, chatInfo, unreadCount, composeState, composeViewHeight, searchValue, + useLinkPreviews, linkMode, selectedChatItems, showMemberInfo, showChatInfo = info, loadMessages, deleteMessage, deleteMessages, + receiveFile, cancelFile, joinGroup, acceptCall, acceptFeature, openDirectChat, forwardItem, + updateContactStats, updateMemberStats, syncContactConnection, syncMemberConnection, findModelChat, findModelMember, + setReaction, showItemDetails, markItemsRead, markChatRead, remember { { onComposed(it) } }, developerTools, showViaProxy, + ) + } } } Box( @@ -937,6 +945,7 @@ fun BoxScope.ChatItemsList( linkMode: SimplexLinkMode, selectedChatItems: MutableState?>, showMemberInfo: (GroupInfo, GroupMember) -> Unit, + showChatInfo: () -> Unit, loadMessages: suspend (ChatId, ChatPagination, ActiveChatState, visibleItemIndexesNonReversed: () -> IntRange) -> Unit, deleteMessage: (Long, CIDeleteMode) -> Unit, deleteMessages: (List) -> Unit, @@ -982,6 +991,7 @@ fun BoxScope.ChatItemsList( }) val maxHeight = remember { derivedStateOf { listState.value.layoutInfo.viewportEndOffset - topPaddingToContentPx.value } } val loadingMoreItems = remember { mutableStateOf(false) } + val animatedScrollingInProgress = remember { mutableStateOf(false) } val ignoreLoadingRequests = remember(remoteHostId) { mutableSetOf() } if (!loadingMoreItems.value) { PreloadItems(chatInfo.id, if (searchValueIsEmpty.value) ignoreLoadingRequests else mutableSetOf(), mergedItems, listState, ChatPagination.UNTIL_PRELOAD_COUNT) { chatId, pagination -> @@ -1002,7 +1012,7 @@ fun BoxScope.ChatItemsList( val chatInfoUpdated = rememberUpdatedState(chatInfo) val highlightedItems = remember { mutableStateOf(setOf()) } val scope = rememberCoroutineScope() - val scrollToItem: (Long) -> Unit = remember { scrollToItem(searchValue, loadingMoreItems, highlightedItems, chatInfoUpdated, maxHeight, scope, reversedChatItems, mergedItems, listState, loadMessages) } + val scrollToItem: (Long) -> Unit = remember { scrollToItem(searchValue, loadingMoreItems, animatedScrollingInProgress, highlightedItems, chatInfoUpdated, maxHeight, scope, reversedChatItems, mergedItems, listState, loadMessages) } val scrollToQuotedItemFromItem: (Long) -> Unit = remember { findQuotedItemFromItem(remoteHostIdUpdated, chatInfoUpdated, scope, scrollToItem) } LoadLastItems(loadingMoreItems, remoteHostId, chatInfo) @@ -1063,7 +1073,7 @@ fun BoxScope.ChatItemsList( highlightedItems.value = setOf() } } - ChatItemView(remoteHostId, chatInfo, cItem, composeState, provider, useLinkPreviews = useLinkPreviews, linkMode = linkMode, revealed = revealed, highlighted = highlighted, range = range, fillMaxWidth = fillMaxWidth, selectedChatItems = selectedChatItems, selectChatItem = { selectUnselectChatItem(true, cItem, revealed, selectedChatItems) }, deleteMessage = deleteMessage, deleteMessages = deleteMessages, receiveFile = receiveFile, cancelFile = cancelFile, joinGroup = joinGroup, acceptCall = acceptCall, acceptFeature = acceptFeature, openDirectChat = openDirectChat, forwardItem = forwardItem, updateContactStats = updateContactStats, updateMemberStats = updateMemberStats, syncContactConnection = syncContactConnection, syncMemberConnection = syncMemberConnection, findModelChat = findModelChat, findModelMember = findModelMember, scrollToItem = scrollToItem, scrollToQuotedItemFromItem = scrollToQuotedItemFromItem, setReaction = setReaction, showItemDetails = showItemDetails, reveal = reveal, showMemberInfo = showMemberInfo, developerTools = developerTools, showViaProxy = showViaProxy, itemSeparation = itemSeparation, showTimestamp = itemSeparation.timestamp) + ChatItemView(remoteHostId, chatInfo, cItem, composeState, provider, useLinkPreviews = useLinkPreviews, linkMode = linkMode, revealed = revealed, highlighted = highlighted, range = range, fillMaxWidth = fillMaxWidth, selectedChatItems = selectedChatItems, selectChatItem = { selectUnselectChatItem(true, cItem, revealed, selectedChatItems) }, deleteMessage = deleteMessage, deleteMessages = deleteMessages, receiveFile = receiveFile, cancelFile = cancelFile, joinGroup = joinGroup, acceptCall = acceptCall, acceptFeature = acceptFeature, openDirectChat = openDirectChat, forwardItem = forwardItem, updateContactStats = updateContactStats, updateMemberStats = updateMemberStats, syncContactConnection = syncContactConnection, syncMemberConnection = syncMemberConnection, findModelChat = findModelChat, findModelMember = findModelMember, scrollToItem = scrollToItem, scrollToQuotedItemFromItem = scrollToQuotedItemFromItem, setReaction = setReaction, showItemDetails = showItemDetails, reveal = reveal, showMemberInfo = showMemberInfo, showChatInfo = showChatInfo, developerTools = developerTools, showViaProxy = showViaProxy, itemSeparation = itemSeparation, showTimestamp = itemSeparation.timestamp) } } @@ -1312,7 +1322,7 @@ fun BoxScope.ChatItemsList( } } } - FloatingButtons(loadingMoreItems, mergedItems, unreadCount, maxHeight, composeViewHeight, searchValue, markChatRead, listState) + FloatingButtons(loadingMoreItems, animatedScrollingInProgress, mergedItems, unreadCount, maxHeight, composeViewHeight, searchValue, markChatRead, listState) FloatingDate(Modifier.padding(top = 10.dp + topPaddingToContent(true)).align(Alignment.TopCenter), mergedItems, listState) LaunchedEffect(Unit) { @@ -1321,6 +1331,15 @@ fun BoxScope.ChatItemsList( chatViewScrollState.value = it } } + LaunchedEffect(Unit) { + snapshotFlow { listState.value.isScrollInProgress } + .filter { !it } + .collect { + if (animatedScrollingInProgress.value) { + animatedScrollingInProgress.value = false + } + } + } } @Composable @@ -1398,6 +1417,7 @@ private fun NotifyChatListOnFinishingComposition( @Composable fun BoxScope.FloatingButtons( loadingMoreItems: MutableState, + animatedScrollingInProgress: MutableState, mergedItems: State, unreadCount: State, maxHeight: State, @@ -1437,8 +1457,14 @@ fun BoxScope.FloatingButtons( bottomUnreadCount, showBottomButtonWithCounter, showBottomButtonWithArrow, + animatedScrollingInProgress, composeViewHeight, - onClick = { scope.launch { tryBlockAndSetLoadingMore(loadingMoreItems) { listState.value.animateScrollToItem(0) } } } + onClick = { + scope.launch { + animatedScrollingInProgress.value = true + tryBlockAndSetLoadingMore(loadingMoreItems) { listState.value.animateScrollToItem(0) } + } + } ) // Don't show top FAB if is in search if (searchValue.value.isNotEmpty()) return @@ -1449,11 +1475,15 @@ fun BoxScope.FloatingButtons( TopEndFloatingButton( Modifier.padding(end = DEFAULT_PADDING, top = 24.dp + topPaddingToContent(true)).align(Alignment.TopEnd), topUnreadCount, + animatedScrollingInProgress, onClick = { val index = mergedItems.value.items.indexOfLast { it.hasUnread() } if (index != -1) { // scroll to the top unread item - scope.launch { tryBlockAndSetLoadingMore(loadingMoreItems) { listState.value.animateScrollToItem(index + 1, -maxHeight.value) } } + scope.launch { + animatedScrollingInProgress.value = true + tryBlockAndSetLoadingMore(loadingMoreItems) { listState.value.animateScrollToItem(index + 1, -maxHeight.value) } + } } }, onLongClick = { showDropDown.value = true } @@ -1593,10 +1623,11 @@ fun MemberImage(member: GroupMember) { private fun TopEndFloatingButton( modifier: Modifier = Modifier, unreadCount: State, + animatedScrollingInProgress: State, onClick: () -> Unit, onLongClick: () -> Unit ) { - if (unreadCount.value > 0) { + if (remember { derivedStateOf { unreadCount.value > 0 && !animatedScrollingInProgress.value } }.value) { val interactionSource = interactionSourceWithDetection(onClick, onLongClick) FloatingActionButton( {}, // no action here @@ -1837,6 +1868,7 @@ private fun lastFullyVisibleIemInListState(topPaddingToContentPx: State, de private fun scrollToItem( searchValue: State, loadingMoreItems: MutableState, + animatedScrollingInProgress: MutableState, highlightedItems: MutableState>, chatInfo: State, maxHeight: State, @@ -1874,6 +1906,7 @@ private fun scrollToItem( highlightedItems.value = setOf(itemId) } else { withContext(scope.coroutineContext) { + animatedScrollingInProgress.value = true listState.value.animateScrollToItem(min(reversedChatItems.value.lastIndex, index + 1), -maxHeight.value) highlightedItems.value = setOf(itemId) } @@ -1935,10 +1968,11 @@ private fun BoxScope.BottomEndFloatingButton( unreadCount: State, showButtonWithCounter: State, showButtonWithArrow: State, + animatedScrollingInProgress: State, composeViewHeight: State, onClick: () -> Unit ) = when { - showButtonWithCounter.value -> { + showButtonWithCounter.value && !animatedScrollingInProgress.value -> { FloatingActionButton( onClick = onClick, elevation = FloatingActionButtonDefaults.elevation(0.dp, 0.dp, 0.dp, 0.dp), @@ -1952,7 +1986,7 @@ private fun BoxScope.BottomEndFloatingButton( ) } } - showButtonWithArrow.value -> { + showButtonWithArrow.value && !animatedScrollingInProgress.value -> { FloatingActionButton( onClick = onClick, elevation = FloatingActionButtonDefaults.elevation(0.dp, 0.dp, 0.dp, 0.dp), @@ -2073,6 +2107,7 @@ private fun markUnreadChatAsRead(chatId: String) { if (success) { withChats { replaceChat(chatRh, chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = false))) + markChatTagRead(chat) } } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt index 5ee6e40e6e..c92ac2ddc3 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupChatInfoView.kt @@ -9,6 +9,7 @@ import SectionSpacer import SectionTextFooter import SectionView import androidx.compose.desktop.ui.tooling.preview.Preview +import androidx.compose.foundation.combinedClickable import androidx.compose.foundation.layout.* import androidx.compose.foundation.lazy.* import androidx.compose.material.* @@ -17,6 +18,8 @@ import androidx.compose.runtime.saveable.rememberSaveable import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier import androidx.compose.ui.graphics.Color +import androidx.compose.ui.platform.LocalClipboardManager +import androidx.compose.ui.text.AnnotatedString import dev.icerock.moko.resources.compose.painterResource import dev.icerock.moko.resources.compose.stringResource import androidx.compose.ui.text.font.FontWeight @@ -446,12 +449,18 @@ private fun GroupChatInfoHeader(cInfo: ChatInfo) { horizontalAlignment = Alignment.CenterHorizontally ) { ChatInfoImage(cInfo, size = 192.dp, iconColor = if (isInDarkTheme()) GroupDark else SettingsSecondaryLight) + val clipboard = LocalClipboardManager.current + val copyNameToClipboard = { + clipboard.setText(AnnotatedString(cInfo.displayName)) + showToast(generalGetString(MR.strings.copied)) + } Text( cInfo.displayName, style = MaterialTheme.typography.h1.copy(fontWeight = FontWeight.Normal), color = MaterialTheme.colors.onBackground, textAlign = TextAlign.Center, maxLines = 4, - overflow = TextOverflow.Ellipsis + overflow = TextOverflow.Ellipsis, + modifier = Modifier.combinedClickable(onClick = copyNameToClipboard, onLongClick = copyNameToClipboard).onRightClick(copyNameToClipboard) ) if (cInfo.fullName != "" && cInfo.fullName != cInfo.displayName) { Text( @@ -459,7 +468,8 @@ private fun GroupChatInfoHeader(cInfo: ChatInfo) { color = MaterialTheme.colors.onBackground, textAlign = TextAlign.Center, maxLines = 8, - overflow = TextOverflow.Ellipsis + overflow = TextOverflow.Ellipsis, + modifier = Modifier.combinedClickable(onClick = copyNameToClipboard, onLongClick = copyNameToClipboard).onRightClick(copyNameToClipboard) ) } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt index 7f0d5f088e..e607efeddc 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/group/GroupMemberInfoView.kt @@ -8,8 +8,7 @@ import SectionSpacer import SectionTextFooter import SectionView import androidx.compose.desktop.ui.tooling.preview.Preview -import java.net.URI -import androidx.compose.foundation.* +import androidx.compose.foundation.combinedClickable import androidx.compose.foundation.layout.* import androidx.compose.foundation.text.InlineTextContent import androidx.compose.foundation.text.appendInlineContent @@ -58,6 +57,19 @@ fun GroupMemberInfoView( val developerTools = chatModel.controller.appPrefs.developerTools.get() var progressIndicator by remember { mutableStateOf(false) } + fun syncMemberConnection() { + withBGApi { + val r = chatModel.controller.apiSyncGroupMemberRatchet(rhId, groupInfo.apiId, member.groupMemberId, force = false) + if (r != null) { + connStats.value = r.second + withChats { + updateGroupMemberConnectionStats(rhId, groupInfo, r.first, r.second) + } + close.invoke() + } + } + } + if (chat != null) { val newRole = remember { mutableStateOf(member.memberRole) } GroupMemberInfoLayout( @@ -78,19 +90,35 @@ fun GroupMemberInfoView( } }, createMemberContact = { - withBGApi { - progressIndicator = true - val memberContact = chatModel.controller.apiCreateMemberContact(rhId, groupInfo.apiId, member.groupMemberId) - if (memberContact != null) { - val memberChat = Chat(remoteHostId = rhId, ChatInfo.Direct(memberContact), chatItems = arrayListOf()) - withChats { - addChat(memberChat) - openLoadedChat(memberChat) + if (member.sendMsgEnabled) { + withBGApi { + progressIndicator = true + val memberContact = chatModel.controller.apiCreateMemberContact(rhId, groupInfo.apiId, member.groupMemberId) + if (memberContact != null) { + val memberChat = Chat(remoteHostId = rhId, ChatInfo.Direct(memberContact), chatItems = arrayListOf()) + withChats { + addChat(memberChat) + openLoadedChat(memberChat) + } + closeAll() + chatModel.setContactNetworkStatus(memberContact, NetworkStatus.Connected()) } - closeAll() - chatModel.setContactNetworkStatus(memberContact, NetworkStatus.Connected()) + progressIndicator = false + } + } else if (connectionStats != null) { + if (connectionStats.ratchetSyncAllowed) { + showFixConnectionAlert(syncConnection = { syncMemberConnection() }) + } else if (connectionStats.ratchetSyncInProgress) { + AlertManager.shared.showAlertMsg( + generalGetString(MR.strings.cant_send_message_to_member_alert_title), + generalGetString(MR.strings.encryption_renegotiation_in_progress) + ) + } else { + AlertManager.shared.showAlertMsg( + generalGetString(MR.strings.cant_send_message_to_member_alert_title), + generalGetString(MR.strings.connection_not_ready) + ) } - progressIndicator = false } }, connectViaAddress = { connReqUri -> @@ -149,16 +177,7 @@ fun GroupMemberInfoView( }) }, syncMemberConnection = { - withBGApi { - val r = chatModel.controller.apiSyncGroupMemberRatchet(rhId, groupInfo.apiId, member.groupMemberId, force = false) - if (r != null) { - connStats.value = r.second - withChats { - updateGroupMemberConnectionStats(rhId, groupInfo, r.first, r.second) - } - close.invoke() - } - } + syncMemberConnection() }, syncMemberConnectionForce = { showSyncConnectionForceAlert(syncConnectionForce = { @@ -335,14 +354,29 @@ fun GroupMemberInfoLayout( val knownChat = if (contactId != null) knownDirectChat(contactId) else null if (knownChat != null) { val (chat, contact) = knownChat + val knownContactConnectionStats: MutableState = remember { mutableStateOf(null) } + + LaunchedEffect(contact.contactId) { + withBGApi { + val contactInfo = chatModel.controller.apiContactInfo(chat.remoteHostId, chat.chatInfo.apiId) + if (contactInfo != null) { + knownContactConnectionStats.value = contactInfo.first + } + } + } + OpenChatButton(modifier = Modifier.fillMaxWidth(0.33f), onClick = { openDirectChat(contact.contactId) }) - AudioCallButton(modifier = Modifier.fillMaxWidth(0.5f), chat, contact) - VideoButton(modifier = Modifier.fillMaxWidth(1f), chat, contact) + AudioCallButton(modifier = Modifier.fillMaxWidth(0.5f), chat, contact, knownContactConnectionStats) + VideoButton(modifier = Modifier.fillMaxWidth(1f), chat, contact, knownContactConnectionStats) } else if (groupInfo.fullGroupPreferences.directMessages.on(groupInfo.membership)) { if (contactId != null) { OpenChatButton(modifier = Modifier.fillMaxWidth(0.33f), onClick = { openDirectChat(contactId) }) // legacy - only relevant for direct contacts created when joining group } else { - OpenChatButton(modifier = Modifier.fillMaxWidth(0.33f), onClick = { createMemberContact() }) + OpenChatButton( + modifier = Modifier.fillMaxWidth(0.33f), + disabledLook = !(member.sendMsgEnabled || (member.activeConn?.connectionStats?.ratchetSyncAllowed ?: false)), + onClick = { createMemberContact() } + ) } InfoViewActionButton(modifier = Modifier.fillMaxWidth(0.5f), painterResource(MR.images.ic_call), generalGetString(MR.strings.info_view_call_button), disabled = false, disabledLook = true, onClick = { showSendMessageToEnableCallsAlert() @@ -413,12 +447,12 @@ fun GroupMemberInfoLayout( SectionDividerSpaced() SectionView(title = stringResource(MR.strings.conn_stats_section_title_servers)) { SwitchAddressButton( - disabled = cStats.rcvQueuesInfo.any { it.rcvSwitchStatus != null } || cStats.ratchetSyncSendProhibited, + disabled = cStats.rcvQueuesInfo.any { it.rcvSwitchStatus != null } || !member.sendMsgEnabled, switchAddress = switchMemberAddress ) if (cStats.rcvQueuesInfo.any { it.rcvSwitchStatus != null }) { AbortSwitchAddressButton( - disabled = cStats.rcvQueuesInfo.any { it.rcvSwitchStatus != null && !it.canAbortSwitch } || cStats.ratchetSyncSendProhibited, + disabled = cStats.rcvQueuesInfo.any { it.rcvSwitchStatus != null && !it.canAbortSwitch } || !member.sendMsgEnabled, abortSwitchAddress = abortSwitchMemberAddress ) } @@ -504,13 +538,19 @@ fun GroupMemberInfoHeader(member: GroupMember) { Icon(painterResource(MR.images.ic_verified_user), null, tint = MaterialTheme.colors.secondary) } ) + val clipboard = LocalClipboardManager.current + val copyNameToClipboard = { + clipboard.setText(AnnotatedString(member.displayName)) + showToast(generalGetString(MR.strings.copied)) + } Text( text, inlineContent = inlineContent, style = MaterialTheme.typography.h1.copy(fontWeight = FontWeight.Normal), textAlign = TextAlign.Center, maxLines = 3, - overflow = TextOverflow.Ellipsis + overflow = TextOverflow.Ellipsis, + modifier = Modifier.combinedClickable(onClick = copyNameToClipboard, onLongClick = copyNameToClipboard).onRightClick(copyNameToClipboard) ) if (member.fullName != "" && member.fullName != member.displayName) { Text( @@ -518,7 +558,8 @@ fun GroupMemberInfoHeader(member: GroupMember) { color = MaterialTheme.colors.onBackground, textAlign = TextAlign.Center, maxLines = 4, - overflow = TextOverflow.Ellipsis + overflow = TextOverflow.Ellipsis, + modifier = Modifier.combinedClickable(onClick = copyNameToClipboard, onLongClick = copyNameToClipboard).onRightClick(copyNameToClipboard) ) } } @@ -578,6 +619,7 @@ fun RemoveMemberButton(onClick: () -> Unit) { @Composable fun OpenChatButton( modifier: Modifier, + disabledLook: Boolean = false, onClick: () -> Unit ) { InfoViewActionButton( @@ -585,7 +627,7 @@ fun OpenChatButton( icon = painterResource(MR.images.ic_chat_bubble), title = generalGetString(MR.strings.info_view_message_button), disabled = false, - disabledLook = false, + disabledLook = disabledLook, onClick = onClick ) } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt index 59643afdf4..2c16de40e9 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.kt @@ -1,12 +1,12 @@ package chat.simplex.common.views.chat.item -import androidx.compose.foundation.background import androidx.compose.foundation.combinedClickable import androidx.compose.foundation.layout.* import androidx.compose.foundation.shape.CornerSize import androidx.compose.foundation.shape.RoundedCornerShape import androidx.compose.material.* import androidx.compose.runtime.* +import androidx.compose.runtime.saveable.rememberSaveable import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier import androidx.compose.ui.draw.clip @@ -184,14 +184,26 @@ fun CIFileView( } } + val showOpenSaveMenu = rememberSaveable(file?.fileId) { mutableStateOf(false) } + val ext = file?.fileSource?.filePath?.substringAfterLast(".")?.takeIf { it.isNotBlank() } + val loadedFilePath = if (appPlatform.isAndroid && file?.fileSource != null) getLoadedFilePath(file) else null + if (loadedFilePath != null && file?.fileSource != null) { + val encrypted = file.fileSource.cryptoArgs != null + SaveOrOpenFileMenu(showOpenSaveMenu, encrypted, ext, File(loadedFilePath).toURI(), file.fileSource, saveFile = { fileAction() }) + } Row( Modifier .combinedClickable( - onClick = { fileAction() }, + onClick = { + if (appPlatform.isAndroid && loadedFilePath != null) { + showOpenSaveMenu.value = true + } else { + fileAction() + } + }, onLongClick = { showMenu.value = true } ) .padding(if (smallView) PaddingValues() else PaddingValues(top = 4.sp.toDp(), bottom = 6.sp.toDp(), start = 6.sp.toDp(), end = 12.sp.toDp())), - //Modifier.clickable(enabled = file?.fileSource != null) { if (file?.fileSource != null && getLoadedFilePath(file) != null) openFile(file.fileSource) }.padding(top = 4.dp, bottom = 6.dp, start = 6.dp, end = 12.dp), verticalAlignment = Alignment.Bottom, horizontalArrangement = Arrangement.spacedBy(2.sp.toDp()) ) { @@ -223,6 +235,16 @@ fun CIFileView( fun fileSizeValid(file: CIFile): Boolean = file.fileSize <= getMaxFileSize(file.fileProtocol) +@Composable +expect fun SaveOrOpenFileMenu( + showMenu: MutableState, + encrypted: Boolean, + ext: String?, + encryptedUri: URI, + fileSource: CryptoFile, + saveFile: () -> Unit +) + @Composable fun rememberSaveFileLauncher(ciFile: CIFile?): FileChooserLauncher = rememberFileChooserLauncher(false, ciFile) { to: URI? -> diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt index bf871ab626..647c74da06 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt @@ -24,12 +24,12 @@ import androidx.compose.ui.text.style.TextOverflow import androidx.compose.ui.unit.* import chat.simplex.common.model.* import chat.simplex.common.model.ChatModel.controller +import chat.simplex.common.model.ChatModel.currentUser import chat.simplex.common.platform.* import chat.simplex.common.ui.theme.* import chat.simplex.common.views.chat.* import chat.simplex.common.views.helpers.* import chat.simplex.res.MR -import kotlinx.coroutines.launch import kotlinx.datetime.Clock import kotlin.math.* @@ -51,6 +51,12 @@ fun chatEventText(eventText: String, ts: String): AnnotatedString = withStyle(chatEventStyle) { append("$eventText $ts") } } +data class ChatItemReactionMenuItem ( + val name: String, + val image: String?, + val onClick: (() -> Unit)? +) + @Composable fun ChatItemView( rhId: Long?, @@ -87,6 +93,7 @@ fun ChatItemView( showItemDetails: (ChatInfo, ChatItem) -> Unit, reveal: (Boolean) -> Unit, showMemberInfo: (GroupInfo, GroupMember) -> Unit, + showChatInfo: () -> Unit, developerTools: Boolean, showViaProxy: Boolean, showTimestamp: Boolean, @@ -120,7 +127,7 @@ fun ChatItemView( Row(verticalAlignment = Alignment.CenterVertically, modifier = Modifier.chatItemOffset(cItem, itemSeparation.largeGap, inverted = true, revealed = true)) { cItem.reactions.forEach { r -> val showReactionMenu = remember { mutableStateOf(false) } - val reactionMembers = remember { mutableStateOf(emptyList()) } + val reactionMenuItems = remember { mutableStateOf(emptyList()) } val interactionSource = remember { MutableInteractionSource() } val enterInteraction = remember { HoverInteraction.Enter() } KeyChangeEffect(highlighted.value) { @@ -134,18 +141,39 @@ fun ChatItemView( var modifier = Modifier.padding(horizontal = 5.dp, vertical = 2.dp).clip(RoundedCornerShape(8.dp)) if (cInfo.featureEnabled(ChatFeature.Reactions)) { fun showReactionsMenu() { - if (cInfo is ChatInfo.Group) { - withBGApi { - try { - val members = controller.apiGetReactionMembers(rhId, cInfo.groupInfo.groupId, cItem.id, r.reaction) - if (members != null) { - showReactionMenu.value = true - reactionMembers.value = members + when (cInfo) { + is ChatInfo.Group -> { + withBGApi { + try { + val members = controller.apiGetReactionMembers(rhId, cInfo.groupInfo.groupId, cItem.id, r.reaction) + if (members != null) { + showReactionMenu.value = true + reactionMenuItems.value = members.map { + val enabled = cInfo.groupInfo.membership.groupMemberId != it.groupMember.groupMemberId + val click = if (enabled) ({ showMemberInfo(cInfo.groupInfo, it.groupMember) }) else null + ChatItemReactionMenuItem(it.groupMember.displayName, it.groupMember.image, click) + } + } + } catch (e: Exception) { + Log.d(TAG, "chatItemView ChatItemReactions onLongClick: unexpected exception: ${e.stackTraceToString()}") } - } catch (e: Exception) { - Log.d(TAG, "hatItemView ChatItemReactions onLongClick: unexpected exception: ${e.stackTraceToString()}") } } + is ChatInfo.Direct -> { + showReactionMenu.value = true + val reactions = mutableListOf() + + if (!r.userReacted || r.totalReacted > 1) { + val contact = cInfo.contact + reactions.add(ChatItemReactionMenuItem(contact.displayName, contact.image, showChatInfo)) + } + + if (r.userReacted) { + reactions.add(ChatItemReactionMenuItem(generalGetString(MR.strings.sender_you_pronoun), currentUser.value?.image, null)) + } + reactionMenuItems.value = reactions + } + else -> {} } } modifier = modifier @@ -166,19 +194,19 @@ fun ChatItemView( Row(modifier.padding(2.dp), verticalAlignment = Alignment.CenterVertically) { ReactionIcon(r.reaction.text, fontSize = 12.sp) DefaultDropdownMenu(showMenu = showReactionMenu) { - reactionMembers.value.forEach { m -> + reactionMenuItems.value.forEach { m -> ItemAction( - text = m.groupMember.displayName, - composable = { ProfileImage(44.dp, m.groupMember.image) }, + text = m.name, + composable = { ProfileImage(44.dp, m.image) }, onClick = { - if (cInfo is ChatInfo.Group && cInfo.groupInfo.membership.groupMemberId != m.groupMember.groupMemberId) { - showMemberInfo(cInfo.groupInfo, m.groupMember) - showReactionMenu.value = false - } else { + val click = m.onClick + if (click != null) { + click() showReactionMenu.value = false } }, - lineLimit = 1 + lineLimit = 1, + color = if (m.onClick == null) MaterialTheme.colors.secondary else MenuTextColor ) } } @@ -839,6 +867,32 @@ fun ItemAction(text: String, icon: Painter, color: Color = Color.Unspecified, on } } +@Composable +fun ItemAction(text: String, icon: ImageBitmap, textColor: Color = Color.Unspecified, iconColor: Color = Color.Unspecified, onClick: () -> Unit) { + val finalColor = if (textColor == Color.Unspecified) { + MenuTextColor + } else textColor + DropdownMenuItem(onClick, contentPadding = PaddingValues(horizontal = DEFAULT_PADDING * 1.5f)) { + Row(verticalAlignment = Alignment.CenterVertically) { + Text( + text, + modifier = Modifier + .fillMaxWidth() + .weight(1F) + .padding(end = 15.dp), + color = finalColor, + maxLines = 1, + overflow = TextOverflow.Ellipsis + ) + if (iconColor == Color.Unspecified) { + Image(icon, text, Modifier.size(22.dp)) + } else { + Icon(icon, text, Modifier.size(22.dp), tint = iconColor) + } + } + } +} + @Composable fun ItemAction( text: String, @@ -1188,6 +1242,7 @@ fun PreviewChatItemView( showItemDetails = { _, _ -> }, reveal = {}, showMemberInfo = { _, _ ->}, + showChatInfo = {}, developerTools = false, showViaProxy = false, showTimestamp = true, @@ -1233,6 +1288,7 @@ fun PreviewChatItemViewDeletedContent() { showItemDetails = { _, _ -> }, reveal = {}, showMemberInfo = { _, _ ->}, + showChatInfo = {}, developerTools = false, showViaProxy = false, preview = true, diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt index 226030fcd4..2f0311b087 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt @@ -4,28 +4,34 @@ import SectionItemView import androidx.compose.foundation.layout.* import androidx.compose.material.* import androidx.compose.runtime.* -import androidx.compose.ui.Modifier -import androidx.compose.ui.graphics.Color import androidx.compose.ui.platform.LocalDensity import dev.icerock.moko.resources.compose.painterResource import dev.icerock.moko.resources.compose.stringResource import androidx.compose.ui.text.font.FontWeight import androidx.compose.ui.text.style.TextOverflow import androidx.compose.desktop.ui.tooling.preview.Preview +import androidx.compose.foundation.interaction.MutableInteractionSource +import androidx.compose.foundation.text.BasicTextField +import androidx.compose.material.MaterialTheme.colors import androidx.compose.runtime.saveable.rememberSaveable -import androidx.compose.runtime.snapshots.SnapshotStateList +import androidx.compose.ui.* +import androidx.compose.ui.focus.* +import androidx.compose.ui.graphics.* import androidx.compose.ui.text.AnnotatedString +import androidx.compose.ui.text.TextStyle import androidx.compose.ui.text.font.FontStyle +import androidx.compose.ui.text.input.VisualTransformation import androidx.compose.ui.text.style.TextAlign import androidx.compose.ui.unit.dp import androidx.compose.ui.unit.sp import chat.simplex.common.model.* +import chat.simplex.common.model.ChatModel.markChatTagRead +import chat.simplex.common.model.ChatModel.updateChatTagRead import chat.simplex.common.model.ChatModel.withChats import chat.simplex.common.platform.* import chat.simplex.common.ui.theme.* import chat.simplex.common.views.chat.* -import chat.simplex.common.views.chat.group.deleteGroupDialog -import chat.simplex.common.views.chat.group.leaveGroupDialog +import chat.simplex.common.views.chat.group.* import chat.simplex.common.views.chat.item.ItemAction import chat.simplex.common.views.contacts.onRequestAccepted import chat.simplex.common.views.helpers.* @@ -33,7 +39,6 @@ import chat.simplex.common.views.newchat.* import chat.simplex.res.MR import kotlinx.coroutines.* import kotlinx.datetime.Clock -import kotlin.math.min @Composable fun ChatListNavLinkView(chat: Chat, nextChatSelected: State) { @@ -252,6 +257,7 @@ fun ContactMenuItems(chat: Chat, contact: Contact, chatModel: ChatModel, showMen } ToggleFavoritesChatAction(chat, chatModel, chat.chatInfo.chatSettings?.favorite == true, showMenu) ToggleNotificationsChatAction(chat, chatModel, chat.chatInfo.ntfsEnabled, showMenu) + TagListAction(chat, showMenu) ClearChatAction(chat, showMenu) } DeleteContactAction(chat, chatModel, showMenu) @@ -291,6 +297,7 @@ fun GroupMenuItems( } ToggleFavoritesChatAction(chat, chatModel, chat.chatInfo.chatSettings?.favorite == true, showMenu) ToggleNotificationsChatAction(chat, chatModel, chat.chatInfo.ntfsEnabled, showMenu) + TagListAction(chat, showMenu) ClearChatAction(chat, showMenu) if (groupInfo.membership.memberCurrent) { LeaveGroupAction(chat.remoteHostId, groupInfo, chatModel, showMenu) @@ -337,6 +344,28 @@ fun MarkUnreadChatAction(chat: Chat, chatModel: ChatModel, showMenu: MutableStat ) } +@Composable +fun TagListAction( + chat: Chat, + showMenu: MutableState +) { + val userTags = remember { chatModel.userTags } + ItemAction( + stringResource(MR.strings.list_menu), + painterResource(MR.images.ic_label), + onClick = { + ModalManager.start.showModalCloseable { close -> + if (userTags.value.isEmpty()) { + TagListEditor(rhId = chat.remoteHostId, chat = chat, close = close) + } else { + TagListView(rhId = chat.remoteHostId, chat = chat, close = close) + } + } + showMenu.value = false + } + ) +} + @Composable fun ToggleFavoritesChatAction(chat: Chat, chatModel: ChatModel, favorite: Boolean, showMenu: MutableState) { ItemAction( @@ -557,6 +586,7 @@ fun markChatRead(c: Chat, chatModel: ChatModel) { if (success) { withChats { replaceChat(chat.remoteHostId, chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = false))) + markChatTagRead(chat) } } } @@ -568,6 +598,7 @@ fun markChatUnread(chat: Chat, chatModel: ChatModel) { if (chat.chatStats.unreadChat) return withApi { + val wasUnread = chat.unreadTag val success = chatModel.controller.apiChatUnread( chat.remoteHostId, chat.chatInfo.chatType, @@ -577,6 +608,7 @@ fun markChatUnread(chat: Chat, chatModel: ChatModel) { if (success) { withChats { replaceChat(chat.remoteHostId, chat.id, chat.copy(chatStats = chat.chatStats.copy(unreadChat = true))) + updateChatTagRead(chat, wasUnread) } } } @@ -826,12 +858,20 @@ fun updateChatSettings(remoteHostId: Long?, chatInfo: ChatInfo, chatSettings: Ch else -> false } if (res && newChatInfo != null) { + val chat = chatModel.getChat(chatInfo.id) + val wasUnread = chat?.unreadTag ?: false + val wasFavorite = chatInfo.chatSettings?.favorite ?: false + chatModel.updateChatFavorite(favorite = chatSettings.favorite, wasFavorite) withChats { updateChatInfo(remoteHostId, newChatInfo) } if (chatSettings.enableNtfs != MsgFilter.All) { ntfManager.cancelNotificationsForChat(chatInfo.id) } + val updatedChat = chatModel.getChat(chatInfo.id) + if (updatedChat != null) { + chatModel.updateChatTagRead(updatedChat, wasUnread) + } val current = currentState?.value if (current != null) { currentState.value = !current diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt index ff776bc8ca..4648ac5037 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListView.kt @@ -16,11 +16,13 @@ import androidx.compose.ui.focus.* import androidx.compose.ui.graphics.* import androidx.compose.ui.text.font.FontStyle import androidx.compose.ui.platform.* -import androidx.compose.ui.text.TextRange +import androidx.compose.ui.text.* import dev.icerock.moko.resources.compose.painterResource import dev.icerock.moko.resources.compose.stringResource import androidx.compose.ui.text.font.FontWeight import androidx.compose.ui.text.input.TextFieldValue +import androidx.compose.ui.text.style.TextAlign +import androidx.compose.ui.text.style.TextOverflow import androidx.compose.ui.unit.* import chat.simplex.common.AppLock import chat.simplex.common.model.* @@ -31,22 +33,30 @@ import chat.simplex.common.ui.theme.* import chat.simplex.common.views.helpers.* import chat.simplex.common.platform.* import chat.simplex.common.views.call.Call -import chat.simplex.common.views.chat.item.CIFileViewScope +import chat.simplex.common.views.chat.item.* import chat.simplex.common.views.chat.topPaddingToContent -import chat.simplex.common.views.mkValidName import chat.simplex.common.views.newchat.* import chat.simplex.common.views.onboarding.* -import chat.simplex.common.views.showInvalidNameAlert import chat.simplex.common.views.usersettings.* import chat.simplex.common.views.usersettings.networkAndServers.ConditionsLinkButton import chat.simplex.common.views.usersettings.networkAndServers.UsageConditionsView import chat.simplex.res.MR +import dev.icerock.moko.resources.ImageResource +import dev.icerock.moko.resources.StringResource import kotlinx.coroutines.* import kotlinx.coroutines.flow.MutableStateFlow import kotlinx.coroutines.flow.distinctUntilChanged import kotlinx.serialization.json.Json import kotlin.time.Duration.Companion.seconds +enum class PresetTagKind { FAVORITES, CONTACTS, GROUPS, BUSINESS } + +sealed class ActiveFilter { + data class PresetTag(val tag: PresetTagKind) : ActiveFilter() + data class UserTag(val tag: ChatTag) : ActiveFilter() + data object Unread: ActiveFilter() +} + private fun showNewChatSheet(oneHandUI: State) { ModalManager.start.closeModals() ModalManager.end.closeModals() @@ -187,6 +197,12 @@ fun ChatListView(chatModel: ChatModel, userPickerState: MutableStateFlow, listStat val oneHandUI = remember { appPrefs.oneHandUI.state } val oneHandUICardShown = remember { appPrefs.oneHandUICardShown.state } val addressCreationCardShown = remember { appPrefs.addressCreationCardShown.state } + val activeFilter = remember { chatModel.activeChatTagFilter } LaunchedEffect(listState.firstVisibleItemIndex, listState.firstVisibleItemScrollOffset) { val currentIndex = listState.firstVisibleItemIndex @@ -753,14 +777,13 @@ private fun BoxScope.ChatList(searchText: MutableState, listStat DisposableEffect(Unit) { onDispose { lazyListState = listState.firstVisibleItemIndex to listState.firstVisibleItemScrollOffset } } - val showUnreadAndFavorites = remember { ChatController.appPrefs.showUnreadAndFavorites.state }.value val allChats = remember { chatModel.chats } // In some not always reproducible situations this code produce IndexOutOfBoundsException on Compose's side // which is related to [derivedStateOf]. Using safe alternative instead // val chats by remember(search, showUnreadAndFavorites) { derivedStateOf { filteredChats(showUnreadAndFavorites, search, allChats.toList()) } } val searchShowingSimplexLink = remember { mutableStateOf(false) } val searchChatFilteredBySimplexLink = remember { mutableStateOf(null) } - val chats = filteredChats(showUnreadAndFavorites, searchShowingSimplexLink, searchChatFilteredBySimplexLink, searchText.value.text, allChats.value.toList()) + val chats = filteredChats(searchShowingSimplexLink, searchChatFilteredBySimplexLink, searchText.value.text, allChats.value.toList(), activeFilter.value) val topPaddingToContent = topPaddingToContent(false) val blankSpaceSize = if (oneHandUI.value) WindowInsets.navigationBars.asPaddingValues().calculateBottomPadding() + AppBarHeight * fontSizeSqrtMultiplier else topPaddingToContent LazyColumnWithScrollBar( @@ -791,11 +814,15 @@ private fun BoxScope.ChatList(searchText: MutableState, listStat ) { if (oneHandUI.value) { Column(Modifier.consumeWindowInsets(WindowInsets.navigationBars).consumeWindowInsets(PaddingValues(bottom = AppBarHeight))) { + Divider() + TagsView() ChatListSearchBar(listState, searchText, searchShowingSimplexLink, searchChatFilteredBySimplexLink) Spacer(Modifier.windowInsetsBottomHeight(WindowInsets.ime)) } } else { ChatListSearchBar(listState, searchText, searchShowingSimplexLink, searchChatFilteredBySimplexLink) + TagsView() + Divider() } } } @@ -815,8 +842,8 @@ private fun BoxScope.ChatList(searchText: MutableState, listStat } } if (chats.isEmpty() && chatModel.chats.value.isNotEmpty()) { - Box(Modifier.fillMaxSize().imePadding(), contentAlignment = Alignment.Center) { - Text(generalGetString(MR.strings.no_filtered_chats), color = MaterialTheme.colors.secondary) + Box(Modifier.fillMaxSize().imePadding().padding(horizontal = DEFAULT_PADDING), contentAlignment = Alignment.Center) { + NoChatsView(searchText = searchText) } } if (oneHandUI.value) { @@ -839,6 +866,41 @@ private fun BoxScope.ChatList(searchText: MutableState, listStat } } } + + LaunchedEffect(activeFilter.value) { + searchText.value = TextFieldValue("") + } +} + +@Composable +private fun NoChatsView(searchText: MutableState) { + val activeFilter = remember { chatModel.activeChatTagFilter }.value + + if (searchText.value.text.isBlank()) { + when (activeFilter) { + is ActiveFilter.PresetTag -> Text(generalGetString(MR.strings.no_filtered_chats), color = MaterialTheme.colors.secondary, textAlign = TextAlign.Center) // this should not happen + is ActiveFilter.UserTag -> Text(String.format(generalGetString(MR.strings.no_chats_in_list), activeFilter.tag.chatTagText), color = MaterialTheme.colors.secondary, textAlign = TextAlign.Center) + is ActiveFilter.Unread -> { + Row( + Modifier.clip(shape = CircleShape).clickable { chatModel.activeChatTagFilter.value = null }.padding(DEFAULT_PADDING_HALF), + horizontalArrangement = Arrangement.spacedBy(4.dp), + verticalAlignment = Alignment.CenterVertically + ) { + Icon( + painterResource(MR.images.ic_filter_list), + null, + tint = MaterialTheme.colors.secondary + ) + Text(generalGetString(MR.strings.no_unread_chats), color = MaterialTheme.colors.secondary, textAlign = TextAlign.Center) + } + } + null -> { + Text(generalGetString(MR.strings.no_chats), color = MaterialTheme.colors.secondary, textAlign = TextAlign.Center) + } + } + } else { + Text(generalGetString(MR.strings.no_chats_found), color = MaterialTheme.colors.secondary, textAlign = TextAlign.Center) + } } @Composable @@ -860,31 +922,301 @@ private fun ChatListFeatureCards() { } } +private val TAG_MIN_HEIGHT = 35.dp + +@Composable +private fun TagsView() { + val userTags = remember { chatModel.userTags } + val presetTags = remember { chatModel.presetTags } + val activeFilter = remember { chatModel.activeChatTagFilter } + val unreadTags = remember { chatModel.unreadTags } + val rhId = chatModel.remoteHostId() + + fun showTagList() { + ModalManager.start.showCustomModal { close -> + val editMode = remember { stateGetOrPut("editMode") { false } } + ModalView(close, showClose = true, endButtons = { + TextButton(onClick = { editMode.value = !editMode.value }, modifier = Modifier.clip(shape = CircleShape)) { + Text(stringResource(if (editMode.value) MR.strings.cancel_verb else MR.strings.edit_verb)) + } + }) { + TagListView(rhId = rhId, close = close, editMode = editMode) + } + } + } + val rowSizeModifier = Modifier.sizeIn(minHeight = TAG_MIN_HEIGHT * fontSizeSqrtMultiplier) + + TagsRow { + if (presetTags.size > 1) { + if (presetTags.size + userTags.value.size <= 3) { + PresetTagKind.entries.filter { t -> (presetTags[t] ?: 0) > 0 }.forEach { tag -> + ExpandedTagFilterView(tag) + } + } else { + CollapsedTagsFilterView() + } + } + + userTags.value.forEach { tag -> + val current = when (val af = activeFilter.value) { + is ActiveFilter.UserTag -> af.tag == tag + else -> false + } + val interactionSource = remember { MutableInteractionSource() } + Row( + rowSizeModifier + .clip(shape = CircleShape) + .combinedClickable( + onClick = { + if (chatModel.activeChatTagFilter.value == ActiveFilter.UserTag(tag)) { + chatModel.activeChatTagFilter.value = null + } else { + chatModel.activeChatTagFilter.value = ActiveFilter.UserTag(tag) + } + }, + onLongClick = { showTagList() }, + interactionSource = interactionSource, + indication = LocalIndication.current + ) + .onRightClick { showTagList() } + .padding(4.dp), + horizontalArrangement = Arrangement.Center, + verticalAlignment = Alignment.CenterVertically + ) { + if (tag.chatTagEmoji != null) { + ReactionIcon(tag.chatTagEmoji, fontSize = 14.sp) + } else { + Icon( + painterResource(if (current) MR.images.ic_label_filled else MR.images.ic_label), + null, + Modifier.size(18.sp.toDp()), + tint = if (current) MaterialTheme.colors.primary else MaterialTheme.colors.onBackground + ) + } + Spacer(Modifier.width(4.dp)) + Box { + val badgeText = if ((unreadTags[tag.chatTagId] ?: 0) > 0) " ●" else "" + val invisibleText = buildAnnotatedString { + append(tag.chatTagText) + withStyle(SpanStyle(fontSize = 12.sp, fontWeight = FontWeight.SemiBold)) { + append(badgeText) + } + } + Text( + text = invisibleText, + fontWeight = FontWeight.Medium, + fontSize = 15.sp, + color = Color.Transparent, + maxLines = 1, + overflow = TextOverflow.Ellipsis + ) + // Visible text with styles + val visibleText = buildAnnotatedString { + append(tag.chatTagText) + withStyle(SpanStyle(fontSize = 12.5.sp, color = MaterialTheme.colors.primary)) { + append(badgeText) + } + } + Text( + text = visibleText, + fontWeight = if (current) FontWeight.Medium else FontWeight.Normal, + fontSize = 15.sp, + color = if (current) MaterialTheme.colors.primary else MaterialTheme.colors.secondary, + maxLines = 1, + overflow = TextOverflow.Ellipsis + ) + } + } + } + val plusClickModifier = Modifier + .clickable { + ModalManager.start.showModalCloseable { close -> + TagListEditor(rhId = rhId, close = close) + } + } + + if (userTags.value.isEmpty()) { + Row(rowSizeModifier.clip(shape = CircleShape).then(plusClickModifier).padding(start = 2.dp, top = 4.dp, end = 6.dp, bottom = 4.dp), verticalAlignment = Alignment.CenterVertically) { + Icon(painterResource(MR.images.ic_add), stringResource(MR.strings.chat_list_add_list), Modifier.size(18.sp.toDp()), tint = MaterialTheme.colors.secondary) + Spacer(Modifier.width(2.dp)) + Text(stringResource(MR.strings.chat_list_add_list), color = MaterialTheme.colors.secondary, fontSize = 15.sp) + } + } else { + Box(rowSizeModifier, contentAlignment = Alignment.Center) { + Icon( + painterResource(MR.images.ic_add), stringResource(MR.strings.chat_list_add_list), Modifier.clip(shape = CircleShape).then(plusClickModifier).padding(2.dp), tint = MaterialTheme.colors.secondary + ) + } + } + } +} + +@OptIn(ExperimentalLayoutApi::class) +@Composable +private fun TagsRow(content: @Composable() (() -> Unit)) { + if (appPlatform.isAndroid) { + Row( + modifier = Modifier + .padding(horizontal = 14.dp) + .horizontalScroll(rememberScrollState()), + verticalAlignment = Alignment.CenterVertically, + horizontalArrangement = Arrangement.spacedBy(2.dp) + ) { + content() + } + } else { + FlowRow(modifier = Modifier.padding(horizontal = 14.dp)) { content() } + } +} + +@Composable +private fun ExpandedTagFilterView(tag: PresetTagKind) { + val activeFilter = remember { chatModel.activeChatTagFilter } + val active = when (val af = activeFilter.value) { + is ActiveFilter.PresetTag -> af.tag == tag + else -> false + } + val rowSizeModifier = Modifier.sizeIn(minHeight = TAG_MIN_HEIGHT * fontSizeSqrtMultiplier) + val (icon, text) = presetTagLabel(tag, active) + val color = if (active) MaterialTheme.colors.primary else MaterialTheme.colors.secondary + + Row( + modifier = rowSizeModifier + .clip(shape = CircleShape) + .clickable { + if (activeFilter.value == ActiveFilter.PresetTag(tag)) { + chatModel.activeChatTagFilter.value = null + } else { + chatModel.activeChatTagFilter.value = ActiveFilter.PresetTag(tag) + } + } + .padding(horizontal = 5.dp, vertical = 4.dp) + , + verticalAlignment = Alignment.CenterVertically, + horizontalArrangement = Arrangement.Center + ) { + Icon( + painterResource(icon), + stringResource(text), + Modifier.size(18.sp.toDp()), + tint = color + ) + Spacer(Modifier.width(4.dp)) + Box { + Text( + stringResource(text), + color = if (active) MaterialTheme.colors.primary else MaterialTheme.colors.secondary, + fontWeight = if (active) FontWeight.Medium else FontWeight.Normal, + fontSize = 15.sp + ) + Text( + stringResource(text), + color = Color.Transparent, + fontWeight = FontWeight.Medium, + fontSize = 15.sp + ) + } + } +} + + +@Composable +private fun CollapsedTagsFilterView() { + val activeFilter = remember { chatModel.activeChatTagFilter } + val presetTags = remember { chatModel.presetTags } + val showMenu = remember { mutableStateOf(false) } + + val selectedPresetTag = when (val af = activeFilter.value) { + is ActiveFilter.PresetTag -> af.tag + else -> null + } + + val rowSizeModifier = Modifier.sizeIn(minHeight = TAG_MIN_HEIGHT * fontSizeSqrtMultiplier) + Box(rowSizeModifier + .padding(vertical = 4.dp) + .clip(shape = CircleShape) + .size(30.sp.toDp()) + .clickable { showMenu.value = true }, + contentAlignment = Alignment.Center + ) { + if (selectedPresetTag != null) { + val (icon, text) = presetTagLabel(selectedPresetTag, true) + Icon( + painterResource(icon), + stringResource(text), + Modifier.size(18.sp.toDp()), + tint = MaterialTheme.colors.secondary + ) + } else { + Icon( + painterResource(MR.images.ic_menu), + stringResource(MR.strings.chat_list_all), + tint = MaterialTheme.colors.secondary + ) + } + + DefaultDropdownMenu(showMenu = showMenu) { + if (selectedPresetTag != null) { + ItemAction( + stringResource(MR.strings.chat_list_all), + painterResource(MR.images.ic_menu), + onClick = { + chatModel.activeChatTagFilter.value = null + showMenu.value = false + } + ) + } + PresetTagKind.entries.forEach { tag -> + if ((presetTags[tag] ?: 0) > 0) { + ItemPresetFilterAction(tag, tag == selectedPresetTag, showMenu) + } + } + } + } +} + +@Composable +fun ItemPresetFilterAction( + presetTag: PresetTagKind, + active: Boolean, + showMenu: MutableState +) { + val (icon, text) = presetTagLabel(presetTag, active) + ItemAction( + stringResource(text), + painterResource(icon), + onClick = { + chatModel.activeChatTagFilter.value = ActiveFilter.PresetTag(presetTag) + showMenu.value = false + } + ) +} + fun filteredChats( - showUnreadAndFavorites: Boolean, searchShowingSimplexLink: State, searchChatFilteredBySimplexLink: State, searchText: String, - chats: List + chats: List, + activeFilter: ActiveFilter? = null, ): List { val linkChatId = searchChatFilteredBySimplexLink.value return if (linkChatId != null) { chats.filter { it.id == linkChatId } } else { val s = if (searchShowingSimplexLink.value) "" else searchText.trim().lowercase() - if (s.isEmpty() && !showUnreadAndFavorites) - chats.filter { chat -> !chat.chatInfo.chatDeleted && chatContactType(chat) != ContactType.CARD } + if (s.isEmpty()) + chats.filter { chat -> !chat.chatInfo.chatDeleted && chatContactType(chat) != ContactType.CARD && filtered(chat, activeFilter) } else { chats.filter { chat -> when (val cInfo = chat.chatInfo) { is ChatInfo.Direct -> chatContactType(chat) != ContactType.CARD && !chat.chatInfo.chatDeleted && ( if (s.isEmpty()) { - chat.id == chatModel.chatId.value || filtered(chat) + chat.id == chatModel.chatId.value || filtered(chat, activeFilter) } else { cInfo.anyNameContains(s) }) is ChatInfo.Group -> if (s.isEmpty()) { - chat.id == chatModel.chatId.value || filtered(chat) || cInfo.groupInfo.membership.memberStatus == GroupMemberStatus.MemInvited + chat.id == chatModel.chatId.value || filtered(chat, activeFilter) || cInfo.groupInfo.membership.memberStatus == GroupMemberStatus.MemInvited } else { cInfo.anyNameContains(s) } @@ -898,10 +1230,41 @@ fun filteredChats( } } -private fun filtered(chat: Chat): Boolean = - (chat.chatInfo.chatSettings?.favorite ?: false) || - chat.chatStats.unreadChat || - (chat.chatInfo.ntfsEnabled && chat.chatStats.unreadCount > 0) +private fun filtered(chat: Chat, activeFilter: ActiveFilter?): Boolean = + when (activeFilter) { + is ActiveFilter.PresetTag -> presetTagMatchesChat(activeFilter.tag, chat.chatInfo) + is ActiveFilter.UserTag -> chat.chatInfo.chatTags?.contains(activeFilter.tag.chatTagId) ?: false + is ActiveFilter.Unread -> chat.chatStats.unreadChat || chat.chatInfo.ntfsEnabled && chat.chatStats.unreadCount > 0 + else -> true + } + +fun presetTagMatchesChat(tag: PresetTagKind, chatInfo: ChatInfo): Boolean = + when (tag) { + PresetTagKind.FAVORITES -> chatInfo.chatSettings?.favorite == true + PresetTagKind.CONTACTS -> when (chatInfo) { + is ChatInfo.Direct -> !(chatInfo.contact.activeConn == null && chatInfo.contact.profile.contactLink != null && chatInfo.contact.active) && !chatInfo.contact.chatDeleted + is ChatInfo.ContactRequest -> true + is ChatInfo.ContactConnection -> true + is ChatInfo.Group -> chatInfo.groupInfo.businessChat?.chatType == BusinessChatType.Customer + else -> false + } + PresetTagKind.GROUPS -> when (chatInfo) { + is ChatInfo.Group -> chatInfo.groupInfo.businessChat == null + else -> false + } + PresetTagKind.BUSINESS -> when (chatInfo) { + is ChatInfo.Group -> chatInfo.groupInfo.businessChat?.chatType == BusinessChatType.Business + else -> false + } + } + +private fun presetTagLabel(tag: PresetTagKind, active: Boolean): Pair = + when (tag) { + PresetTagKind.FAVORITES -> (if (active) MR.images.ic_star_filled else MR.images.ic_star) to MR.strings.chat_list_favorites + PresetTagKind.CONTACTS -> (if (active) MR.images.ic_person_filled else MR.images.ic_person) to MR.strings.chat_list_contacts + PresetTagKind.GROUPS -> (if (active) MR.images.ic_group_filled else MR.images.ic_group) to MR.strings.chat_list_groups + PresetTagKind.BUSINESS -> (if (active) MR.images.ic_work_filled else MR.images.ic_work) to MR.strings.chat_list_businesses + } fun scrollToBottom(scope: CoroutineScope, listState: LazyListState) { scope.launch { try { listState.animateScrollToItem(0) } catch (e: Exception) { Log.e(TAG, e.stackTraceToString()) } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt index e048c39fe7..aa9847c98a 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ShareListView.kt @@ -191,7 +191,7 @@ private fun ShareList( val chats by remember(search) { derivedStateOf { val sorted = chatModel.chats.value.toList().filter { it.chatInfo.ready }.sortedByDescending { it.chatInfo is ChatInfo.Local } - filteredChats(false, mutableStateOf(false), mutableStateOf(null), search, sorted) + filteredChats(mutableStateOf(false), mutableStateOf(null), search, sorted) } } val topPaddingToContent = topPaddingToContent(false) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/TagListView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/TagListView.kt new file mode 100644 index 0000000000..2cd0c953c7 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/TagListView.kt @@ -0,0 +1,500 @@ +package chat.simplex.common.views.chatlist + +import SectionCustomFooter +import SectionDivider +import SectionItemView +import TextIconSpaced +import androidx.compose.animation.core.animateDpAsState +import androidx.compose.foundation.LocalIndication +import androidx.compose.foundation.combinedClickable +import androidx.compose.foundation.interaction.MutableInteractionSource +import androidx.compose.foundation.layout.* +import androidx.compose.foundation.lazy.itemsIndexed +import androidx.compose.foundation.lazy.rememberLazyListState +import androidx.compose.foundation.text.BasicTextField +import androidx.compose.material.* +import androidx.compose.material.MaterialTheme.colors +import androidx.compose.material.TextFieldDefaults.indicatorLine +import androidx.compose.runtime.* +import androidx.compose.runtime.saveable.rememberSaveable +import androidx.compose.ui.Alignment +import androidx.compose.ui.Modifier +import androidx.compose.ui.focus.* +import androidx.compose.ui.graphics.Color +import androidx.compose.ui.graphics.SolidColor +import androidx.compose.ui.text.TextStyle +import androidx.compose.ui.text.font.FontWeight +import androidx.compose.ui.text.input.VisualTransformation +import androidx.compose.ui.text.style.TextAlign +import androidx.compose.ui.unit.dp +import androidx.compose.ui.unit.sp +import chat.simplex.common.model.* +import chat.simplex.common.model.ChatController.apiDeleteChatTag +import chat.simplex.common.model.ChatController.apiSetChatTags +import chat.simplex.common.model.ChatController.appPrefs +import chat.simplex.common.model.ChatModel.withChats +import chat.simplex.common.platform.* +import chat.simplex.common.ui.theme.* +import chat.simplex.common.views.chat.item.ItemAction +import chat.simplex.common.views.chat.item.ReactionIcon +import chat.simplex.common.views.chat.topPaddingToContent +import chat.simplex.common.views.helpers.* +import chat.simplex.res.MR +import dev.icerock.moko.resources.compose.painterResource +import dev.icerock.moko.resources.compose.stringResource + +@Composable +fun TagListView(rhId: Long?, chat: Chat? = null, close: () -> Unit, editMode: MutableState = remember { mutableStateOf(false) }) { + if (remember { editMode }.value) { + BackHandler { + editMode.value = false + } + } + val userTags = remember { chatModel.userTags } + val oneHandUI = remember { appPrefs.oneHandUI.state } + val listState = LocalAppBarHandler.current?.listState ?: rememberLazyListState() + val saving = remember { mutableStateOf(false) } + val chatTagIds = derivedStateOf { chat?.chatInfo?.chatTags ?: emptyList() } + + fun reorderTags(tagIds: List) { + saving.value = true + withBGApi { + try { + chatModel.controller.apiReorderChatTags(rhId, tagIds) + } catch (e: Exception) { + Log.d(TAG, "ChatListTag reorderTags error: ${e.message}") + } finally { + saving.value = false + } + } + } + + val dragDropState = + rememberDragDropState(listState) { fromIndex, toIndex -> + userTags.value = userTags.value.toMutableList().apply { add(toIndex, removeAt(fromIndex)) } + reorderTags(userTags.value.map { it.chatTagId }) + } + val topPaddingToContent = topPaddingToContent(false) + + LazyColumnWithScrollBar( + modifier = if (editMode.value) Modifier.dragContainer(dragDropState) else Modifier, + contentPadding = PaddingValues( + top = if (oneHandUI.value) WindowInsets.statusBars.asPaddingValues().calculateTopPadding() else topPaddingToContent, + bottom = if (oneHandUI.value) WindowInsets.navigationBars.asPaddingValues().calculateBottomPadding() + AppBarHeight * fontSizeSqrtMultiplier else 0.dp + ), + state = listState, + verticalArrangement = if (oneHandUI.value) Arrangement.Bottom else Arrangement.Top, + ) { + @Composable fun CreateList() { + SectionItemView({ + ModalManager.start.showModalCloseable { close -> + TagListEditor(rhId = rhId, close = close, chat = chat) + } + }) { + Icon(painterResource(MR.images.ic_add), stringResource(MR.strings.create_list), tint = MaterialTheme.colors.primary) + Spacer(Modifier.padding(horizontal = 4.dp)) + Text(stringResource(MR.strings.create_list), color = MaterialTheme.colors.primary) + } + } + + if (oneHandUI.value && !editMode.value) { + item { + CreateList() + } + } + itemsIndexed(userTags.value, key = { _, item -> item.chatTagId }) { index, tag -> + DraggableItem(dragDropState, index) { isDragging -> + val elevation by animateDpAsState(if (isDragging) 4.dp else 0.dp) + + Card( + elevation = elevation, + backgroundColor = if (isDragging) colors.surface else Color.Unspecified + ) { + Column { + val showMenu = remember { mutableStateOf(false) } + val selected = chatTagIds.value.contains(tag.chatTagId) + + Row( + Modifier + .fillMaxWidth() + .sizeIn(minHeight = DEFAULT_MIN_SECTION_ITEM_HEIGHT) + .combinedClickable( + enabled = !saving.value, + onClick = { + if (chat == null) { + ModalManager.start.showModalCloseable { close -> + TagListEditor( + rhId = rhId, + tagId = tag.chatTagId, + close = close, + emoji = tag.chatTagEmoji, + name = tag.chatTagText, + ) + } + } else { + saving.value = true + setTag(rhId = rhId, tagId = if (selected) null else tag.chatTagId, chat = chat, close = { + saving.value = false + close() + }) + } + }, + onLongClick = if (editMode.value) null else { + { showMenu.value = true } + }, + interactionSource = remember { MutableInteractionSource() }, + indication = LocalIndication.current + ) + .onRightClick { showMenu.value = true } + .padding(PaddingValues(horizontal = DEFAULT_PADDING, vertical = DEFAULT_MIN_SECTION_ITEM_PADDING_VERTICAL)), + verticalAlignment = Alignment.CenterVertically + ) { + if (tag.chatTagEmoji != null) { + ReactionIcon(tag.chatTagEmoji, fontSize = 14.sp) + } else { + Icon(painterResource(MR.images.ic_label), null, Modifier.size(18.sp.toDp()), tint = MaterialTheme.colors.onBackground) + } + Spacer(Modifier.padding(horizontal = 4.dp)) + Text( + tag.chatTagText, + color = MenuTextColor, + fontWeight = if (selected) FontWeight.Medium else FontWeight.Normal + ) + if (selected) { + Spacer(Modifier.weight(1f)) + Icon(painterResource(MR.images.ic_done_filled), null, Modifier.size(20.dp), tint = MaterialTheme.colors.onBackground) + } else if (editMode.value) { + Spacer(Modifier.weight(1f)) + Icon(painterResource(MR.images.ic_drag_handle), null, Modifier.size(20.dp), tint = MaterialTheme.colors.secondary) + } + DefaultDropdownMenu(showMenu, dropdownMenuItems = { + EditTagAction(rhId, tag, showMenu) + DeleteTagAction(rhId, tag, showMenu, saving) + }) + } + SectionDivider() + } + } + } + } + if (!oneHandUI.value && !editMode.value) { + item { + CreateList() + } + } + } +} + +@Composable +fun ModalData.TagListEditor( + rhId: Long?, + chat: Chat? = null, + tagId: Long? = null, + emoji: String? = null, + name: String = "", + close: () -> Unit +) { + val userTags = remember { chatModel.userTags } + val oneHandUI = remember { appPrefs.oneHandUI.state } + val newEmoji = remember { stateGetOrPutNullable("chatTagEmoji") { emoji } } + val newName = remember { stateGetOrPut("chatTagName") { name } } + val saving = remember { mutableStateOf(null) } + val trimmedName = remember { derivedStateOf { newName.value.trim() } } + val isDuplicateEmojiOrName = remember { + derivedStateOf { + userTags.value.any { tag -> + tag.chatTagId != tagId && + ((newEmoji.value != null && tag.chatTagEmoji == newEmoji.value) || tag.chatTagText == trimmedName.value) + } + } + } + + fun createTag() { + saving.value = true + withBGApi { + try { + val updatedTags = chatModel.controller.apiCreateChatTag(rhId, ChatTagData(newEmoji.value, trimmedName.value)) + if (updatedTags != null) { + saving.value = false + userTags.value = updatedTags + close() + } else { + saving.value = null + return@withBGApi + } + + if (chat != null) { + val createdTag = updatedTags.firstOrNull() { it.chatTagText == trimmedName.value && it.chatTagEmoji == newEmoji.value } + + if (createdTag != null) { + setTag(rhId, createdTag.chatTagId, chat, close = { + saving.value = false + close() + }) + } + } + } catch (e: Exception) { + Log.d(TAG, "createChatTag tag error: ${e.message}") + saving.value = null + } + } + } + + fun updateTag() { + saving.value = true + withBGApi { + try { + if (chatModel.controller.apiUpdateChatTag(rhId, tagId!!, ChatTagData(newEmoji.value, trimmedName.value))) { + userTags.value = userTags.value.map { tag -> + if (tag.chatTagId == tagId) { + tag.copy(chatTagEmoji = newEmoji.value, chatTagText = trimmedName.value) + } else { + tag + } + } + } else { + saving.value = null + return@withBGApi + } + saving.value = false + close() + } catch (e: Exception) { + Log.d(TAG, "ChatListTagEditor updateChatTag tag error: ${e.message}") + saving.value = null + } + } + } + + val showError = derivedStateOf { isDuplicateEmojiOrName.value && saving.value != false } + + ColumnWithScrollBar(Modifier.consumeWindowInsets(PaddingValues(bottom = if (oneHandUI.value) WindowInsets.ime.asPaddingValues().calculateBottomPadding().coerceIn(0.dp, WindowInsets.navigationBars.asPaddingValues().calculateBottomPadding()) else 0.dp))) { + if (oneHandUI.value) { + Spacer(Modifier.weight(1f)) + } + ChatTagInput(newName, showError, newEmoji) + val disabled = saving.value == true || + (trimmedName.value == name && newEmoji.value == emoji) || + trimmedName.value.isEmpty() || + isDuplicateEmojiOrName.value + + SectionItemView(click = { if (tagId == null) createTag() else updateTag() }, disabled = disabled) { + Text( + generalGetString(if (chat != null) MR.strings.add_to_list else if (tagId == null) MR.strings.create_list else MR.strings.save_list), + color = if (disabled) colors.secondary else colors.primary + ) + } + val showErrorMessage = isDuplicateEmojiOrName.value && saving.value != false + SectionCustomFooter { + Row( + Modifier.fillMaxWidth().padding(bottom = DEFAULT_PADDING), + verticalAlignment = Alignment.CenterVertically + ) { + Icon( + painterResource(MR.images.ic_error), + contentDescription = stringResource(MR.strings.error), + tint = if (showErrorMessage) Color.Red else Color.Transparent, + modifier = Modifier + .size(19.sp.toDp()) + .offset(x = 2.sp.toDp()) + ) + TextIconSpaced() + Text( + generalGetString(MR.strings.duplicated_list_error), + color = if (showErrorMessage) colors.secondary else Color.Transparent, + lineHeight = 18.sp, + fontSize = 14.sp + ) + } + } + } +} + +@Composable +private fun DeleteTagAction(rhId: Long?, tag: ChatTag, showMenu: MutableState, saving: MutableState) { + ItemAction( + stringResource(MR.strings.delete_chat_list_menu_action), + painterResource(MR.images.ic_delete), + onClick = { + deleteTagDialog(rhId, tag, saving) + showMenu.value = false + }, + color = Color.Red + ) +} + +@Composable +private fun EditTagAction(rhId: Long?, tag: ChatTag, showMenu: MutableState) { + ItemAction( + stringResource(MR.strings.edit_chat_list_menu_action), + painterResource(MR.images.ic_edit), + onClick = { + showMenu.value = false + ModalManager.start.showModalCloseable { close -> + TagListEditor( + rhId = rhId, + tagId = tag.chatTagId, + close = close, + emoji = tag.chatTagEmoji, + name = tag.chatTagText + ) + } + }, + color = MenuTextColor + ) +} + +@Composable +expect fun ChatTagInput(name: MutableState, showError: State, emoji: MutableState) + +@Composable +fun TagListNameTextField(name: MutableState, showError: State) { + var focused by rememberSaveable { mutableStateOf(false) } + val focusRequester = remember { FocusRequester() } + val interactionSource = remember { MutableInteractionSource() } + val colors = TextFieldDefaults.textFieldColors( + backgroundColor = Color.Unspecified, + focusedIndicatorColor = MaterialTheme.colors.secondary.copy(alpha = 0.6f), + unfocusedIndicatorColor = CurrentColors.value.colors.secondary.copy(alpha = 0.3f), + cursorColor = MaterialTheme.colors.secondary, + ) + BasicTextField( + value = name.value, + onValueChange = { name.value = it }, + interactionSource = interactionSource, + modifier = Modifier + .fillMaxWidth() + .indicatorLine(true, showError.value, interactionSource, colors) + .heightIn(min = TextFieldDefaults.MinHeight) + .onFocusChanged { focused = it.isFocused } + .focusRequester(focusRequester), + textStyle = TextStyle(fontSize = 18.sp, color = MaterialTheme.colors.onBackground), + singleLine = true, + cursorBrush = SolidColor(MaterialTheme.colors.secondary), + decorationBox = @Composable { innerTextField -> + TextFieldDefaults.TextFieldDecorationBox( + value = name.value, + innerTextField = innerTextField, + placeholder = { + Text(generalGetString(MR.strings.list_name_field_placeholder), style = MaterialTheme.typography.body1.copy(color = MaterialTheme.colors.secondary, lineHeight = 22.sp)) + }, + contentPadding = PaddingValues(), + label = null, + visualTransformation = VisualTransformation.None, + leadingIcon = null, + singleLine = true, + enabled = true, + isError = false, + interactionSource = remember { MutableInteractionSource() }, + colors = TextFieldDefaults.textFieldColors(backgroundColor = Color.Unspecified) + ) + } + ) +} + +private fun setTag(rhId: Long?, tagId: Long?, chat: Chat, close: () -> Unit) { + withBGApi { + val tagIds: List = if (tagId == null) { + emptyList() + } else { + listOf(tagId) + } + + try { + val result = apiSetChatTags(rh = rhId, type = chat.chatInfo.chatType, id = chat.chatInfo.apiId, tagIds = tagIds) + + if (result != null) { + val oldTags = chat.chatInfo.chatTags + chatModel.userTags.value = result.first + when (val cInfo = chat.chatInfo) { + is ChatInfo.Direct -> { + val contact = cInfo.contact.copy(chatTags = result.second) + withChats { + updateContact(rhId, contact) + } + } + + is ChatInfo.Group -> { + val group = cInfo.groupInfo.copy(chatTags = result.second) + withChats { + updateGroup(rhId, group) + } + } + + else -> {} + } + chatModel.moveChatTagUnread(chat, oldTags, result.second) + close() + } + } catch (e: Exception) { + Log.d(TAG, "setChatTag error: ${e.message}") + } + } +} + +private fun deleteTag(rhId: Long?, tag: ChatTag, saving: MutableState) { + withBGApi { + saving.value = true + + try { + val tagId = tag.chatTagId + if (apiDeleteChatTag(rhId, tagId)) { + chatModel.userTags.value = chatModel.userTags.value.filter { it.chatTagId != tagId } + if (chatModel.activeChatTagFilter.value == ActiveFilter.UserTag(tag)) { + chatModel.activeChatTagFilter.value = null + } + chatModel.chats.value.forEach { c -> + when (val cInfo = c.chatInfo) { + is ChatInfo.Direct -> { + val contact = cInfo.contact.copy(chatTags = cInfo.contact.chatTags.filter { it != tagId }) + withChats { + updateContact(rhId, contact) + } + } + is ChatInfo.Group -> { + val group = cInfo.groupInfo.copy(chatTags = cInfo.groupInfo.chatTags.filter { it != tagId }) + withChats { + updateGroup(rhId, group) + } + } + else -> {} + } + } + } + + } catch (e: Exception) { + Log.d(TAG, "deleteTag error: ${e.message}") + } finally { + saving.value = false + } + } +} + +private fun deleteTagDialog(rhId: Long?, tag: ChatTag, saving: MutableState) { + AlertManager.shared.showAlertDialogButtonsColumn( + title = generalGetString(MR.strings.delete_chat_list_question), + text = String.format(generalGetString(MR.strings.delete_chat_list_warning), tag.chatTagText), + buttons = { + SectionItemView({ + AlertManager.shared.hideAlert() + deleteTag(rhId, tag, saving) + }) { + Text( + generalGetString(MR.strings.confirm_verb), + Modifier.fillMaxWidth(), + textAlign = TextAlign.Center, + color = colors.error + ) + } + SectionItemView({ + AlertManager.shared.hideAlert() + }) { + Text( + stringResource(MR.strings.cancel_verb), + Modifier.fillMaxWidth(), + textAlign = TextAlign.Center, + color = colors.primary + ) + } + } + ) +} diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt index ab908e4c5f..28772f01d3 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/database/DatabaseView.kt @@ -30,6 +30,7 @@ import kotlinx.datetime.* import java.io.* import java.net.URI import java.nio.file.Files +import java.nio.file.StandardCopyOption import java.text.SimpleDateFormat import java.util.* import kotlin.collections.ArrayList @@ -44,11 +45,14 @@ fun DatabaseView() { val chatArchiveFile = remember { mutableStateOf(null) } val stopped = remember { m.chatRunning }.value == false val saveArchiveLauncher = rememberFileChooserLauncher(false) { to: URI? -> - val file = chatArchiveFile.value - if (file != null && to != null) { - copyFileToFile(File(file), to) { - chatArchiveFile.value = null - } + val archive = chatArchiveFile.value + if (archive != null && to != null) { + copyFileToFile(File(archive), to) {} + } + // delete no matter the database was exported or canceled the export process + if (archive != null) { + File(archive).delete() + chatArchiveFile.value = null } } val appFilesCountAndSize = remember { mutableStateOf(directoryFileCountAndSize(appFilesDir.absolutePath)) } @@ -56,8 +60,7 @@ fun DatabaseView() { if (to != null) { importArchiveAlert { stopChatRunBlockStartChat(stopped, chatLastStart, progressIndicator) { - importArchive(to, appFilesCountAndSize, progressIndicator) - true + importArchive(to, appFilesCountAndSize, progressIndicator, false) } } } @@ -641,6 +644,7 @@ suspend fun importArchive( importedArchiveURI: URI, appFilesCountAndSize: MutableState>, progressIndicator: MutableState, + migration: Boolean ): Boolean { val m = chatModel progressIndicator.value = true @@ -662,12 +666,13 @@ suspend fun importArchive( if (chatModel.localUserCreated.value == false) { chatModel.chatRunning.value = false } + return true } else { operationEnded(m, progressIndicator) { showArchiveImportedWithErrorsAlert(archiveErrors) } + return migration } - return true } catch (e: Error) { operationEnded(m, progressIndicator) { AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_importing_database), e.toString()) @@ -680,6 +685,8 @@ suspend fun importArchive( } finally { File(archivePath).delete() } + } else { + progressIndicator.value = false } return false } @@ -691,14 +698,15 @@ private fun saveArchiveFromURI(importedArchiveURI: URI): String? { if (inputStream != null && archiveName != null) { val archivePath = "$databaseExportDir${File.separator}$archiveName" val destFile = File(archivePath) - Files.copy(inputStream, destFile.toPath()) + Files.copy(inputStream, destFile.toPath(), StandardCopyOption.REPLACE_EXISTING) archivePath } else { Log.e(TAG, "saveArchiveFromURI null inputStream") null } } catch (e: Exception) { - Log.e(TAG, "saveArchiveFromURI error: ${e.message}") + AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_saving_database), e.stackTraceToString()) + Log.e(TAG, "saveArchiveFromURI error: ${e.stackTraceToString()}") null } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/DragAndDrop.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/DragAndDrop.kt new file mode 100644 index 0000000000..cded400892 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/helpers/DragAndDrop.kt @@ -0,0 +1,177 @@ +package chat.simplex.common.views.helpers + +/* + * This was adapted from google example of drag and drop for Jetpack Compose + * https://cs.android.com/androidx/platform/frameworks/support/+/androidx-main:compose/foundation/foundation/integration-tests/foundation-demos/src/main/java/androidx/compose/foundation/demos/LazyColumnDragAndDropDemo.kt + */ + +import androidx.compose.animation.core.* +import androidx.compose.foundation.gestures.detectDragGesturesAfterLongPress +import androidx.compose.foundation.gestures.scrollBy +import androidx.compose.foundation.layout.Column +import androidx.compose.foundation.layout.ColumnScope +import androidx.compose.foundation.lazy.* +import androidx.compose.runtime.* +import androidx.compose.ui.Modifier +import androidx.compose.ui.geometry.Offset +import androidx.compose.ui.graphics.graphicsLayer +import androidx.compose.ui.input.pointer.pointerInput +import androidx.compose.ui.zIndex +import kotlinx.coroutines.CoroutineScope +import kotlinx.coroutines.channels.Channel +import kotlinx.coroutines.launch + +@Composable +fun rememberDragDropState(lazyListState: LazyListState, onMove: (Int, Int) -> Unit): DragDropState { + val scope = rememberCoroutineScope() + val state = + remember(lazyListState) { + DragDropState(state = lazyListState, onMove = onMove, scope = scope) + } + LaunchedEffect(state) { + while (true) { + val diff = state.scrollChannel.receive() + lazyListState.scrollBy(diff) + } + } + return state +} + +class DragDropState +internal constructor( + private val state: LazyListState, + private val scope: CoroutineScope, + private val onMove: (Int, Int) -> Unit +) { + var draggingItemIndex by mutableStateOf(null) + private set + + internal val scrollChannel = Channel() + + private var draggingItemDraggedDelta by mutableFloatStateOf(0f) + private var draggingItemInitialOffset by mutableIntStateOf(0) + internal val draggingItemOffset: Float + get() = + draggingItemLayoutInfo?.let { item -> + draggingItemInitialOffset + draggingItemDraggedDelta - item.offset + } ?: 0f + + private val draggingItemLayoutInfo: LazyListItemInfo? + get() = state.layoutInfo.visibleItemsInfo.firstOrNull { it.index == draggingItemIndex } + + internal var previousIndexOfDraggedItem by mutableStateOf(null) + private set + + internal var previousItemOffset = Animatable(0f) + private set + + internal fun onDragStart(offset: Offset) { + val touchY = offset.y.toInt() + val item = state.layoutInfo.visibleItemsInfo.minByOrNull { + val itemCenter = (it.offset - state.layoutInfo.viewportStartOffset) + it.size / 2 + kotlin.math.abs(touchY - itemCenter) // Find the item closest to the touch position, needs to take viewportStartOffset into account + } + + if (item != null) { + draggingItemIndex = item.index + draggingItemInitialOffset = item.offset + } + } + + + internal fun onDragInterrupted() { + if (draggingItemIndex != null) { + previousIndexOfDraggedItem = draggingItemIndex + val startOffset = draggingItemOffset + scope.launch { + previousItemOffset.snapTo(startOffset) + previousItemOffset.animateTo( + 0f, + spring(stiffness = Spring.StiffnessMediumLow, visibilityThreshold = 1f) + ) + previousIndexOfDraggedItem = null + } + } + draggingItemDraggedDelta = 0f + draggingItemIndex = null + draggingItemInitialOffset = 0 + } + + internal fun onDrag(offset: Offset) { + draggingItemDraggedDelta += offset.y + + val draggingItem = draggingItemLayoutInfo ?: return + val startOffset = draggingItem.offset + draggingItemOffset + val endOffset = startOffset + draggingItem.size + val middleOffset = startOffset + (endOffset - startOffset) / 2f + + val targetItem = + state.layoutInfo.visibleItemsInfo.find { item -> + middleOffset.toInt() in item.offset..item.offsetEnd && + draggingItem.index != item.index + } + if (targetItem != null) { + if ( + draggingItem.index == state.firstVisibleItemIndex || + targetItem.index == state.firstVisibleItemIndex + ) { + state.requestScrollToItem( + state.firstVisibleItemIndex, + state.firstVisibleItemScrollOffset + ) + } + onMove.invoke(draggingItem.index, targetItem.index) + draggingItemIndex = targetItem.index + } else { + val overscroll = + when { + draggingItemDraggedDelta > 0 -> + (endOffset - state.layoutInfo.viewportEndOffset).coerceAtLeast(0f) + draggingItemDraggedDelta < 0 -> + (startOffset - state.layoutInfo.viewportStartOffset).coerceAtMost(0f) + else -> 0f + } + if (overscroll != 0f) { + scrollChannel.trySend(overscroll) + } + } + } + + private val LazyListItemInfo.offsetEnd: Int + get() = this.offset + this.size +} + +fun Modifier.dragContainer(dragDropState: DragDropState): Modifier { + return pointerInput(dragDropState) { + detectDragGesturesAfterLongPress( + onDrag = { change, offset -> + change.consume() + dragDropState.onDrag(offset = offset) + }, + onDragStart = { offset -> dragDropState.onDragStart(offset) }, + onDragEnd = { dragDropState.onDragInterrupted() }, + onDragCancel = { dragDropState.onDragInterrupted() } + ) + } +} + +@Composable +fun LazyItemScope.DraggableItem( + dragDropState: DragDropState, + index: Int, + modifier: Modifier = Modifier, + content: @Composable ColumnScope.(isDragging: Boolean) -> Unit +) { + val dragging = index == dragDropState.draggingItemIndex + val draggingModifier = + if (dragging) { + Modifier.zIndex(1f).graphicsLayer { translationY = dragDropState.draggingItemOffset } + } else if (index == dragDropState.previousIndexOfDraggedItem) { + Modifier.zIndex(1f).graphicsLayer { + translationY = dragDropState.previousItemOffset.value + } + } else { + Modifier.animateItem(fadeInSpec = null, fadeOutSpec = null) + } + Column(modifier = modifier.then(draggingModifier)) { content(dragging) } +} diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateFromDevice.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateFromDevice.kt index d3f3facbd9..8588e0e981 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateFromDevice.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateFromDevice.kt @@ -174,7 +174,7 @@ private fun SectionByState( is MigrationFromState.UploadProgress -> migrationState.UploadProgressView(s.uploadedBytes, s.totalBytes, s.ctrl, s.user, tempDatabaseFile, chatReceiver, s.archivePath) is MigrationFromState.UploadFailed -> migrationState.UploadFailedView(s.totalBytes, s.archivePath, chatReceiver.value) is MigrationFromState.LinkCreation -> LinkCreationView() - is MigrationFromState.LinkShown -> migrationState.LinkShownView(s.fileId, s.link, s.ctrl) + is MigrationFromState.LinkShown -> migrationState.LinkShownView(s.fileId, s.link, s.ctrl, chatReceiver.value) is MigrationFromState.Finished -> migrationState.FinishedView(s.chatDeletion) } } @@ -335,7 +335,7 @@ private fun LinkCreationView() { } @Composable -private fun MutableState.LinkShownView(fileId: Long, link: String, ctrl: ChatCtrl) { +private fun MutableState.LinkShownView(fileId: Long, link: String, ctrl: ChatCtrl, chatReceiver: MigrationFromChatReceiver?) { SectionView { SettingsActionItemWithContent( icon = painterResource(MR.images.ic_close), @@ -356,7 +356,7 @@ private fun MutableState.LinkShownView(fileId: Long, link: S confirmText = generalGetString(MR.strings.continue_to_next_step), destructive = true, onConfirm = { - finishMigration(fileId, ctrl) + finishMigration(fileId, ctrl, chatReceiver) } ) } @@ -450,6 +450,7 @@ private fun MutableState.stopChat() { try { controller.apiSaveAppSettings(AppSettings.current.prepareForExport()) state = if (appPreferences.initialRandomDBPassphrase.get()) MigrationFromState.PassphraseNotSet else MigrationFromState.PassphraseConfirmation + platform.androidChatStopped() } catch (e: Exception) { AlertManager.shared.showAlertMsg( title = generalGetString(MR.strings.migrate_from_device_error_saving_settings), @@ -617,9 +618,11 @@ private fun cancelMigration(fileId: Long, ctrl: ChatCtrl) { } } -private fun MutableState.finishMigration(fileId: Long, ctrl: ChatCtrl) { +private fun MutableState.finishMigration(fileId: Long, ctrl: ChatCtrl, chatReceiver: MigrationFromChatReceiver?) { withBGApi { cancelUploadedArchive(fileId, ctrl) + chatReceiver?.stopAndCleanUp() + getMigrationTempFilesDirectory().deleteRecursively() state = MigrationFromState.Finished(false) } } @@ -655,6 +658,7 @@ private suspend fun startChatAndDismiss(dismiss: Boolean = true) { } else if (user != null) { startChat(user) } + platform.androidChatStartedAfterBeingOff() } catch (e: Exception) { AlertManager.shared.showAlertMsg( title = generalGetString(MR.strings.error_starting_chat), diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateToDevice.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateToDevice.kt index 788c07a9d2..1a28bbf589 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateToDevice.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/migration/MigrateToDevice.kt @@ -239,7 +239,7 @@ private fun ArchiveImportView(progressIndicator: MutableState, close: ( val importArchiveLauncher = rememberFileChooserLauncher(true) { to: URI? -> if (to != null) { withLongRunningApi { - val success = importArchive(to, mutableStateOf(0 to 0), progressIndicator) + val success = importArchive(to, mutableStateOf(0 to 0), progressIndicator, true) if (success) { startChat( chatModel, @@ -691,6 +691,7 @@ private suspend fun finishMigration(appSettings: AppSettings, close: () -> Unit) if (user != null) { startChat(user) } + platform.androidChatStartedAfterBeingOff() hideView(close) AlertManager.shared.showAlertMsg(generalGetString(MR.strings.migrate_to_device_chat_migrated), generalGetString(MR.strings.migrate_to_device_finalize_migration)) } catch (e: Exception) { diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/ChooseServerOperators.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/ChooseServerOperators.kt index dcb7d7e133..2f84166362 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/ChooseServerOperators.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/onboarding/ChooseServerOperators.kt @@ -14,10 +14,8 @@ import androidx.compose.runtime.* import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier import androidx.compose.ui.text.AnnotatedString -import androidx.compose.ui.text.font.FontWeight import androidx.compose.ui.text.style.TextAlign import androidx.compose.ui.unit.dp -import androidx.compose.ui.unit.sp import chat.simplex.common.model.* import chat.simplex.common.model.ChatController.appPrefs import chat.simplex.common.platform.* @@ -55,7 +53,7 @@ fun ModalData.ChooseServerOperators( Column(Modifier.fillMaxWidth().padding(horizontal = DEFAULT_PADDING), horizontalAlignment = Alignment.CenterHorizontally) { OnboardingInformationButton( stringResource(MR.strings.how_it_helps_privacy), - onClick = { modalManager.showModal { ChooseServerOperatorsInfoView() } } + onClick = { modalManager.showModal { ChooseServerOperatorsInfoView(modalManager) } } ) } @@ -346,7 +344,9 @@ private fun enabledOperators(operators: List, selectedOperatorId } @Composable -private fun ChooseServerOperatorsInfoView() { +private fun ChooseServerOperatorsInfoView( + modalManager: ModalManager +) { ColumnWithScrollBar { AppBarTitle(stringResource(MR.strings.onboarding_network_operators)) @@ -362,7 +362,7 @@ private fun ChooseServerOperatorsInfoView() { SectionView(title = stringResource(MR.strings.onboarding_network_about_operators).uppercase()) { chatModel.conditions.value.serverOperators.forEach { op -> - ServerOperatorRow(op) + ServerOperatorRow(op, modalManager) } } SectionBottomSpacer() @@ -371,11 +371,12 @@ private fun ChooseServerOperatorsInfoView() { @Composable() private fun ServerOperatorRow( - operator: ServerOperator + operator: ServerOperator, + modalManager: ModalManager ) { SectionItemView( { - ModalManager.start.showModalCloseable { close -> + modalManager.showModalCloseable { close -> OperatorInfoView(operator) } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt index 87770e9ffd..c5a4ae5f70 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt @@ -14,6 +14,7 @@ import androidx.compose.runtime.saveable.rememberSaveable import androidx.compose.ui.Modifier import androidx.compose.ui.platform.LocalUriHandler import chat.simplex.common.model.* +import chat.simplex.common.model.ChatController.appPrefs import chat.simplex.common.platform.* import dev.icerock.moko.resources.compose.painterResource import dev.icerock.moko.resources.compose.stringResource @@ -44,6 +45,12 @@ fun DeveloperView(withAuth: (title: String, desc: String, block: () -> Unit) -> if (devTools.value) { SectionDividerSpaced(maxTopPadding = true) SectionView(stringResource(MR.strings.developer_options_section).uppercase()) { + SettingsActionItemWithContent(painterResource(MR.images.ic_breaking_news), stringResource(MR.strings.debug_logs)) { + DefaultSwitch( + checked = remember { appPrefs.logLevel.state }.value <= LogLevel.DEBUG, + onCheckedChange = { appPrefs.logLevel.set(if (it) LogLevel.DEBUG else LogLevel.WARNING) } + ) + } SettingsPreferenceItem(painterResource(MR.images.ic_drive_folder_upload), stringResource(MR.strings.confirm_database_upgrades), m.controller.appPrefs.confirmDBUpgrades) if (appPlatform.isDesktop) { TerminalAlwaysVisibleItem(m.controller.appPrefs.terminalAlwaysVisible) { checked -> diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NotificationsSettingsView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NotificationsSettingsView.kt index 66b518e9aa..5af5d5fb90 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NotificationsSettingsView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/NotificationsSettingsView.kt @@ -78,7 +78,7 @@ fun NotificationsSettingsLayout( ) } if (platform.androidIsXiaomiDevice() && (notificationsMode.value == NotificationsMode.PERIODIC || notificationsMode.value == NotificationsMode.SERVICE)) { - SectionTextFooter(stringResource(MR.strings.xiaomi_ignore_battery_optimization)) + SectionTextFooter(annotatedStringResource(MR.strings.xiaomi_ignore_battery_optimization)) } } SectionBottomSpacer() @@ -95,7 +95,7 @@ fun NotificationsModeView( AppBarTitle(stringResource(MR.strings.settings_notifications_mode_title).lowercase().capitalize(Locale.current)) SectionViewSelectable(null, notificationsMode, modes, onNotificationsModeSelected) if (platform.androidIsXiaomiDevice() && (notificationsMode.value == NotificationsMode.PERIODIC || notificationsMode.value == NotificationsMode.SERVICE)) { - SectionTextFooter(stringResource(MR.strings.xiaomi_ignore_battery_optimization)) + SectionTextFooter(annotatedStringResource(MR.strings.xiaomi_ignore_battery_optimization)) } } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/OperatorView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/OperatorView.kt index dcb1bc9de1..cc72387875 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/OperatorView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/networkAndServers/OperatorView.kt @@ -735,7 +735,10 @@ private fun ConditionsAppliedToOtherOperatorsText(userServers: Listعن SimpleX أعلاه، ثم: اقبل - لا يمكن التراجع عن هذا الإجراء - سيتم فقد ملف التعريف وجهات الاتصال والرسائل والملفات الخاصة بك بشكل نهائي. + لا يمكن التراجع عن هذا الإجراء - سيتم فقد ملف تعريفك وجهات اتصالك ورسائلك وملفاتك بشكل نهائي. هذه المجموعة لم تعد موجودة. رمز QR هذا ليس رابطًا! - الجيل القادم من \nالرسائل الخاصة + مستقبل المُراسلة لا يمكن التراجع عن هذا الإجراء - سيتم حذف جميع الملفات والوسائط المستلمة والمرسلة. ستبقى الصور منخفضة الدقة. لا يمكن التراجع عن هذا الإجراء - سيتم حذف الرسائل المرسلة والمستلمة قبل التحديد. قد تأخذ عدة دقائق. ينطبق هذا الإعداد على الرسائل الموجودة في ملف تعريف الدردشة الحالي الخاص بك @@ -30,7 +30,7 @@ أضِف خوادم مُعدة مسبقًا أضِف إلى جهاز آخر سيتم حذف جميع الدردشات والرسائل - لا يمكن التراجع عن هذا! - الوصول إلى الخوادم عبر وكيل SOCKS على المنفذ %d؟ يجب بدء تشغيل الوكيل قبل تمكين هذا الخيار. + الوصول إلى الخوادم عبر وكيل SOCKS على المنفذ %d؟ يجب بدء تشغيل الوكيل قبل تفعيل هذا الخيار. أضِف خادم إعدادات الشبكة المتقدمة سيبقى جميع أعضاء المجموعة على اتصال. @@ -42,7 +42,7 @@ قبول التخفي أضِف رسالة ترحيب أضف الخوادم عن طريق مسح رموز QR. - يمكّن للمشرفين إنشاء روابط للانضمام إلى المجموعات. + يمكن للمشرفين إنشاء روابط للانضمام إلى المجموعات. قبول طلب الاتصال؟ سيتم حذف جميع الرسائل - لا يمكن التراجع عن هذا! سيتم حذف الرسائل فقط من أجلك. مكالمة مقبولة @@ -67,17 +67,17 @@ دائِماً مُتاح يمكن للتطبيق استلام الإشعارات فقط عند تشغيله، ولن يتم بدء تشغيل أي خدمة في الخلفية السماح بالرسائل الصوتية؟ - ستبقى جميع جهات الاتصال الخاصة بك متصلة. + ستبقى جميع جهات اتصالك متصلة. استخدم التتابع دائمًا النسخ الاحتياطي لبيانات التطبيق حُذفت جميع بيانات التطبيق. السماح بحذف الرسائل المرسلة بشكل لا رجعة فيه. (24 ساعة) اسمح لجهات اتصالك بإرسال رسائل صوتية. - حول عنوان SimpleX + عن عنوان SimpleX بناء التطبيق: %s المظهر - أضف عنوانًا إلى ملف التعريف الخاص بك ، حتى تتمكن جهات الاتصال الخاصة بك من مشاركته مع أشخاص آخرين. سيتم إرسال تحديث الملف الشخصي إلى جهات الاتصال الخاصة بك. - ستبقى جميع جهات الاتصال الخاصة بك متصلة. سيتم إرسال تحديث الملف الشخصي إلى جهات الاتصال الخاصة بك. + أضف عنوانًا إلى ملف تعريفك، حتى تتمكن جهات اتصالك من مشاركته مع أشخاص آخرين. سيتم إرسال تحديث ملف التعريف إلى جهات اتصالك. + ستبقى جميع جهات اتصالك متصلة. سيتم إرسال تحديث ملف التعريف إلى جهات اتصالك. رمز التطبيق عنوان اسمح لجهات اتصالك بحذف الرسائل المرسلة بشكل لا رجعة فيه. (24 ساعة) @@ -96,7 +96,7 @@ يمكنك أنت وجهة اتصالك إضافة ردود فعل الرسائل. يمكنك أنت وجهة اتصالك إرسال رسائل تختفي. مكالمتك تحت الإجراء - لا يمكّن استلام الملف + لا يمكن استلام الملف جيد للبطارية. يتحقق التطبيق من الرسائل كل 10 دقائق. قد تفوتك مكالمات أو رسائل عاجلة.]]> عريض مكالمات الصوت (ليست مُعمّاة بين الطرفين) @@ -135,7 +135,7 @@ يتم استبدال رمز مرور التطبيق برمز مرور التدمير الذاتي. مكالمات الصوت والفيديو خطأ في الاتصال - تحسين البطارية نشط ، مما يؤدي إلى إيقاف تشغيل خدمة الخلفية والطلبات الدورية للرسائل الجديدة. يمكنك إعادة تمكينها عبر الإعدادات. + تحسين البطارية نشط، مما يؤدي إلى إيقاف تشغيل خدمة الخلفية والطلبات الدورية للرسائل الجديدة. يمكنك إعادة تفعيلها عبر الإعدادات. لا يمكن تهيئة قاعدة البيانات إرفاق طلب لاستلام الصورة @@ -182,7 +182,7 @@ قاعدة البيانات مُعمّاة غيرت دور %s إلى %s تغيير عنوان الاستلام - خطأ في إنشاء الملف الشخصي! + خطأ في إنشاء ملف التعريف! خطأ في الإتصال انتهت مهلة الاتصال جهة الاتصال موجودة بالفعل @@ -303,7 +303,7 @@ أدخل عبارة المرور الدردشات متصل - سيتم حذف جهة الاتصال وجميع الرسائل - لا يمكن التراجع عن هذا الإجراء! + سيتم حذف جهة الاتصال وجميع الرسائل - لا يمكن التراجع عن هذا! الحد الأقصى لحجم الملف المدعوم حاليًا هو %1$s. تواصل عبر الرابط / رمز QR إنشاء رابط دعوة لمرة واحدة @@ -314,7 +314,7 @@ ملون لدى جهة الاتصال التعمية بين الطريفين إنشاء - إنشاء ملف تعريف + أنشئ ملف تعريفك مكالمة جارية... تفعيل التدمير الذاتي الموافقة على التعمية… @@ -409,11 +409,11 @@ توسيع تحديد الدور انتهت صلاحية دعوة المجموعة المجموعة غير موجودة! - تصدير السمة + صدّر السمة الملفات والوسائط قلب الكاميرا سيتم حذف المجموعة لجميع الأعضاء - لا يمكن التراجع عن هذا! - يمكن لأعضاء المجموعة إرسال رسائل مباشرة. + يمكن للأعضاء إرسال رسائل مباشرة. فشل تحميل الدردشات أهلاً! \nتواصل معي عبر SimpleX Chat: %s @@ -422,8 +422,8 @@ الملف حُدّث ملف تعريف المجموعة أدخل اسم المجموعة: - يمكن لأعضاء المجموعة إرسال رسائل صوتية. - الملفات والوسائط ممنوعة في هذه المجموعة. + يمكن للأعضاء إرسال رسائل صوتية. + الملفات والوسائط ممنوعة. رسالة ترحيب المجموعة مزيد من تقليل استخدام البطارية المجموعة @@ -433,16 +433,16 @@ الواجهة الفرنسية المساعدة حُذِفت المجموعة - يمكن لأعضاء المجموعة إرسال رسائل تختفي. + يمكن للأعضاء إرسال رسائل تختفي. إشراف المجموعة أخيرا، لدينا منهم! 🚀 - تصدير قاعدة البيانات + صدّر قاعدة البيانات لوحدة التحكم الميزات التجريبية تجريبي المجموعة غير نشطة الملفات والوسائط - يمكن لأعضاء المجموعة حذف الرسائل المرسلة بشكل لا رجعة فيه. (24 ساعة) + يمكن للأعضاء حذف الرسائل المُرسلة بشكل لا رجعة فيه. (24 ساعة) الإصلاح غير مدعوم من قبل جهة الاتصال يُخزّن ملف تعريف المجموعة على أجهزة الأعضاء، وليس على الخوادم. روابط المجموعة @@ -450,25 +450,25 @@ الاسم الكامل: لم تعد دعوة المجموعة صالحة، تمت أُزيلت بواسطة المرسل. رابط المجموعة - سيتم استلام الملف عندما تكون جهة اتصالك متصلة بالإنترنت، يرجى الانتظار أو التحقق لاحقًا! + سيتم استلام الملف عندما تكون جهة اتصالك متصلة بالإنترنت، يُرجى الانتظار أو التحقق لاحقًا! الاسم الكامل للمجموعة: رابط كامل ملف سيتم حذف المجموعة لك - لا يمكن التراجع عن هذا! فشل تحميل الدردشة - يمكن لأعضاء المجموعة إضافة ردود فعل الرسالة. + يمكن للأعضاء إضافة ردود الفعل على الرسائل. المفضل مخفي حُفظ الملف سيتم حذف الملف من الخوادم. - سيتم استلام الملف عند اكتمال تحميل جهة الاتصال الخاصة بك. + سيتم استلام الملف عندما يكتمل جهة اتصالك من رفعِها. المساعدة الملف: %s إصلاح إصلاح الاتصال إصلاح الاتصال؟ الإصلاح غير مدعوم من قبل أعضاء المجموعة - يمكن لأعضاء المجموعة إرسال الملفات والوسائط. + يمكن للأعضاء إرسال الملفات والوسائط. تفضيلات المجموعة سريع ولا تنتظر حتى يصبح المرسل متصلاً بالإنترنت! إخفاء @@ -483,7 +483,7 @@ استيراد قاعدة بيانات ساعات السجل - سيتم استلام الصورة عند اكتمال تحميل جهة اتصالك. + سيتم استلام الصورة عندما يكتمل جهة اتصالك من رفعِها. اعرض رمز QR في مكالمة الفيديو، أو شارك الرابط.]]> ثبّت SimpleX Chat لطرفية إذا قمت بالتأكيد، فستتمكن خوادم المراسلة من رؤية عنوان IP الخاص بك ومزود الخدمة الخاص بك - أي الخوادم التي تتصل بها. @@ -511,7 +511,7 @@ التخفي عبر رابط لمرة واحدة أرسلت صورة صورة - سيتم استلام الصورة عندما تكون جهة اتصالك متصلة بالإنترنت، يرجى الانتظار أو التحقق لاحقًا! + سيتم استلام الصورة عندما تكون جهة اتصالك متصلة بالإنترنت، يُرجى الانتظار أو التحقق لاحقًا! حُفظت الصورة في المعرض صورة إذا لم تتمكن من الالتقاء شخصيًا، اعرض رمز QR في مكالمة الفيديو، أو شارك الرابط. @@ -526,7 +526,7 @@ فوري المضيف إخفاء - يُرجى السماح لSimpleX للتشغيل في الخلفية في مربع الحوار التالي. وإلا، سيتم تعطيل الإشعارات.]]> + السماح بذلك في مربع الحوار التالي لتلقي الإشعارات على الفور.]]> ردًا على إشعارات فورية خوادم ICE (واحد لكل سطر) @@ -534,7 +534,7 @@ إخفاء ملف التعريف كيفية استخدام ماركداون إذا أدخلت رمز مرور التدمير الذاتي أثناء فتح التطبيق: - يمكن تغييره لاحقًا عبر الإعدادات. + كيف يؤثر على البطارية انضمام فاتح مدعو للتواصل @@ -554,13 +554,13 @@ دعوة الأصدقاء خطأ في Keychain دعوة للمجموعة - يٌمنع حذف الرسائل بشكل لا رجعة فيه في هذه المجموعة. + يٌمنع حذف الرسائل بشكل لا رجعة فيه. تنسيق الرسالة غير صالح البيانات غير صالحة - بيانات الملف الشخصي المحلية فقط + بيانات ملف التعريف المحلية فقط يٌمنع حذف الرسائل بشكل لا رجعة فيه في هذه الدردشة. دعوة الأعضاء - مغادرة المجموعة + غادِر المجموعة الاسم المحلي: غادر يسمح بوجود العديد من الاتصالات المجهولة دون مشاركة أي بيانات بينهم في ملف تعريف دردشة واحد. @@ -603,7 +603,7 @@ نزّل الملف تعطيل قفل SimpleX تحرير - اسم الملف الشخصي: + اسم ملف التعريف: البريد الإلكتروني أدخل أسمك: كرر الرسالة @@ -613,7 +613,7 @@ حُرر الرجوع إلى إصدار سابق وفتح الدردشة رسائل مباشرة - الرسائل المختفية ممنوعة في هذه المجموعة. + الرسائل المختفية ممنوعة. تحرير ملف تعريف المجموعة لا تُظهر مرة أخرى الجهاز @@ -651,7 +651,7 @@ لا تنشئ عنوانًا خطأ في تحديث تضبيط الشبكة خطأ في استلام الملف - خطأ في تبديل الملف الشخصي! + خطأ في تبديل ملف التعريف! حافظ على اتصالاتك تأكد من أن عناوين خادم XFTP بالتنسيق الصحيح، وأن تكون مفصولة بأسطر وليست مكررة. عُلّم محذوف @@ -683,7 +683,7 @@ خطأ في بدء الدردشة خطأ في تصدير قاعدة بيانات الدردشة ستتم إزالة العضو من المجموعة - لا يمكن التراجع عن هذا! - اجعل الملف الشخصي خاصًا! + اجعل ملف التعريف خاصًا! تصفية الدردشات غير المقروءة والمفضلة. البحث عن الدردشات بشكل أسرع تفعيل @@ -734,7 +734,7 @@ \n- و اكثر! حالة الشبكة كتم - ردود الفعل الرسائل ممنوعة في هذه المجموعة. + ردود الفعل الرسائل ممنوعة. المزيد إعدادات متقدّمة مكالمة فائتة @@ -757,9 +757,7 @@ سيتم استخدام مضيفات البصل عند توفرها. لن يتم استخدام مضيفات البصل. لم تٌحدد جهات اتصال - يمكّن للمشرف الآن: -\n- حذف رسائل الأعضاء. -\n- تعطيل الأعضاء (دور "المراقب") + يمكن للمشرف الآن:\n- حذف رسائل الأعضاء.\n- تعطيل الأعضاء (دور المراقب) خدمة الإشعار غير مفعّل` مفعل @@ -793,7 +791,7 @@ تم تعيين كلمة المرور! المالك فقط جهة اتصالك يمكنها إرسال رسائل تختفي. - جهة اتصالك فقط يمكنها إضافة تفاعلات على الرسالة + جهة اتصالك فقط يمكنها إضافة ردود الفعل على الرسالة فقط مالكي المجموعة يمكنهم تغيير تفضيلات المجموعة. جهة اتصالك فقط يمكنها حذف الرسائل بشكل لا رجعة فيه (يمكنك تعليم الرسالة للحذف). (24 ساعة) أنت فقط يمكنك إرسال رسائل صوتية. @@ -806,7 +804,7 @@ كلمة المرور غير موجودة في مخزن المفاتيح، يرجى إدخالها يدوياً. قد يحدث هذا إذا قمت باستعادة ملفات التطبيق باستخدام أداة استرجاع بيانات. إذا لم يكن الأمر كذلك، تواصل مع المبرمجين رجاء افتح الدردشة فتح الرابط في المتصفح قد يقلل خصوصية وحماية اتصالك. الروابط غير الموثوقة من SimpleX ستكون باللون الأحمر - أنت فقط يمكنك إضافة تفاعل على الرسالة. + أنت فقط يمكنك إضافة ردود الفعل على الرسالة. أنت فقط يمكنك حذف الرسائل بشكل لا رجعة فيه (يمكن للمستلم تعليمها للحذف). (24 ساعة) أنت فقط يمكنك إرسال رسائل تختفي أنت فقط يمكنك إجراء المكالمات. @@ -819,7 +817,7 @@ ندّ لِندّ أنت تقرر من يمكنه الاتصال. مكالمة قيد الانتظار - تعمية ثنائية الطبقات من بين الطريفين.]]> + تقوم أجهزة العميل فقط بتخزين ملفات تعريف المستخدمين وجهات الاتصال والمجموعات والرسائل. صفّر الألوان حفظ عنوان الخادم المُعد مسبقًا @@ -829,7 +827,7 @@ الاستلام عبر يُرجى التحقق من استخدامك للرابط الصحيح أو اطلب من جهة اتصالك أن ترسل لك رابطًا آخر. الإشعارات الدورية مُعطَّلة - صورة الملف الشخصي + صورة ملف التعريف الإشعارات خاصة يرجى تخزين عبارة المرور بشكل آمن، فلن تتمكن من الوصول إلى الدردشة إذا فقدتها. يُرجى تحديث التطبيق والتواصل مع المطورين. @@ -862,7 +860,7 @@ الرجاء إدخال كلمة المرور السابقة بعد استعادة نسخة احتياطية لقاعدة البيانات. لا يمكن التراجع عن هذا الإجراء. استعادة النسخة الاحتياطية لقاعدة البيانات؟ حفظ - اتصالات الملف الشخصي والخادم + اتصالات ملف التعريف والخادم منع ردود فعل الرسالة. منع إرسال الرسائل الصوتية. منع ردود فعل الرسائل. @@ -884,7 +882,7 @@ يرى المستلمون التحديثات أثناء كتابتها. استلمت، ممنوع حفظ - سيتم إرسال تحديث الملف الشخصي إلى جهات الاتصال الخاصة بك. + سيتم إرسال تحديث ملف التعريف إلى جهات اتصالك. حفظ وإشعار جهات الاتصال حفظ وتحديث ملف تعريف المجموعة عدد البينج @@ -900,7 +898,7 @@ إزالة صفّر إلى الإعدادات الافتراضية بينج الفاصل الزمني - كلمة مرور الملف الشخصي + كلمة مرور ملف التعريف منع إرسال الرسائل التي تختفي. مهلة البروتوكول مهلة البروتوكول لكل كيلوبايت @@ -924,7 +922,7 @@ سحب وصول الملف؟ رٌفض الإذن! يرجى مطالبة جهة اتصالك بتفعيل إرسال الرسائل الصوتية. - العنصر النائب لصورة الملف الشخصي + العنصر النائب لصورة ملف التعريف رمز QR صفّر المنفذ %d @@ -1016,7 +1014,7 @@ خوادم SMP مشاركة الوسائط… رسائل SimpleX Chat - لم يتم تمكين قفل SimpleX! + قفل SimpleX غير مفعّل! إيقاف الدردشة التوقف عن استلام الملف؟ مشاركة الملف… @@ -1056,7 +1054,7 @@ عرض خيارات المطور simplexmq: v%s (%2s) يتطلب الخادم إذنًا لإنشاء قوائم انتظار، تحقق من كلمة المرور - يتطلب الخادم إذنًا للتحميل، تحقق من كلمة المرور + يتطلب الخادم إذنًا للرفع، تحقق من كلمة المرور عرض جهة الاتصال فقط مكالمات SimpleX Chat خدمة SimpleX Chat @@ -1084,14 +1082,13 @@ سيتم إلغاء الاتصال الذي قبلته! لن تتمكن جهة الاتصال التي شاركت هذا الرابط معها من الاتصال! هذا النص متاح في الإعدادات - لحماية الخصوصية، بدلاً من معرفات المستخدم التي تستخدمها جميع الأنظمة الأساسية الأخرى, يحتوي SimpleX على معرفات لقوائم انتظار الرسائل، منفصلة لكل جهة من جهات اتصالك. - لحماية معلوماتك، قم بتشغيل قفل SimpleX -\nسيُطلب منك إكمال المصادقة قبل تمكين هذه الميزة. + لحماية خصوصيتك، يستخدم SimpleX معرّفات منفصلة لكل جهة اتصال لديك. + لحماية معلوماتك، فعّل قفل SimpleX \nسيُطلب منك إكمال المصادقة قبل تفعيل هذه الميزة. عزل النقل بفضل المستخدمين - المساهمة عبر Weblate! دعم البلوتوث وتحسينات أخرى. بفضل المستخدمين - المساهمة عبر Weblate! - خدمة SimpleX تعمل في الخلفية – يستخدم نسبة قليلة من البطارية يوميًا.]]> + يتم تشغيل SimpleX في الخلفية بدلاً من استخدام إشعارات push.]]> انقر لبدء محادثة جديدة (للمشاركة مع جهة اتصالك) للتواصل عبر الرابط @@ -1103,17 +1100,17 @@ العنوان الرئيسي سيتم وضع علامة على الرسالة على أنها تحت الإشراف لجميع الأعضاء. انقر للانضمام - للكشف عن ملف التعريف المخفي الخاص بك، أدخل كلمة مرور كاملة في حقل البحث في صفحة ملفات تعريف الدردشة الخاصة بك. + للكشف عن ملف تعريفك المخفي، أدخل كلمة مرور كاملة في حقل البحث في صفحة ملفات تعريف الدردشة الخاصة بك. انقر للانضمام إلى وضع التخفي النظام السمات بفضل المستخدمين - المساهمة عبر Weblate! قاعدة البيانات لا تعمل بشكل صحيح. انقر لمعرفة المزيد ألوان الواجهة - انقر لتنشيط الملف الشخصي. + انقر لتنشيط ملف التعريف. عزل النقل هذه السلسلة ليست رابط اتصال! - هذه الإعدادات لملف التعريف الحالي الخاص بك + هذه الإعدادات لملف تعريفك الحالي يمكن تجاوزها في إعدادات الاتصال و المجموعة. انتهت مهلة اتصال TCP لحماية المنطقة الزمنية، تستخدم ملفات الصور / الصوت التوقيت العالمي المنسق (UTC). @@ -1140,7 +1137,7 @@ محاولة الاتصال بالخادم المستخدم لاستلام الرسائل من جهة الاتصال هذه (خطأ: %1$s). تشغيل خوادم WebRTC ICE - أنت تستخدم ملفًا شخصيًا متخفيًا لهذه المجموعة - لمنع مشاركة ملفك الشخصي الرئيسي الذي يدعو جهات الاتصال غير مسموح به + أنت تستخدم ملف تعريف متخفي لهذه المجموعة - لمنع مشاركة ملفك التعريفي الرئيسي الذي يدعو جهات الاتصال غير مسموح به غيّرتَ دور %s إلى %s نعم أنت متصل بالخادم المستخدم لاستلام الرسائل من جهة الاتصال هذه. @@ -1155,23 +1152,23 @@ عبر المُرحل لقد انضممت إلى هذه المجموعة لقد رفضت دعوة المجموعة - عندما تشارك ملفًا شخصيًا متخفيًا مع شخص ما، فسيتم استخدام هذا الملف الشخصي للمجموعات التي يدعوك إليها. + عندما تشارك ملف تعريف متخفي مع شخص ما، فسيتم استخدام هذا الملف التعريفي للمجموعات التي يدعوك إليها. لديك بالفعل ملف تعريف دردشة بنفس اسم العرض. الرجاء اختيار اسم آخر. أنت متصل بالفعل بـ%1$s. في انتظار الفيديو - سيتم استلام الفيديو عند اكتمال تحميل جهة اتصالك. + سيتم استلام الفيديو عند اكتمال رفع جهة اتصالك. تحقق من رمز الأمان رسائل صوتية عندما يطلب الأشخاص الاتصال، يمكنك قبوله أو رفضه. - سوف تكون متصلاً بالمجموعة عندما يكون جهاز مضيف المجموعة متصلاً بالإنترنت، يرجى الانتظار أو التحقق لاحقًا! - سوف تكون متصلاً عندما يتم قبول طلب الاتصال الخاص بك، يرجى الانتظار أو التحقق لاحقًا! + سوف تكون متصلاً بالمجموعة عندما يكون جهاز مضيف المجموعة متصلاً بالإنترنت، يُرجى الانتظار أو التحقق لاحقًا! + سوف تكون متصلاً عندما يتم قبول طلب اتصالك، يُرجى الانتظار أو التحقق لاحقًا! تستخدم خوادم SimpleX Chat. استخدم وكيل SOCKS استخدم مضيفي onion. استخدام وكيل SOCKS؟ عندما تكون متاحة ستبقى جهات اتصالك متصلة. - لا نقوم بتخزين أي من جهات الاتصال أو الرسائل الخاصة بك (بمجرد تسليمها) على الخوادم. + لا نقوم بتخزين أي من جهات اتصالك أو رسائلك (بمجرد تسليمها) على الخوادم. يمكنك استخدام تخفيض السعر لتنسيق الرسائل: استخدم الدردشة أنت @@ -1206,10 +1203,10 @@ عبر رابط لمرة واحدة مكالمة الفيديو ليست مُعمّاة بين الطريفين غيّرتَ العنوان - سوف تكون متصلاً عندما يكون جهاز جهة الاتصال الخاصة بك متصلاً بالإنترنت، يرجى الانتظار أو التحقق لاحقًا! + سوف تكون متصلاً عندما يكون جهاز جهة اتصالك متصلاً بالإنترنت، يُرجى الانتظار أو التحقق لاحقًا! غادرت يجب عليك استخدام أحدث إصدار من قاعدة بيانات الدردشة الخاصة بك على جهاز واحد فقط، وإلا فقد تتوقف عن تلقي الرسائل من بعض جهات الاتصال. - سيتم استلام الفيديو عندما تكون جهة اتصالك متصلة بالإنترنت، يرجى الانتظار أو التحقق لاحقًا! + سيتم استلام الفيديو عندما تكون جهة اتصالك متصلة بالإنترنت، يُرجى الانتظار أو التحقق لاحقًا! يمكنك مشاركة هذا العنوان مع جهات اتصالك للسماح لهم بالاتصال بـ%s. أُزيلت %1$s تحديث @@ -1238,11 +1235,11 @@ سيتم حذف قاعدة بيانات الدردشة الحالية واستبدالها بالقاعدة المستوردة. \nلا يمكن التراجع عن هذا الإجراء - سيتم فقد ملف التعريف وجهات الاتصال والرسائل والملفات الخاصة بك بشكل نهائي. تحديث عبارة مرور قاعدة البيانات - سوف تتوقف عن تلقي الرسائل من هذه المجموعة. سيتم الاحتفاظ سجل الدردشة. + سوف تتوقف عن تلقي الرسائل من هذه المجموعة. سيتم الاحتفاظ بسجل الدردشة. أسابيع يمكنك إخفاء أو كتم ملف تعريف المستخدم - اضغط مطولاً للقائمة. ما هو الجديد - ملفك الشخصي الحالي + ملف تعريفك الحالي عبر %1$s غير مقروءة مرحبًا! @@ -1252,7 +1249,7 @@ فيديو يمكنك مشاركة عنوانك كرابط أو رمز QR - يمكن لأي شخص الاتصال بك. يمكنك إنشاؤه لاحقًا - أنت تحاول دعوة جهة اتصال قمت بمشاركة ملف تعريف متخفي معها إلى المجموعة التي تستخدم فيها ملفك الشخصي الرئيسي + أنت تحاول دعوة جهة اتصال شاركت ملف تعريف متخفي معها إلى المجموعة التي تستخدم فيها ملف تعريفك الرئيسي ألغِ الكتم ألغِ الكتم لقد قبلت الاتصال @@ -1274,7 +1271,7 @@ \n- الوقت المخصص لتختفي. \n- تحرير التاريخ. يمكنك تفعيلة لاحقًا عبر الإعدادات - يمكنك تمكينها لاحقًا عبر إعدادات الخصوصية والأمان للتطبيق. + يمكنك تفعيلها لاحقًا عبر إعدادات الخصوصية والأمان للتطبيق. عبر رابط المجموعة لقد شاركت رابط لمرة واحدة متخفي عبر المتصفح @@ -1287,11 +1284,11 @@ سيتم إرسال ملف تعريف الدردشة الخاص بك \nإلى جهة اتصالك إلغاء الإخفاء - ملفك الشخصي العشوائي - ستستمر في استلام المكالمات والإشعارات من الملفات الشخصية المكتومة عندما تكون نشطة. + ملفك التعريفي العشوائي + ستستمر في استلام المكالمات والإشعارات من الملفات التعريفية المكتومة عندما تكون نشطة. انت تسمح بها مكالمة فيديو - الرسائل الصوتية ممنوعة في هذه الدردشة. + الرسائل الصوتية ممنوعة. فتح القفل رفع الملف لا يمكن التحقق منك؛ الرجاء المحاولة مرة اخرى. @@ -1299,7 +1296,7 @@ رسالة صوتية… أنت مدعو إلى المجموعة لا يمكنك إرسال رسائل! - تحتاج إلى السماح لجهة الاتصال الخاصة بك بإرسال رسائل صوتية لتتمكن من إرسالها. + تحتاج إلى السماح لجهة اتصالك بإرسال رسائل صوتية لتتمكن من إرسالها. أرسلت جهة اتصالك ملفًا أكبر من الحجم الأقصى المعتمد حاليًا (%1$s). الاتصال بمطوري SimpleX Chat لطرح أي أسئلة وتلقي التحديثات.]]> خادمك @@ -1334,7 +1331,7 @@ لا يمكن تشغيل SimpleX في الخلفية. ستستلم الإشعارات فقط عندما يكون التطبيق قيد التشغيل. سيتم مشاركة ملف تعريف عشوائي جديد. ألصق الرابط المُستلَم للتواصل مع جهة اتصالك… - ستتم مشاركة ملفك الشخصي %1$s. + ستتم مشاركة ملفك التعريفي %1$s. قد يغلق التطبيق بعد دقيقة واحدة في الخلفية. سماح لا مكالمات في الخلفية @@ -1388,9 +1385,9 @@ محظور حظر أعضاء المجموعة جهة الاتصال حُذفت - أنشِئ مجموعة باستخدام ملف تعريف عشوائي. - أنشِئ مجموعة - أنشِئ ملف تعريف + أنشئ مجموعة باستخدام ملف تعريف عشوائي. + أنشئ مجموعة + أنشئ ملف تعريف سطح المكتب متصل اتصل تلقائيًا عنوان سطح المكتب @@ -1485,9 +1482,7 @@ تحقق من الرمز مع سطح المكتب مسح رمز QR من سطح المكتب إلغاء الحظر - - إشعار اختياريًا جهات الاتصال المحذوفة. -\n- أسماء الملفات الشخصية بمسافات. -\n- و اكثر! + - إشعار اختياريًا جهات الاتصال المحذوفة. \n- أسماء الملفات التعريفية بمسافات. \n- و اكثر! مسار الملف غير صالح لقد طلبت بالفعل الاتصال عبر هذا العنوان! إظهار وحدة التحكم في نافذة جديدة @@ -1522,7 +1517,7 @@ يمكنك عرض رابط الدعوة مرة أخرى في تفاصيل الاتصال. أبقِ الدعوة غير المستخدمة؟ شارك رابط الدعوة هذا لمرة واحدة - أنشِئ مجموعة: لإنشاء مجموعة جديدة.]]> + أنشئ مجموعة: لإنشاء مجموعة جديدة.]]> التاريخ المرئي رمز مرور التطبيق دردشة جديدة @@ -1550,7 +1545,7 @@ %s غير نشط]]> أظهر مكالمات API البطيئة غير معروف - حدّثت الملف الشخصي + حدّثت ملف التعريف %s مفقود]]> %s لديه إصدار غير مدعوم. يُرجى التأكد من استخدام نفس الإصدار على كلا الجهازين]]> %s في حالة سيئة]]> @@ -1575,9 +1570,9 @@ خيارات المطور تغيّر العضو %1$s إلى %2$s أزلت عنوان الاتصال - أزلت الصورة الشخصية + أزلت صورة ملف التعريف عيّن عنوان جهة اتصال جديد - عيّن صورة شخصية جديدة + عيّن صورة تعريفية جديدة حالة غير معروفة تغيّر جهة الاتصال %1$s إلى %2$s يستغرق تنفيذ الوظيفة وقتًا طويلاً جدًا: %1$d ثانية: %2$s @@ -1624,7 +1619,7 @@ يمكن للمشرفين حظر عضو للجميع. ترحيل بيانات التطبيق جارِ أرشفة قاعدة البيانات - سيتم تعمية جميع جهات الاتصال والمحادثات والملفات الخاصة بك بشكل آمن وتحميلها في أجزاء إلى مُرحلات XFTP التي ضبطت. + سيتم تعمية جميع جهات الاتصال والمحادثات والملفات الخاصة بك بشكل آمن ورفعها في أجزاء إلى مُرحلات XFTP التي ضُبطت. طبّق يُرجى ملاحظة: استخدام نفس قاعدة البيانات على جهازين سيؤدي إلى كسر فك تعمية الرسائل من اتصالاتك، كحماية أمنية.]]> تحذير: سيتم حذف الأرشيف.]]> @@ -1658,7 +1653,7 @@ ألصق رابط الأرشيف يمكنك إعطاء محاولة أخرى. حدث خطأ أثناء تنزيل الأرشيف - الملف المُصدر غير موجود + الملف المُصدّر غير موجود تحقق من عبارة المرور تأكد من أنك تتذكر عبارة مرور قاعدة البيانات لترحيلها. التحقق من عبارة مرور قاعدة البيانات @@ -1718,8 +1713,8 @@ السماح بإرسال روابط SimpleX. منع إرسال روابط SimpleX كل الأعضاء - يمكن لأعضاء المجموعة إرسال روابط SimpleX. - روابط SimpleX محظورة في هذه المجموعة. + يمكن للأعضاء إرسال روابط SimpleX. + روابط SimpleX محظورة. المشرفين مفعّل لـ المالكون @@ -1746,8 +1741,8 @@ عند اتصال بمكالمات الصوت والفيديو. إدارة الشبكة اتصال شبكة أكثر موثوقية. - صور الملف الشخصي - شكل الصور الشخصية + صور ملف التعريف + شكل الصور التعريفية واجهة المستخدم الليتوانية مربع أو دائرة أو أي شيء بينهما. عنوان الخادم غير متوافق مع إعدادات الشبكة. @@ -1814,7 +1809,7 @@ صباح الخير! صورة خلفية الشاشة الوضع الفاتح - السمة الملف الشخصي + سمة ملف التعريف فاتح طبّق لِ ملء @@ -1833,8 +1828,7 @@ \nآخر رسالة تم استلامها: %2$s تسليم التصحيح معلومات قائمة انتظار الرسائل - احمِ عنوان IP الخاص بك من مُرحلات المُراسلة التي اختارتها جهات الاتصال الخاصة بك. -\nفعّل في إعدادات *الشبكة والخوادم*. + احمِ عنوان IP الخاص بك من مُرحلات المُراسلة التي اختارتها جهات اتصالك. \nفعّل في إعدادات *الشبكة والخوادم*. سمات دردشة جديدة حدث خطأ أثناء تهيئة WebView. حدّث نظامك إلى الإصدار الجديد. يُرجى التواصل بالمطورين. \nError: %s @@ -1999,7 +1993,7 @@ بإمكانك إرسال رسائل إلى %1$s من جهات الاتصال المؤرشفة. ألصق الرابط جهات اتصالك - شريط أدوات الدردشة القابل للوصول + شريط أدوات التطبيق القابلة للوصول حُذفت جهة الاتصال. السماح بالمكالمات؟ أرسل رسالة لتفعيل المكالمات. @@ -2040,7 +2034,7 @@ يحمي عنوان IP الخاص بك واتصالاتك. اتصال TCP حفظ وإعادة الاتصال - أنشِئ + أنشئ تجربة دردشة جديدة 🎉 تمويه من أجل خصوصية أفضل. كبّر حجم الخط @@ -2075,9 +2069,9 @@ لا يزال يتم تنزيل %1$d ملفًا. لا تستخدم بيانات الاعتماد مع الوكيل. خطأ في تحويل الرسائل - خطأ في تبديل الملف الشخصي + خطأ في تبديل ملف التعريف حدد ملف تعريف الدردشة - لقد تم نقل اتصالك إلى %s ولكن حدث خطأ غير متوقع أثناء إعادة توجيهك إلى الملف الشخصي. + لقد تم نقل اتصالك إلى %s ولكن حدث خطأ غير متوقع أثناء إعادة توجيهك إلى ملف التعريف. تحويل %1$s رسالة؟ لم يحوّل %1$s من الرسائل جارِ تحويل %1$s رسالة @@ -2117,7 +2111,7 @@ لملف تعريف الدردشة %s: لا يوجد وسائط أو خوادم ملفات. لا يوجد خوادم لإرسال الملفات. - لقد وصل الاتصال إلى الحد الأقصى من الرسائل غير المُسلمة، قد يكون جهة الاتصال الخاصة بك غير متصلة بالإنترنت. + لقد وصل الاتصال إلى الحد الأقصى من الرسائل غير المُسلمة، قد يكون جهة اتصالك غير متصلة بالإنترنت. الرسائل غير المُسلَّمة شارك رابطًا لمرة واحدة مع صديق أمان الاتصال @@ -2182,11 +2176,11 @@ عنوان أو رابط لمرة واحدة؟ مع جهة اتصال واحدة فقط - المشاركة شخصيًا أو عبر أي مُراسل.]]> سيتم قبول الشروط للمُشغلين المفعّلين بعد 30 يومًا. - اختر المُشغلين + مُشغلي الخادم لا يمكن تحميل نص الشروط الحالية، يمكنك مراجعة الشروط عبر هذا الرابط: خطأ في قبول الشروط خطأ في حفظ الخوادم - على سبيل المثال، إذا تلقيت رسائل عبر خادم SimpleX Chat، فسيستخدم التطبيق أحد خوادم Flux للتوجيه الخاص. + على سبيل المثال، إذا تلقى أحد جهات اتصالك رسائل عبر خادم SimpleX Chat، فسوف يقوم تطبيقك بتسليمها عبر خادم Flux. لا يوجد خوادم لتوجيه الرسائل الخاصة. لا يوجد خوادم رسائل. لا يوجد خوادم لاستقبال الملفات. @@ -2202,8 +2196,49 @@ انقر فوق أنشئ عنوان SimpleX في القائمة لإنشائه لاحقًا. حُذفت هذه الرسالة أو لم يتم استلامها بعد. استخدم للرسائل - عندما تفعّل أكثر من مُشغل شبكة واحد، سيستخدم التطبيق خوادم مُشغلين مختلفين لكل مُحادثة. + يحمي التطبيق خصوصيتك من خلال استخدام مُشغلين مختلفين في كل محادثة. %s.]]> %s.]]> %s.]]> + عنوان العمل التجاري + يتم تشغيل التطبيق دائمًا في الخلفية + دردشات العمل التجاري + أضف أعضاء الفريق + أضف أصدقاء + أضف أعضاء فريقك إلى المحادثات. + يُحظر إرسال الرسائل المباشرة بين الأعضاء في هذه الدردشة. + أجهزة Xiaomi: يُرجى تفعيل التشغيل التلقائي (Autostart) في إعدادات النظام لكي تعمل الإشعارات.]]> + مُعمَّاة بين الطرفين، مع أمان ما بعد الكم في الرسائل المباشرة.]]> + تحقق من الرسائل كل 10 دقائق + يُمنع إرسال الرسائل المباشرة بين الأعضاء. + الدردشة + كيف يساعد على الخصوصية + سيتم حذف الدردشة لجميع الأعضاء - لا يمكن التراجع عن هذا! + سيتم حذف الدردشة لديك - لا يمكن التراجع عن هذا! + احذف الدردشة + الدردشة موجودة بالفعل! + حذف الدردشة؟ + %1$s.]]> + أو استورد ملف الأرشيف + لا توجد خدمة خلفية + الإشعارات والبطارية + يمكن فقط لأصحاب الدردشة تغيير التفضيلات. + الخصوصية لعملائك. + الجوالات عن بُعد + ادعُ للدردشة + مغادرة المجموعة؟ + سيتم إزالة العضو من الدردشة - لا يمكن التراجع عن هذا! + غادِر الدردشة + الرسالة كبيرة جدًا! + يُرجى تقليل حجم الرسالة وإرسالها مرة أخرى. + شريط أداة الدردشة القابلة للوصول + الدعوة قُبلت + طلبت الاتصال + يُرجى تقليل حجم الرسالة أو إزالة الوسائط ثم إرسالها مرة أخرى. + يمكنك نسخ الرسالة وتقليل حجمها لإرسالها. + عندما يتم تفعيل أكثر من مُشغل واحد، لن يكون لدى أي منهم بيانات تعريفية لمعرفة من يتواصل مع من. + سيتم تغيير الدور إلى %s. وسيتم إشعار الجميع في الدردشة. + سيتم إرسال ملف تعريفك للدردشة إلى أعضاء الدردشة + سوف تتوقف عن تلقي الرسائل من هذه الدردشة. سيتم حفظ سجل الدردشة. + عن المُشغلين \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml index 82bf5bc8dc..ffbe473df8 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml @@ -188,6 +188,9 @@ Error updating user privacy Slow function Execution of function takes too long time: %1$d seconds: %2$s + Error updating chat list + Error creating chat list + Error loading chat lists Instant notifications @@ -361,6 +364,7 @@ Revoke Forward Download + List Message forwarded No direct connection yet, message is forwarded by admin. @@ -390,6 +394,10 @@ You have no chats Loading chats… No filtered chats + No chats in list %s. + No unread chats + No chats + No chats found Tap to Connect Connect with %1$s? Search or paste SimpleX link @@ -409,6 +417,12 @@ %1$d file(s) were deleted. Download %1$s messages not forwarded + Favorites + Contacts + Groups + Businesses + All + Add list Share message… @@ -482,6 +496,7 @@ Please, wait while the file is being loaded from the linked mobile File error Temporary file error + Open with %s Voice message @@ -524,6 +539,10 @@ Renegotiate encryption? The encryption is working and the new encryption agreement is not required. It may result in connection errors! Renegotiate + Fix connection? + Connection requires encryption renegotiation. + Fix + Encryption renegotiation in progress. View security code Verify security code @@ -622,6 +641,16 @@ Favorite Unfavorite + + Create list + Add to list + Save list + List name... + List name and emoji should be different for all lists. + Delete + Delete list? + All chats will be removed from the list %s, and the list deleted + Edit You invited a contact @@ -903,6 +932,7 @@ Show: Hide: Show developer options + Enable logs Database IDs and Transport isolation option. Developer options Show internal errors @@ -1334,6 +1364,7 @@ You may migrate the exported database. Some file(s) were not exported Continue + Error saving database Save passphrase in Keystore @@ -1690,6 +1721,7 @@ Can\'t call group member Send message to enable calls. Can\'t message group member + Connection not ready. Welcome message @@ -1752,7 +1784,6 @@ %s.]]> %s.]]> %s.]]> - %s.]]> %s.]]> %s.]]> View conditions @@ -2403,7 +2434,7 @@ Messages sent Messages received Details - Starting from %s.\nAll data is private to your device. + Starting from %s.\nAll data is kept private on your device.. Message reception Active connections Pending diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/de/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/de/strings.xml index 5ab956ae85..be6896d932 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/de/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/de/strings.xml @@ -62,7 +62,7 @@ Der Absender hat die Dateiübertragung abgebrochen. Fehler beim Empfangen der Datei Fehler beim Erstellen der Adresse - Kontakt ist bereits vorhanden + Kontakt besteht bereits Sie sind bereits mit %1$s verbunden. Ungültiger Verbindungslink Überprüfen Sie bitte, ob Sie den richtigen Link genutzt haben, oder bitten Sie Ihren Kontakt darum, Ihnen nochmal einen Link zuzusenden. @@ -88,9 +88,9 @@ Sofortige Benachrichtigungen Sofortige Benachrichtigungen! Sofortige Benachrichtigungen sind deaktiviert! - SimpleX-Hintergrunddienst genutzt werden – dieser benötigt ein paar Prozent Akkuleistung am Tag.]]> + läuft SimpleX im Hintergrund ab, anstatt Push-Benachrichtigungen zu nutzen.]]> Diese können über die Einstellungen deaktiviert werden – solange die App läuft, werden Benachrichtigungen weiterhin angezeigt.]]> - Erlauben Sie SimpleX im Hintergrund abzulaufen. Ansonsten werden die Benachrichtigungen deaktiviert.]]> + Erlauben Sie es im nächsten Dialog.]]> Die Akkuoptimierung ist aktiv, der Hintergrunddienst und die periodische Nachfrage nach neuen Nachrichten ist abgeschaltet. Sie können diese Funktion in den Einstellungen wieder aktivieren. Periodische Benachrichtigungen Periodische Benachrichtigungen sind deaktiviert! @@ -462,7 +462,7 @@ Verbunden Beendet - Die nächste Generation \ndes privaten Messagings + Die Zukunft des Messagings Datenschutz neu definiert Keine Benutzerkennungen. Immun gegen Spam @@ -474,8 +474,8 @@ Wie es funktioniert Wie SimpleX funktioniert - Zum Schutz Ihrer Privatsphäre verwendet SimpleX anstelle von Benutzerkennungen, die von allen anderen Plattformen verwendet werden, Kennungen für Nachrichtenwarteschlangen, die für jeden Ihrer Kontakte individuell sind. - zweischichtige Ende-zu-Ende-Verschlüsselung gesendet werden.]]> + SimpleX nutzt individuelle Kennungen für jeden Ihrer Kontakte, um Ihre Privatsphäre zu schützen. + Nur die Endgeräte speichern Benutzerprofile, Kontakte, Gruppen und Nachrichten. GitHub-Repository mehr dazu.]]> Fügen Sie den erhaltenen Link ein @@ -683,7 +683,7 @@ Die Einladung ist abgelaufen! Die Gruppeneinladung ist nicht mehr gültig, da sie vom Absender entfernt wurde. Die Gruppe wurde nicht gefunden! - Diese Gruppe existiert nicht mehr. + Diese Gruppe ist nicht mehr vorhanden. Kontakte können nicht eingeladen werden! Sie verwenden ein Inkognito-Profil für diese Gruppe. Um zu verhindern, dass Sie Ihr Hauptprofil teilen, ist in diesem Fall das Einladen von Kontakten nicht erlaubt. @@ -781,8 +781,8 @@ Ändern Wechseln Die Mitgliederrolle ändern? - Die Mitgliederrolle wird auf "%s" geändert. Alle Mitglieder der Gruppe werden benachrichtigt. - Die Mitgliederrolle wird auf "%s" geändert. Das Mitglied wird eine neue Einladung erhalten. + Die Rolle wird auf %s geändert. Alle Mitglieder der Gruppe werden benachrichtigt. + Die Rolle wird auf %s geändert. Das Mitglied wird eine neue Einladung erhalten. Fehler beim Entfernen des Mitglieds Fehler beim Ändern der Rolle Gruppe @@ -872,12 +872,12 @@ Unwiederbringliches Löschen von Nachrichten nicht erlauben. Das Senden von Sprachnachrichten erlauben. Das Senden von Sprachnachrichten nicht erlauben. - Gruppenmitglieder können Direktnachrichten versenden. + Mitglieder können Direktnachrichten versenden. In dieser Gruppe sind Direktnachrichten zwischen Mitgliedern nicht erlaubt. - Gruppenmitglieder können gesendete Nachrichten unwiederbringlich löschen (bis zu 24 Stunden). - In dieser Gruppe ist das unwiederbringliche Löschen von Nachrichten nicht erlaubt. - Gruppenmitglieder können Sprachnachrichten versenden. - In dieser Gruppe sind Sprachnachrichten nicht erlaubt. + Mitglieder können gesendete Nachrichten unwiederbringlich löschen (bis zu 24 Stunden). + Das unwiederbringliche Löschen von Nachrichten ist nicht erlaubt. + Mitglieder können Sprachnachrichten versenden. + Sprachnachrichten sind nicht erlaubt. LIVE Schauen Sie sich den Sicherheitscode an Sofort @@ -887,7 +887,7 @@ %s wurde erfolgreich überprüft Verifikation zurücknehmen Solange die App abläuft - Kann später über die Einstellungen geändert werden. + Auswirkung auf den Akku Löschen nach %d Stunde %d Stunden @@ -922,8 +922,8 @@ Gruppenlink erstellen Erlauben Sie Ihren Kontakten das Senden von verschwindenden Nachrichten. Das Senden von verschwindenden Nachrichten nicht erlauben. - In dieser Gruppe sind verschwindende Nachrichten nicht erlaubt. - Gruppenmitglieder können verschwindende Nachrichten senden. + Verschwindende Nachrichten sind nicht erlaubt. + Mitglieder können verschwindende Nachrichten senden. Fügen Sie Server durch Scannen der QR-Codes hinzu. Verschwindende Nachrichten Übernehmen @@ -978,7 +978,7 @@ Chat-Profil löschen für PING-Zähler Transport-Isolations-Modus aktualisieren\? - Mögliche Server für neue Verbindungen über Ihr aktuelles Chat-Profil + Nachrichten-Server für neue Verbindungen über Ihr aktuelles Chat-Profil Dateien & Medien Transport-Isolation Chat-Profil löschen\? @@ -1248,7 +1248,7 @@ Wenn Sie diesen Zugangscode während des Öffnens der App eingeben, werden alle App-Daten unwiederbringlich gelöscht! Selbstzerstörungs-Zugangscode Zugangscode einstellen - In dieser Gruppe sind Reaktionen auf Nachrichten nicht erlaubt. + Reaktionen auf Nachrichten sind nicht erlaubt. Fehler beim Laden von Details Empfangene Nachricht Information @@ -1279,7 +1279,7 @@ Nur Ihr Kontakt kann Reaktionen auf Nachrichten geben. Reaktionen auf Nachrichten erlauben. Reaktionen auf Nachrichten nicht erlauben. - Gruppenmitglieder können eine Reaktion auf Nachrichten geben. + Mitglieder können eine Reaktion auf Nachrichten geben. Mehr erfahren Endlich haben wir sie! 🚀 Reaktionen auf Nachrichten @@ -1294,9 +1294,7 @@ Farbdesigns anpassen und weitergeben. Tage Stunden - - Bis zu 5 Minuten lange Sprachnachrichten -\n- Zeitdauer für verschwindende Nachrichten anpassen -\n- Nachrichtenverlauf bearbeiten + - Bis zu 5 Minuten lange Sprachnachrichten\n- Zeitdauer für verschwindende Nachrichten anpassen\n- Nachrichtenverlauf bearbeiten benutzerdefiniert Monate Auswählen @@ -1325,9 +1323,9 @@ Wechsel der Empfängeradresse beenden? Dateien und Medien sind nicht erlaubt! Nur Gruppenbesitzer können Dateien und Medien aktivieren. - Gruppenmitglieder können Dateien und Medien senden. + Mitglieder können Dateien und Medien senden. Der Wechsel der Empfängeradresse wird beendet. Die bisherige Adresse wird weiter verwendet. - In dieser Gruppe sind Dateien und Medien nicht erlaubt. + Dateien und Medien sind nicht erlaubt. Favorit entfernen Favorit Keine gefilterten Chats @@ -1385,9 +1383,7 @@ Reparatur der Verschlüsselung nach Wiedereinspielen von Backups. Ein paar weitere Dinge Auch wenn sie in den Unterhaltungen deaktiviert sind. - - stabilere Zustellung von Nachrichten. -\n- ein bisschen verbesserte Gruppen. -\n- und mehr! + - Stabilere Zustellung von Nachrichten.\n- Ein bisschen verbesserte Gruppen.\n- Und mehr! Nicht aktivieren Das Senden von Empfangsbestätigungen an alle Kontakte wird aktiviert. Sie können diese später in den Datenschutz- und Sicherheits-Einstellungen der App aktivieren. @@ -1457,9 +1453,7 @@ Arabisch, Bulgarisch, Finnisch, Hebräisch, Thailändisch und Ukrainisch - Dank der Nutzer und Weblate. Erstellen eines neuen Profils in der Desktop-App. 💻 Inkognito beim Verbinden einschalten. - - Verbindung mit dem Directory-Service (BETA)! -\n- Empfangsbestätigungen (für bis zu 20 Mitglieder). -\n- Schneller und stabiler. + - Verbindung mit dem Directory-Service (BETA)!\n- Empfangsbestätigungen (für bis zu 20 Mitglieder).\n- Schneller und stabiler. Direktnachricht senden Direkt miteinander verbunden Erweitern @@ -1568,9 +1562,7 @@ Desktop-Adresse einfügen Code mit dem Desktop überprüfen Den QR-Code vom Desktop scannen - - Optionale Benachrichtigung von gelöschten Kontakten. -\n- Profilnamen mit Leerzeichen. -\n- Und mehr! + - Optionale Benachrichtigung von gelöschten Kontakten.\n- Profilnamen mit Leerzeichen.\n- Und mehr! Vom Mobiltelefon scannen Verbindungen überprüfen Bitte warten Sie, solange die Datei von dem verknüpften Mobiltelefon geladen wird @@ -1799,12 +1791,12 @@ SimpleX-Links sind nicht erlaubt Sprachnachrichten sind nicht erlaubt SimpleX-Links - Gruppenmitglieder können SimpleX-Links senden. + Mitglieder können SimpleX-Links senden. Administratoren Alle Mitglieder Aktiviert für Eigentümer - In dieser Gruppe sind SimpleX-Links nicht erlaubt. + SimpleX-Links sind nicht erlaubt. Das Senden von SimpleX-Links nicht erlauben. Das Senden von SimpleX-Links erlauben. Lautsprecher @@ -2077,7 +2069,7 @@ Archivierte Kontakte Keine gefilterten Kontakte Ihre Kontakte - Chat-Symbolleiste unten + App-Symbolleiste unten Bitten Sie Ihren Kontakt darum, Anrufe zu aktivieren. Sie müssen Ihrem Kontakt Anrufe zu Ihnen erlauben, bevor Sie ihn selbst anrufen können. Anrufe erlauben? @@ -2157,8 +2149,7 @@ Verwenden Sie für jedes Profil unterschiedliche Proxy-Anmeldeinformationen. Verwenden Sie zufällige Anmeldeinformationen Benutzername - %1$d Datei-Fehler: -\n%2$s + %1$d Datei-Fehler:\n%2$s %1$d Datei(en) wird/werden immer noch heruntergeladen. Bei %1$d Datei(en) ist das Herunterladen fehlgeschlagen. Fehler beim Weiterleiten der Nachrichten @@ -2215,11 +2206,11 @@ Für soziale Medien Oder zum privaten Teilen SimpleX-Adresse oder Einmal-Link? - Betreiber auswählen + Server-Betreiber Netzwerk-Betreiber - Wenn mehr als ein Netzwerk-Betreiber aktiviert ist, verwendet die App für jede Unterhaltung Server der verschiedenen Betreiber. + Die App verwendet für jede Unterhaltung Server von unterschiedlichen Betreibern, um Ihre Privatsphäre zu schützen. Die Nutzungsbedingungen der aktivierten Betreiber werden nach 30 Tagen akzeptiert. - Wenn Sie beispielsweise Nachrichten über einen SimpleX-Chatserver empfangen, verwendet die App einen der Server von Flux für die private Weiterleitung. + Wenn Ihr Kontakt beispielsweise Nachrichten über einen SimpleX-Chat-Server empfängt, wird Ihre App diese über einen Flux-Server versenden. Später einsehen Wählen sie die zu nutzenden Netzwerk-Betreiber aus. Sie können die Betreiber in den Netzwerk- und Servereinstellungen konfigurieren. @@ -2246,7 +2237,7 @@ Für Nachrichten verwenden Nachrichtenserver hinzugefügt Für privates Routing - Die Server Deines aktuellen Chat-Profils für neue Dateien + Medien- und Datei-Server für neue Daten über Ihr aktuelles Chat-Profil Für das Senden Für Dateien verwenden Fehler beim Hinzufügen des Servers @@ -2271,7 +2262,7 @@ nur mit einem Kontakt genutzt werden - teilen Sie in nur persönlich oder über einen beliebigen Messenger.]]> %s.]]> %s.]]> - Die Nutzungsbedingungen werden akzeptiert am: %s. + Die Nutzungsbedingungen wurden akzeptiert am: %s %s.]]> %s zu nutzen, müssen Sie dessen Nutzungsbedingungen akzeptieren.]]> Fehler beim Akzeptieren der Nutzungsbedingungen @@ -2285,10 +2276,50 @@ Diese Verbindung hat das Limit der nicht ausgelieferten Nachrichten erreicht. Ihr Kontakt ist möglicherweise offline. Diese Nachricht wurde gelöscht oder bisher noch nicht empfangen. Zum Schutz vor dem Austausch Ihres Links können Sie die Sicherheitscodes Ihrer Kontakte vergleichen. - %s.]]> + %s.]]> %s.]]> Die Nutzungsbedingungen wurden akzeptiert am: %s. Der Text der aktuellen Nutzungsbedingungen konnte nicht geladen werden. Sie können die Nutzungsbedingungen unter diesem Link einsehen: Ferngesteuerte Mobiltelefone Oder importieren Sie eine Archiv-Datei + Hinweis für Geräte von Xiaomi: Bitte aktivieren Sie in den System-Einstellungen die Option "Autostart", damit Benachrichtigungen funktionieren.]]> + Ende-zu-Ende-verschlüsselt versendet. In Direktnachrichten sogar mit Post-Quantum-Security.]]> + Team-Mitglieder aufnehmen + Freunde aufnehmen + Einladung akzeptiert + Geschäftliche Adresse + Geschäftliche Chats + Nehmen Sie Team-Mitglieder in Ihre Unterhaltungen auf. + Die App läuft immer im Hintergrund ab + In diesem Chat sind Direktnachrichten zwischen Mitgliedern nicht erlaubt. + Kein Hintergrund-Service + Nachrichten alle 10 Minuten überprüfen + Benachrichtigungen und Akku + Zum Chat einladen + Chat besteht bereits! + Chat-Symbolleiste unten + Chat verlassen + Das Mitglied wird aus dem Chat entfernt. Dies kann nicht rückgängig gemacht werden! + Ihr Chat-Profil wird an die Chat-Mitglieder gesendet. + Direktnachrichten zwischen Mitgliedern sind nicht erlaubt. + Wie die Privatsphäre geschützt wird + Chat verlassen? + Chat löschen? + Der Chat wird für alle Mitglieder gelöscht. Dies kann nicht rückgängig gemacht werden! + Schutz der Privatsphäre Ihrer Kunden. + Zur Verbindung aufgefordert + Bitte verkleinern Sie die Nachrichten-Größe oder entfernen Sie Medien und versenden Sie diese erneut. + Nur Chat-Eigentümer können die Präferenzen ändern. + Bitte verkleinern Sie die Nachrichten-Größe und versenden Sie diese erneut. + Die Rolle wird auf %s geändert. Im Chat wird Jeder darüber informiert. + Sie werden von diesem Chat keine Nachrichten mehr erhalten. Der Nachrichtenverlauf wird beibehalten. + Sie können die Nachricht kopieren und verkleinern, um sie zu versenden. + Chat löschen + Der Chat wird für Sie gelöscht. Dies kann nicht rückgängig gemacht werden! + Die Nachricht ist zu umfangreich! + Wenn mehr als ein Betreiber aktiviert ist, hat keiner von ihnen Metadaten, um zu erfahren, wer mit wem kommuniziert. + Chat + %1$s verbunden.]]> + Über Betreiber + SimpleX-Chat und Flux haben vereinbart, die von Flux betriebenen Server in die App aufzunehmen. \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/es/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/es/strings.xml index 0e53f59c06..6163d7e873 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/es/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/es/strings.xml @@ -94,7 +94,7 @@ Autenticación de dispositivo desactivada. Puedes habilitar Bloqueo SimpleX en Configuración, después de activar la autenticación de dispositivo. Desactivar Los mensajes temporales no están permitidos en este chat. - Los mensajes temporales no están permitidos en este grupo. + Mensajes temporales no permitidos. El nombre mostrado no puede contener espacios en blanco. Videollamada con cifrado de extremo a extremo conexión establecida @@ -337,7 +337,7 @@ Introduce la contraseña… Grupo inactivo grupo eliminado - Los miembros del grupo pueden enviar mensajes temporales. + Los miembros pueden enviar mensajes temporales. Enlaces de grupo Enlace de conexión no válido Error al aceptar solicitud del contacto @@ -357,7 +357,7 @@ Error al eliminar base de datos Base de datos cifrada Error al eliminar miembro - Los miembros del grupo pueden enviar mensajes de voz. + Los miembros pueden enviar mensajes de voz. en modo incógnito mediante enlace de dirección del contacto ¡Error al crear perfil! No se pudo cargar el chat @@ -407,8 +407,8 @@ SERVIDORES Nombre del grupo: Preferencias del grupo - Los miembros del grupo pueden enviar mensajes directos. - Los miembros del grupo pueden eliminar mensajes de forma irreversible. (24 horas) + Los miembros pueden enviar mensajes directos. + Los miembros pueden eliminar mensajes enviados de forma irreversible. (24 horas) Ocultar pantalla de aplicaciones en aplicaciones recientes. Cifrar Ampliar la selección de roles @@ -431,7 +431,7 @@ Cómo funciona El mensaje será eliminado. ¡No podrá deshacerse! El modo incógnito protege tu privacidad creando un perfil aleatorio por cada contacto. - permite que SimpleX se ejecute en segundo plano en el siguiente cuadro de diálogo. De lo contrario las notificaciones se desactivarán.]]> + Da permiso en el siguiente diálogo para recibir notificaciones instantáneas.]]> Instalar terminal de SimpleX Chat invitación al grupo %1$s ha invitado a %1$s @@ -443,7 +443,7 @@ Notificación instantánea Configuración avanzada Sólo los dispositivos cliente almacenan perfiles de usuario, contactos, grupos y mensajes. - Puedes cambiar estos ajustes más tarde en Configuración. + Cómo afecta a la batería Instantánea Unirte Unirte en modo incógnito @@ -451,7 +451,7 @@ Claro Activado La eliminación irreversible de mensajes no está permitida en este chat. - La eliminación irreversible de mensajes no está permitida en este grupo. + Eliminación irreversible no permitida. Configuración del servidor mejorada Esto puede ocurrir cuando: \n1. Los mensajes hayan caducado en el cliente saliente tras 2 días o en el servidor tras 30 días. @@ -555,7 +555,7 @@ has cambiado el servidor para %s ha salido Salir del grupo - Sólo los propietarios pueden modificar las preferencias del grupo. + Sólo los propietarios del grupo pueden cambiar las preferencias. Eliminar sólo el perfil no k @@ -642,7 +642,7 @@ Espacio reservado para la imagen del perfil Código QR Consultas y sugerencias - Dirección del servidor predefinida + Dirección predefinida del servidor Contacta vía email Valora la aplicación Guardar @@ -718,7 +718,7 @@ envío no autorizado Escribe un nombre para el contacto Error desconocido - El rol del miembro cambiará a "%s" y se notificará al grupo. + El rol cambiará a %s. Todos serán notificados. La seguridad de SimpleX Chat ha sido auditada por Trail of Bits. Los mensajes enviados se eliminarán una vez transcurrido el tiempo establecido. Mensajes de chat SimpleX @@ -736,12 +736,12 @@ ¡La conexión que has aceptado se cancelará! La base de datos no funciona correctamente. Pulsa para conocer más El mensaje será marcado como moderado para todos los miembros. - La nueva generación \nde mensajería privada + El futuro de la mensajería Esta acción es irreversible. Se eliminarán todos los archivos y multimedia recibidos y enviados. Las imágenes de baja resolución permanecerán. Esta acción es irreversible. Los mensajes enviados y recibidos anteriores a la selección serán eliminados. Podría tardar varios minutos. Esta configuración se aplica a los mensajes del perfil actual ¡Esta cadena no es un enlace de conexión! - servicio en segundo planoSimpleX, usa un pequeño porcentaje de la batería al día.]]> + SimpleX se ejecuta en segundo plano en lugar de usar notificaciones push.]]> Configuración Altavoz desactivado Inciar chat nuevo @@ -785,7 +785,7 @@ Probar servidor Probar servidores Estrella en GitHub - Lista de servidores para las conexiones nuevas de tu perfil actual + Lista de servidores para las conexiones nuevas del perfil ¿Usar conexión directa a Internet\? El perfil sólo se comparte con tus contactos. inicializando… @@ -804,7 +804,7 @@ Actualizar contraseña base de datos Pulsa para unirte en modo incógnito Cambiar - El rol del miembro cambiará a "%s" y recibirá una invitación nueva. + El rol cambiará a %s y el miembro recibirá una invitación nueva. Actualizar ¿Actualizar la configuración de red\? Intentando conectar con el servidor para recibir mensajes de este contacto. @@ -840,9 +840,9 @@ Mensajes de voz Tus contactos pueden permitir la eliminación completa de mensajes. Mensajes de voz - Los mensajes de voz no están permitidos en este grupo. + Mensajes de voz no permitidos. Comprobar la seguridad de la conexión - ¡Ya estás conectado a %1$s. + ¡Ya estás conectado con %1$s. ¡Bienvenido! Tu perfil será enviado \na tu contacto @@ -1028,7 +1028,7 @@ Servidores XFTP Puerto puerto %d - Usar hosts .onion como No si el proxy SOCKS no los admite.]]> + Usar hosts .onion debe estar a No si el proxy SOCKS no los admite.]]> Descargar archivo Usar proxy SOCKS Host @@ -1208,7 +1208,7 @@ semanas Error al cargar detalles Los miembros pueden añadir reacciones a los mensajes. - Las reacciones a los mensajes no están permitidas en este grupo. + Reacciones a los mensajes no permitidas. Sólo tu contacto puede añadir reacciones a los mensajes. 1 minuto Registro actualiz @@ -1228,12 +1228,12 @@ Personalizar y compartir temas de color. ¡Por fin los tenemos! 🚀 Reacciones a los mensajes - Conoce más + Saber más Interfaz en japonés y portugués sin texto Han ocurrido algunos errores no críticos durante la importación: ¿Cerrar\? - Aplicación + APLICACIÓN Reiniciar Cerrar Las notificaciones dejarán de funcionar hasta que reinicies la aplicación @@ -1248,8 +1248,8 @@ Cancelar cambio de dirección Archivos y multimedia No se permite el envío de archivos y multimedia. - Los archivos y multimedia no están permitidos en este grupo. - Los miembros del grupo pueden enviar archivos y multimedia. + Archivos y multimedia no permitidos. + Los miembros pueden enviar archivos y multimedia. Se permite enviar archivos y multimedia Favorito Sólo los propietarios del grupo pueden activar los archivos y multimedia. @@ -1356,7 +1356,7 @@ La contraseña aleatoria se almacenará en Configuración como texto plano. \nPuedes cambiarlo más tarde. La contraseña para el cifrado de la base de datos se actualizará y almacenará en Configuración - Eliminar contraseña de configuración\? + ¿Eliminar contraseña de configuración? Usar contraseña aleatoria Guardar contraseña en configuración Configuración contraseña base de datos @@ -1715,8 +1715,8 @@ Enlaces SimpleX no permitidos Mensajes de voz no permitidos Enlaces SimpleX - Los miembros del grupo pueden enviar enlaces SimpleX. - Los enlaces SimpleX no se permiten en este grupo. + Los miembros pueden enviar enlaces SimpleX. + Enlaces SimpleX no permitidos. propietarios Móvil Sin conexión de red @@ -1897,7 +1897,7 @@ errores de descifrado Eliminadas Errores de eliminación - desactivado + inactivo Mensaje reenviado El mensaje puede ser entregado más tarde si el miembro vuelve a estar activo. Miembro inactivo @@ -1990,7 +1990,7 @@ Medio Suave Barra de herramientas accesible - llamada + llamar conectar ¿Eliminar %d mensajes de miembros? mensaje @@ -2083,8 +2083,8 @@ Error guardando proxy Contraseña Autenticación proxy - Credenciales proxy diferentes para cada conexión. - Credenciales proxy diferentes para cada perfil. + Se usan credenciales proxy diferentes para cada conexión. + Se usan credenciales proxy diferentes para cada perfil. Credenciales aleatorias Nombre de usuario Tus credenciales podrían ser enviadas sin cifrar. @@ -2125,12 +2125,12 @@ Ningún servidor para enviar archivos. Seguridad de conexión Compartir enlace de un uso con un amigo - Compartir dirección SimpleX en redes sociales. + Comparte tu dirección SimpleX en redes sociales. Configuración de dirección Crear enlace de un uso Para redes sociales - Dirección SimpleX o enlace de un uso? - Selecciona operadores + ¿Dirección SimpleX o enlace de un uso? + Operadores de servidores Operadores de red Las condiciones de los operadores habilitados serán aceptadas después de 30 días. Revisar más tarde @@ -2162,10 +2162,10 @@ Las condiciones serán aceptadas automáticamente para los operadores habilitados el: %s. Continuar El texto con las condiciones actuales no se ha podido cargar, puedes revisar las condiciones en el siguiente enlace: - Habilitar Flux + Habilita Flux Error al aceptar las condiciones Error al actualizar el servidor - para mayor privacidad de los metadatos. + para mejorar la privacidad de los metadatos. Ningún mensaje Servidor nuevo Ningún servidor de archivos y multimedia. @@ -2175,7 +2175,7 @@ O para compartir en privado Selecciona los operadores de red a utilizar Campartir dirección públicamente - Compartir enlaces de un uso y direcciones SimpleX es seguro a través de cualquier medio. + Compartir los enlaces de un uso y las direcciones SimpleX es seguro a través de cualquier medio. Actualizar Sitio web Tus servidores @@ -2191,25 +2191,65 @@ Mensajes no entregados solamente con un contacto - comparte en persona o mediante cualquier aplicación de mensajería.]]> Puedes añadir un nombre a la conexión para recordar a quién corresponde. - Cuando está habilitado más de un operador de red, la aplicación usa servidores de diferentes operadores para cada conversación. + La aplicación protege tu privacidad mediante el uso de diferentes operadores en cada conversación. Puedes configurar los operadores desde Servidores y Redes. %s.]]> %s.]]> %s.]]> - %s.]]> + %s.]]> %s.]]> %s.]]> %s, acepta las condiciones de uso.]]> Los servidores para archivos nuevos en tu perfil actual - El segundo operador predefinido! + ¡Segundo operador predefinido! Puedes configurar los servidores a través de su configuración. Para protegerte contra una sustitución del enlace, puedes comparar los códigos de seguridad con tu contacto. - %s.]]> + %s.]]> %s.]]> - Si por ejemplo recibes los mensajes a través de un servidor de SimpleX Chat, la aplicación usará uno de Flux para el enrutamiento privado. + Por ejemplo, si tu contacto recibe a través de un servidor de SimpleX Chat, tu aplicación enviará a través de un servidor de Flux. Pulsa Crear dirección SimpleX en el menú para crearla más tarde. La conexión ha alcanzado el límite de mensajes no entregados. es posible que tu contacto esté desconectado. El mensaje ha sido borrado o aún no se ha recibido. Móvil remoto O importa desde un archivo + Mensajes directos entre miembros de este chat no permitidos. + En dispositivos Xiaomi: por favor, habilita el Autoinicio en los ajustes del sistema para que las notificaciones funcionen.]]> + Por favor, reduce el tamaño del mensaje y envíalo de nuevo. + Por favor, reduce el tamaño del mensaje o elimina los archivos y envíalo de nuevo. + Puedes copiar y reducir el tamaño del mensaje para enviarlo. + Añade a los miembros de tu equipo a las conversaciones. + Notificaciones y batería + Invitar al chat + Añadir amigos + Añadir miembros del equipo + El chat será eliminado para todos los miembros. ¡No podrá deshacerse! + Eliminar chat + ¿Eliminar chat? + Salir del chat + El chat será eliminado para tí. ¡No podrá deshacerse! + Sólo los propietarios del chat pueden cambiar las preferencias. + El miembro será eliminado del chat. ¡No podrá deshacerse! + El rol cambiará a %s. Todos serán notificados. + Dejarás de recibir mensajes de este chat. El historial del chat se conserva. + Cómo ayuda a la privacidad + Cuando está habilitado más de un operador, ninguno dispone de los metadatos para conocer quién se comunica con quién. + Tu perfil de chat será enviado a los miembros de chat + Chats empresariales + ¿Salir del chat? + Privacidad para tus clientes. + invitación aceptada + solicitado para conectar + Dirección empresarial + Comprobar mensajes cada 10 min. + Sin servicio en segundo plano + Chat + Barra de herramientas accesible + Mensajes directos entre miembros no permitidos. + %1$s.]]> + ¡El chat ya existe! + Acerca de los operadores + La aplicación siempre funciona en segundo plano + cifrados de extremo a extremo y con seguridad postcuántica en mensajes directos.]]> + ¡Mensaje demasiado largo! + Simplex Chat y Flux han acordado incluir servidores operados por Flux en la aplicación. \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/hu/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/hu/strings.xml index 83f408054f..531e29de20 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/hu/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/hu/strings.xml @@ -15,7 +15,7 @@ 30 másodperc Egyszer használható meghívó-hivatkozás %1$s szeretne kapcsolatba lépni Önnel ezen keresztül: - A SimpleX Chatről + SimpleX Chat névjegye 1 nap Címváltoztatás megszakítása A SimpleXről @@ -1754,7 +1754,7 @@ Ne küldjön üzeneteket közvetlenül, még akkor sem, ha az Ön kiszolgálója vagy a célkiszolgáló nem támogatja a privát útválasztást. Tor vagy VPN nélkül az IP-címe látható lesz a fájlkiszolgálók számára. FÁJLOK - IP-cím védelem + IP-cím védelme Az alkalmazás kérni fogja az ismeretlen fájlkiszolgálókról történő letöltések megerősítését (kivéve, ha az .onion vagy a SOCKS proxy engedélyezve van). Ismeretlen kiszolgálók! Tor vagy VPN nélkül az IP-címe látható lesz az XFTP-közvetítő-kiszolgálók számára:\n%1$s. @@ -2109,13 +2109,13 @@ Egyszer használható meghívó-hivatkozás létrehozása Kiszolgáló-üzemeltetők Hálózati üzemeltetők - Amikor egynél több hálózati üzemeltető van engedélyezve, akkor az alkalmazás minden egyes beszélgetéshez a különböző üzemeltetők kiszolgálóit használja. - Ha például a SimpleX Chat kiszolgálón keresztül fogadja az üzeneteket, az alkalmazás a Flux egyik kiszolgálóját használja a privát útválasztáshoz. + Az alkalmazás úgy védi az adatait, hogy minden egyes beszélgetésben más-más üzemeltetőt használ. + Például, ha az Ön ismerőse egy SimpleX Chat-kiszolgálón keresztül fogadja az üzeneteket, az Ön alkalmazása egy Flux-kiszolgálón keresztül fogja azokat kézbesíteni. Válassza ki a használni kívánt hálózati üzemeltetőket. Felülvizsgálat később - A kiszolgálókat a beállításokon keresztül konfigurálhatja. + A kiszolgálókat a „Hálózat és kiszolgálók” menüben konfigurálhatja. A feltételek 30 nap elteltével lesznek elfogadva az engedélyezett üzemeltetők számára. - Az üzemeltetőket a „Hálózat és kiszolgálók” beállításaban konfigurálhatja. + Az üzemeltetőket a „Hálózat és kiszolgálók” menüben konfigurálhatja. Frissítés Folytatás Feltételek felülvizsgálata @@ -2133,14 +2133,14 @@ %s használata A jelenlegi feltételek szövegét nem lehetett betölteni, a feltételeket ezen a hivatkozáson keresztül vizsgálhatja felül: %s.]]> - %s.]]> - %s.]]> + %s.]]> + %s.]]> %s.]]> %s.]]> %s.]]> Feltételek elfogadása Használati feltételek - %s kiszolgálóinak használatához fogadja el a használati feltételeket.]]> + %s kiszolgálók használatához fogadja el a használati feltételeket.]]> Használat az üzenetekhez A fogadáshoz A privát útválasztáshoz @@ -2204,4 +2204,9 @@ Az üzenet túl nagy! Csökkentse az üzenet méretét vagy távolítsa el a médiát, és küldje el újra. A tagok közötti közvetlen üzenetek le vannak tiltva ebben a csevegésben. + Amikor egynél több üzemeltető van engedélyezve, akkor egyik sem rendelkezik olyan metaadatokkal, amelyekből megtudható, hogy ki kivel kommunikál. + elfogadott meghívó + kérelmezve a kapcsolódáshoz + Az üzemeltetőkről + A SimpleX Chat és a Flux megállapodást kötött arról, hogy a Flux által üzemeltetett kiszolgálókat beépítik az alkalmazásba. \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_breaking_news.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_breaking_news.svg new file mode 100644 index 0000000000..4688932ef9 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_breaking_news.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_drag_handle.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_drag_handle.svg new file mode 100644 index 0000000000..99d3e66fe8 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_drag_handle.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_group_filled.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_group_filled.svg new file mode 100644 index 0000000000..f30bc0db2c --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_group_filled.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_label.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_label.svg new file mode 100644 index 0000000000..02c84c9d05 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_label.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_label_filled.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_label_filled.svg new file mode 100644 index 0000000000..3b58600ae2 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_label_filled.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_person_filled.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_person_filled.svg new file mode 100644 index 0000000000..0ed867b156 --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_person_filled.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_work_filled.svg b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_work_filled.svg new file mode 100644 index 0000000000..fb5c122eec --- /dev/null +++ b/apps/multiplatform/common/src/commonMain/resources/MR/images/ic_work_filled.svg @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/it/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/it/strings.xml index c342319dbb..ffdc377ceb 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/it/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/it/strings.xml @@ -363,7 +363,7 @@ Audio spento Audio acceso Chiamate audio e video - Auto-accetta immagini + Auto-accetta le immagini hash del messaggio errato ID messaggio errato Chiamata terminata @@ -470,7 +470,7 @@ attivato per il contatto attivato per te Preferenze del gruppo - Auto-accetta richieste di contatto + Auto-accetta le richieste di contatto %dg %d giorno %d giorni @@ -538,7 +538,7 @@ Codice QR non valido immagine di anteprima link Segna come già letto - Segna come non letto + Segna come non letta Altro Silenzia immagine del profilo @@ -704,7 +704,7 @@ Riavvia l\'app per creare un profilo di chat nuovo. Riavvia l\'app per usare il database della chat importato. AVVIA CHAT - Invia anteprime dei link + Invia le anteprime dei link Imposta la password per esportare IMPOSTAZIONI PROXY SOCKS @@ -918,7 +918,7 @@ Grazie agli utenti – contribuite via Weblate! Interfaccia francese Interfaccia italiana - Bozza dei messaggi + Bozza del messaggio Conserva la bozza dell\'ultimo messaggio, con gli allegati. Nomi di file privati Per profilo di chat (predefinito) o per connessione (BETA). @@ -1348,7 +1348,7 @@ %s e %s si sono connessi/e %s, %s e altri %d membri si sono connessi %s, %s e %s si sono connessi/e - Bozza + Bozza del messaggio Mostra gli ultimi messaggi Il database verrà crittografato e la password conservata nelle impostazioni. La password casuale viene conservata nelle impostazioni come testo normale. @@ -1615,8 +1615,7 @@ hai bloccato %s Il messaggio di benvenuto è troppo lungo Messaggio troppo grande - Migrazione database in corso. -\nPuò richiedere qualche minuto. + Migrazione del database in corso.\nPuò richiedere qualche minuto. Chiamata audio Termina chiamata Videochiamata @@ -1980,7 +1979,7 @@ Errore di connessione al server di inoltro %1$s. Riprova più tardi. La versione server di inoltro è incompatibile con le impostazioni di rete: %1$s. Off - Sfocatura file multimediali + Sfocatura dei file multimediali Leggera Media Forte @@ -2131,18 +2130,18 @@ Per i social media O per condividere in modo privato Operatori di rete - Quando più di un operatore di rete è attivato, l\'app userà i server di diversi operatori per ogni conversazione. + L\'app protegge la tua privacy usando diversi operatori per ogni conversazione. Puoi configurare gli operatori nelle impostazioni di rete e server. Operatori del server Seleziona gli operatori di rete da usare. Continua Aggiorna - Esamina più tardi + Leggi più tardi Server preimpostati Condizioni accettate Le condizioni verranno accettate automaticamente per gli operatori attivati il: %s. I tuoi server - Esamina le condizioni + Leggi le condizioni %s.]]> %s.]]> Il testo delle condizioni attuali testo non è stato caricato, puoi consultare le condizioni tramite questo link: @@ -2192,13 +2191,13 @@ Errore di accettazione delle condizioni Errore di salvataggio dei server per una migliore privacy dei metadati. - Ad esempio, se ricevi messaggi tramite il server di SimpleX Chat, l\'app userà uno dei server Flux per l\'instradamento privato. + Ad esempio, se il tuo contatto riceve i messaggi tramite un server di SimpleX Chat, la tua app li consegnerà tramite un server di Flux. Navigazione della chat migliorata Nuovo server Usa per i file Indirizzo SimpleX o link una tantum? Questo messaggio è stato eliminato o non ancora ricevuto. - Tocca \"Crea indirizzo SimpleX\" nel menu per crearlo più tardi. + Tocca Crea indirizzo SimpleX nel menu per crearlo più tardi. La connessione ha raggiunto il limite di messaggi non consegnati, il contatto potrebbe essere offline. Usa i server Puoi configurare i server nelle impostazioni. @@ -2208,7 +2207,7 @@ Nessun server per inviare file. - Apri la chat sul primo messaggio non letto.\n- Salta ai messaggi citati. Condividi indirizzo pubblicamente - Condividi indirizzo SimpleX sui social media. + Condividi l\'indirizzo SimpleX sui social media. O importa file archivio Telefoni remoti I messaggi diretti tra i membri sono vietati in questa chat. @@ -2246,4 +2245,8 @@ Il ruolo verrà cambiato in %s. Verrà notificato a tutti nella chat. Il tuo profilo di chat verrà inviato ai membri della chat Non riceverai più messaggi da questa chat. La cronologia della chat verrà conservata. + Quando più di un operatore è attivato, nessuno di essi ha metadati per capire chi comunica con chi. + invito accettato + richiesto di connettersi + SimpleX Chat e Flux hanno concluso un accordo per includere server gestiti da Flux nell\'app \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/nl/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/nl/strings.xml index f00182b469..ced3b9a3b0 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/nl/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/nl/strings.xml @@ -2147,7 +2147,7 @@ Later beoordelen Selecteer welke netwerkoperators u wilt gebruiken. Update - Wanneer er meer dan één netwerkoperator is ingeschakeld, gebruikt de app voor elk gesprek de servers van verschillende operators. + De app beschermt uw privacy door in elk gesprek verschillende operators te gebruiken. U kunt operators configureren in Netwerk- en serverinstellingen. Doorgaan Voorwaarden bekijken @@ -2183,7 +2183,7 @@ Verbeterde chatnavigatie Netwerk decentralisatie De tweede vooraf ingestelde operator in de app! - Als u bijvoorbeeld berichten ontvangt via de SimpleX Chat-server, gebruikt de app een van de Flux-servers voor privéroutering. + Als uw contactpersoon bijvoorbeeld berichten ontvangt via een SimpleX Chat-server, worden deze door uw app via een Flux-server verzonden. Flux inschakelen Geen bericht App-werkbalken @@ -2242,4 +2242,9 @@ Geen achtergrondservice Alleen chateigenaren kunnen voorkeuren wijzigen. Verklein de berichtgrootte of verwijder de media en verzend het bericht opnieuw. + geaccepteerde uitnodiging + Wanneer er meer dan één operator is ingeschakeld, beschikt geen enkele operator over metagegevens om te achterhalen wie met wie communiceert. + gevraagd om verbinding te maken + Over operatoren + Simplex-chat en flux hebben een overeenkomst gemaakt om door flux geëxploiteerde servers in de app op te nemen. \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/ru/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/ru/strings.xml index a0c5ccf01b..f234a2cf0a 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/ru/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/ru/strings.xml @@ -1882,8 +1882,7 @@ Информация об очереди сообщений Персидский интерфейс Защитить IP адрес - Защитите ваш IP адрес от серверов сообщений, выбранных Вашими контактами. -\nВключите в настройках Сеть и серверы. + Защитите ваш IP адрес от серверов сообщений, выбранных Вашими контактами. \nВключите в настройках Сети и серверов. Отправьте сообщения напрямую, когда Ваш сервер или сервер получателя не поддерживает конфиденциальную доставку. Конфиденциальная доставка Использовать конфиденциальную доставку с неизвестными серверами. @@ -2265,7 +2264,7 @@ Как это улучшает конфиденциальность Операторы серверов Выберите операторов сети. - Вы можете настроить операторов в настройках Сеть и серверы. + Вы можете настроить операторов в настройках Сети и серверов. Продолжить Посмотреть позже Обновить @@ -2305,7 +2304,7 @@ Ошибка сохранения сервера Для доставки сообщений Открыть изменения - Оператор серверов изменен. + Оператор сервера изменен. Протокол сервера изменен. Серверы для новых файлов Вашего текущего профиля Для получения diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/uk/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/uk/strings.xml index 548e29f836..eff112717e 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/uk/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/uk/strings.xml @@ -219,7 +219,7 @@ OK Скопійовано в буфер обміну Для підключення через посилання - Відкрити у мобільному додатку, а потім торкніться Підключити в додатку.]]> + Відкрити у мобільному додатку, а потім торкніться Підключити в додатку.]]> Приглушити Скасувати приглушення Ви запросили контакт @@ -233,7 +233,7 @@ Одноразове запрошення Невірний код безпеки! Для перевірки end-to-end шифрування порівняйте (або скануйте) код на своїх пристроях. - Ваші налаштування + Налаштування Ваша SimpleX-адреса Допомога з Markdown Блокування SimpleX @@ -268,7 +268,7 @@ Ніяких ідентифікаторів користувачів. Децентралізована Використовувати чат - Це можна змінити пізніше в налаштуваннях. + Як це впливає на батарею Миттєво Виклик вже завершено! Ваші виклики @@ -496,7 +496,7 @@ Тільки ваш контакт може надсилати голосові повідомлення. Забороняйте надсилання повідомлень, які зникають. Забороняйте невідворотне видалення повідомлень. - Учасники групи можуть надсилати голосові повідомлення. + Учасники можуть надсилати голосові повідомлення. %dm Нове в %s Самознищуючий пароль @@ -544,7 +544,7 @@ Створити файл Помилка видалення користувача Помилка оновлення конфіденційності користувача - фоновий сервіс SimpleX – він використовує кілька відсотків батареї щодня.]]> + SimpleX працює у фоновому режимі замість використання пуш-повідомлень.]]> Періодичні сповіщення Служба чату SimpleX Перевіряє нові повідомлення кожні 10 хвилин протягом 1 хвилини @@ -649,7 +649,7 @@ Ви можете використовувати markdown для форматування повідомлень: Створіть свій профіль Створіть приватне підключення - шифрування на двох рівнях.]]> + Тільки клієнтські пристрої зберігають профілі, контакти, групи та повідомлення. Приватні сповіщення Споживає більше акумулятора! Додаток завжди працює у фоновому режимі – сповіщення відображаються миттєво.]]> Вставте отримане посилання @@ -746,14 +746,14 @@ Тільки ви можете надсилати голосові повідомлення. Тільки ви можете додавати реакції на повідомлення. Заборонити реакції на повідомлення. - Самознищувальні повідомлення заборонені в цій групі. - Учасники групи можуть надсилати приватні повідомлення. + Повідомлення, що зникають, заборонені. + Учасники можуть надсилати прямі повідомлення. Приватні повідомлення між учасниками заборонені в цій групі. - Учасники групи можуть назавжди видаляти відправлені повідомлення. (24 години) - Назавжди видалення повідомлень заборонене в цій групі. - Голосові повідомлення заборонені в цій групі. - Учасники групи можуть додавати реакції на повідомлення. - Реакції на повідомлення заборонені в цій групі. + Учасники можуть необоротно видаляти надіслані повідомлення (протягом 24 годин). + Заборонено необоротне видалення повідомлень. + Голосові повідомлення заборонені + Учасники можуть додавати реакції на повідомлення. + Реакції на повідомлення заборонені. %d година %d тиждень %d тижні @@ -805,7 +805,7 @@ Безпечна черга Видалити чергу Будь ласка, перевірте, що ви використали правильне посилання або попросіть вашого контакту вислати інше. - дозвольте SimpleX працювати в фоновому режимі в наступному діалозі. В іншому випадку сповіщення будуть вимкнені.]]> + Дозвольте це в наступному діалозі, щоб отримувати сповіщення миттєво.]]> Миттєві сповіщення Контакт прихований: нове повідомлення @@ -892,7 +892,7 @@ Дякуємо користувачам – приєднуйтеся через Weblate! Режим блокування SimpleX Системна аутентифікація - Для захисту приватності, замість ідентифікаторів користувачів, які використовуються всіма іншими платформами, у SimpleX є ідентифікатори черг повідомлень, окремі для кожного з ваших контактів. + Для захисту вашої конфіденційності SimpleX використовує окремі ID для кожного вашого контакту. Коли додаток запущено Періодично контакт не має зашифрування e2e @@ -919,7 +919,7 @@ ви видалили %1$s Торкніться для активації профілю. Забороняйте надсилання голосових повідомлень. - Учасники групи можуть надсилати самознищувальні повідомлення. + Учасники можуть надсилати повідомлення, що зникають. %d хв Зменшене споживання енергії батареї Редагувати зображення @@ -1012,7 +1012,7 @@ Очистити перевірку %s перевірено %s не перевірено - Надішліть нам електронного листа + Написати нам ел. листа Тестовий сервер Зберегти сервери\? Ваші сервери ICE @@ -1089,7 +1089,7 @@ ні вимк Встановити налаштування групи - Ваші налаштування + Налаштування Прямі повідомлення Помилка Одноразове запрошення @@ -1161,7 +1161,7 @@ кольоровий дзвінок завершено %1$s помилка дзвінка - Наступне покоління \nприватних повідомлень + Майбутнє обміну повідомленнями Кожен може хостити сервери. Інструменти розробника Експериментальні функції @@ -1178,7 +1178,7 @@ (щоб поділитися з вашим контактом) (сканувати або вставити з буферу обміну) підключитися до розробників SimpleX Chat, щоб задати будь-які питання і отримувати оновлення.]]> - Сканувати QR-код.]]> + Сканувати QR-код.]]> Адреса SimpleX Показати QR-код Приєднання до групи @@ -1249,7 +1249,7 @@ Помилка відміни зміни адреси Перервати зміну адреси Дозволити надсилання файлів та медіафайлів. - Файли та медіафайли заборонені в цій групі. + Файли та медіа заборонені. Підключити інкогніто Використовувати поточний профіль Дозволити @@ -1347,7 +1347,7 @@ Зміна адреси буде скасована. Буде використовуватися стара адреса для отримання. Повторно узгодити шифрування? Шифрування працює і нова угода про шифрування не потрібна. Це може призвести до помилок підключення! - Учасники групи можуть надсилати файли та медіафайли. + Учасники можуть надсилати файли та медіа. База даних буде зашифрована, і ключова фраза буде збережена в налаштуваннях. Розгорнути Повторити запит на підключення? @@ -1441,7 +1441,7 @@ Підключати автоматично Адреса робочого столу Одночасно може працювати лише один пристрій - Посилання на мобільний та комп\'ютерний додатки! 🔗 + Підключіть мобільний і десктопний додатки! 🔗 Через безпечний квантовостійкий протокол. Використовувати з робочого столу у мобільному додатку і скануйте QR-код.]]> Щоб приховати небажані повідомлення. @@ -1734,7 +1734,7 @@ Переслати Переслано Переслано з - Учасники групи можуть надсилати посилання SimpleX. + Учасники можуть надсилати посилання SimpleX. Звуки вхідного дзвінка Світлий режим Запасний варіант маршрутизації повідомлень @@ -1828,7 +1828,7 @@ Коли IP приховано Так Отримання паралелізму - У цій групі заборонені посилання на SimpleX. + Посилання SimpleX заборонені. Сформуйте зображення профілю При підключенні аудіо та відеодзвінків. Скинути колір @@ -2011,7 +2011,7 @@ Завантажити %s (%s) Відкрити розташування файлу Пропустити цю версію - Доступна панель чату + Доступні панелі додатка Не можна зателефонувати контакту Підключення до контакту, будь ласка, зачекайте або перевірте пізніше! Дзвінки заборонені! @@ -2129,10 +2129,10 @@ Щоб захиститися від заміни вашого посилання, ви можете порівняти коди безпеки контактів. Для соціальних мереж Або поділитися приватно - Обирайте операторів + Оператори серверів Мережеві оператори Умови будуть прийняті для ввімкнених операторів через 30 днів. - Наприклад, якщо ви отримуєте повідомлення через сервер SimpleX Chat, програма використовуватиме один із серверів Flux для приватної маршрутизації. + Наприклад, якщо ваш контакт отримує повідомлення через сервер SimpleX Chat, ваш додаток доставлятиме їх через сервер Flux. Виберіть мережевих операторів для використання. Ви можете налаштувати сервери за допомогою налаштувань. Перегляньте пізніше @@ -2145,7 +2145,7 @@ Ваші сервери Використовуйте %s Використовуйте сервери - %s.]]> + %s.]]> %s.]]> Прийняти умови Умови перегляду @@ -2177,7 +2177,7 @@ %s.]]> %s.]]> %s.]]> - %s.]]> + %s.]]> %s.]]> %s, прийміть умови використання.]]> Текст поточних умов не вдалося завантажити, ви можете переглянути умови за цим посиланням: @@ -2203,9 +2203,48 @@ SimpleX-адреси та одноразові посилання можна безпечно ділитися через будь-який месенджер. З\'єднання досягло ліміту недоставлених повідомлень, ваш контакт може бути офлайн. Натисніть Створити адресу SimpleX у меню, щоб створити її пізніше. - Якщо увімкнено більше одного оператора, програма використовуватиме сервери різних операторів для кожної розмови. + Додаток захищає вашу конфіденційність, використовуючи різних операторів у кожній розмові. Використовуйте для повідомлень Ви можете налаштувати операторів у налаштуваннях Мережі та серверів. Або імпортуйте архівний файл Віддалені мобільні + Пристрої Xiaomi: будь ласка, увімкніть Автозапуск у налаштуваннях системи, щоб сповіщення працювали.]]> + Повідомлення занадто велике! + Будь ласка, зменшіть розмір повідомлення або видаліть медіа та надішліть знову. + Додайте учасників команди до розмов. + Бізнес адреса + Перевіряти повідомлення кожні 10 хвилин. + Без фонової служби + Сповіщення та батарея + Додаток завжди працює у фоні. + зашифрованими end-to-end, з пост-квантовою безпекою в особистих повідомленнях.]]> + Покинути чат? + Учасник буде видалений з чату — це неможливо скасувати! + Бізнес чати + Конфіденційність для ваших клієнтів. + Доступна панель чату + Додати друзів + Додати учасників команди + Запросити до чату + Чат буде видалений для всіх учасників — це неможливо скасувати! + Видалити чат + Видалити чат? + Тільки власники чату можуть змінювати налаштування. + Роль буде змінена на %s. Усі учасники чату отримають повідомлення. + Прямі повідомлення між учасниками заборонені. + %1$s.]]> + Чат вже існує! + Як це допомагає зберігати конфіденційність + Прямі повідомлення між учасниками заборонені в цьому чаті. + Покинути чат + Чат + Чат буде видалений для вас — це неможливо скасувати! + Будь ласка, зменшіть розмір повідомлення та надішліть знову. + Скопіюйте та зменшіть розмір повідомлення для відправки. + Ви припините отримувати повідомлення з цього чату. Історія чату буде збережена. + Ваш профіль чату буде надіслано учасникам чату. + Коли увімкнено більше ніж одного оператора, жоден з них не має метаданих, щоб дізнатися, хто спілкується з ким. + прийнято запрошення + запит на підключення + Про операторів \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/zh-rCN/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/zh-rCN/strings.xml index ca42ccc902..0477307343 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/zh-rCN/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/zh-rCN/strings.xml @@ -2157,8 +2157,8 @@ 应用中的第二个预设运营者！ 改进了聊天导航 查看更新后的条款 - 比如，如果你通过 SimpleX 服务器收到消息，应用会使用 Flux 服务器中的一台进行私密路由。 - 启用了多于一个网络运营者时，应用会为每个对话使用不同运营者的服务器。 + 比如，如果你通过 SimpleX 服务器收到消息，应用会通过 Flux 服务器传送它们。 + 应用通过在每个对话中使用不同运营者保护你的隐私。 接受条款 模糊 地址或一次性链接？ @@ -2229,4 +2229,8 @@ 聊天 将从聊天中删除成员 - 此操作无法撤销！ 请减小消息尺寸并再次发送。 + 当启用了超过一个运营者时，没有一个运营者拥有了解谁和谁联络的元数据。 + 已接受邀请 + 被请求连接 + 关于运营者 \ No newline at end of file diff --git a/apps/multiplatform/common/src/commonMain/resources/assets/www/android/style.css b/apps/multiplatform/common/src/commonMain/resources/assets/www/android/style.css index a9d1c3785a..377458c184 100644 --- a/apps/multiplatform/common/src/commonMain/resources/assets/www/android/style.css +++ b/apps/multiplatform/common/src/commonMain/resources/assets/www/android/style.css @@ -12,26 +12,60 @@ body { object-fit: cover; } -#remote-video-stream.collapsed { - position: absolute; - max-width: 30%; - max-height: 30%; - object-fit: cover; - margin: 16px; - border-radius: 16px; - bottom: 80px; - right: 0; +@media (orientation: portrait) { + #remote-video-stream.collapsed { + position: absolute; + width: 30%; + max-width: 30%; + height: 39.9vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + bottom: 80px; + right: 0; + } } -#remote-video-stream.collapsed-pip { - position: absolute; - max-width: 50%; - max-height: 50%; - object-fit: cover; - margin: 8px; - border-radius: 8px; - bottom: 0; - right: 0; +@media (orientation: landscape) { + #remote-video-stream.collapsed { + position: absolute; + width: 20%; + max-width: 20%; + height: 15.03vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + bottom: 80px; + right: 0; + } +} + +@media (orientation: portrait) { + #remote-video-stream.collapsed-pip { + position: absolute; + width: 50%; + max-width: 50%; + height: 66.5vw; + object-fit: cover; + margin: 8px; + border-radius: 8px; + bottom: 0; + right: 0; + } +} + +@media (orientation: landscape) { + #remote-video-stream.collapsed-pip { + position: absolute; + width: 50%; + max-width: 50%; + height: 37.59vw; + object-fit: cover; + margin: 8px; + border-radius: 8px; + bottom: 0; + right: 0; + } } #remote-screen-video-stream.inline { @@ -41,15 +75,32 @@ body { object-fit: cover; } -#local-video-stream.inline { - position: absolute; - width: 30%; - max-width: 30%; - object-fit: cover; - margin: 16px; - border-radius: 16px; - top: 0; - right: 0; +@media (orientation: portrait) { + #local-video-stream.inline { + position: absolute; + width: 30%; + max-width: 30%; + height: 39.9vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + top: 0; + right: 0; + } +} + +@media (orientation: landscape) { + #local-video-stream.inline { + position: absolute; + width: 20%; + max-width: 20%; + height: 15.03vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + top: 0; + right: 0; + } } #local-screen-video-stream.inline { diff --git a/apps/multiplatform/common/src/commonMain/resources/assets/www/call.js b/apps/multiplatform/common/src/commonMain/resources/assets/www/call.js index 4dae487d03..7ab8d6fdd6 100644 --- a/apps/multiplatform/common/src/commonMain/resources/assets/www/call.js +++ b/apps/multiplatform/common/src/commonMain/resources/assets/www/call.js @@ -301,6 +301,7 @@ const processCommand = (function () { localStream = await getLocalMediaStream(true, command.media == CallMediaType.Video && (await browserHasCamera()), VideoCamera.User); const videos = getVideoElements(); if (videos) { + setupLocalVideoRatio(videos.local); videos.local.srcObject = localStream; videos.local.play().catch((e) => console.log(e)); } @@ -330,9 +331,12 @@ const processCommand = (function () { console.log("starting incoming call - create webrtc session"); if (activeCall) endCall(); + // It can be already defined on Android when switching calls (if the previous call was outgoing) + notConnectedCall = undefined; inactiveCallMediaSources.mic = true; inactiveCallMediaSources.camera = command.media == CallMediaType.Video; inactiveCallMediaSourcesChanged(inactiveCallMediaSources); + setupLocalVideoRatio(getVideoElements().local); const { media, iceServers, relay } = command; const encryption = supportsInsertableStreams(useWorker); const aesKey = encryption ? command.aesKey : undefined; @@ -547,13 +551,13 @@ const processCommand = (function () { } function endCall() { var _a; + shutdownCameraAndMic(); try { (_a = activeCall === null || activeCall === void 0 ? void 0 : activeCall.connection) === null || _a === void 0 ? void 0 : _a.close(); } catch (e) { console.log(e); } - shutdownCameraAndMic(); activeCall = undefined; resetVideoElements(); } @@ -642,27 +646,21 @@ const processCommand = (function () { } // Without doing it manually Firefox shows black screen but video can be played in Picture-in-Picture videos.local.play().catch((e) => console.log(e)); - setupLocalVideoRatio(videos.local); } function setupLocalVideoRatio(local) { - const ratio = isDesktop ? 1.33 : 1 / 1.33; - const currentRect = local.getBoundingClientRect(); - // better to get percents from here than to hardcode values from styles (the styles can be changed) - const screenWidth = currentRect.left + currentRect.width; - const percents = currentRect.width / screenWidth; - local.style.width = `${percents * 100}%`; - local.style.height = `${(percents / ratio) * 100}vw`; local.addEventListener("loadedmetadata", function () { console.log("Local video videoWidth: " + local.videoWidth + "px, videoHeight: " + local.videoHeight + "px"); if (local.videoWidth == 0 || local.videoHeight == 0) return; - local.style.height = `${(percents / (local.videoWidth / local.videoHeight)) * 100}vw`; + const ratio = local.videoWidth > local.videoHeight ? 0.2 : 0.3; + local.style.height = `${(ratio / (local.videoWidth / local.videoHeight)) * 100}vw`; }); local.onresize = function () { console.log("Local video size changed to " + local.videoWidth + "x" + local.videoHeight); if (local.videoWidth == 0 || local.videoHeight == 0) return; - local.style.height = `${(percents / (local.videoWidth / local.videoHeight)) * 100}vw`; + const ratio = local.videoWidth > local.videoHeight ? 0.2 : 0.3; + local.style.height = `${(ratio / (local.videoWidth / local.videoHeight)) * 100}vw`; }; } function setupEncryptionForLocalStream(call) { @@ -1128,8 +1126,9 @@ const processCommand = (function () { (!!useWorker && "RTCRtpScriptTransform" in window)); } function shutdownCameraAndMic() { - if (activeCall === null || activeCall === void 0 ? void 0 : activeCall.localStream) { + if (activeCall) { activeCall.localStream.getTracks().forEach((track) => track.stop()); + activeCall.localScreenStream.getTracks().forEach((track) => track.stop()); } } function resetVideoElements() { @@ -1295,6 +1294,9 @@ function changeLayout(layout) { break; } videos.localScreen.style.visibility = localSources.screenVideo ? "visible" : "hidden"; + if (!isDesktop && !localSources.camera) { + resetLocalVideoElementHeight(videos.local); + } } function getVideoElements() { const local = document.getElementById("local-video-stream"); @@ -1312,6 +1314,11 @@ function getVideoElements() { return; return { local, localScreen, remote, remoteScreen }; } +// Allow CSS to figure out the size of view by itself on Android because rotating to different orientation +// without dropping override will cause the view to have not normal proportion while no video is present +function resetLocalVideoElementHeight(local) { + local.style.height = ""; +} function desktopShowPermissionsAlert(mediaType) { if (!isDesktop) return; diff --git a/apps/multiplatform/common/src/commonMain/resources/assets/www/desktop/style.css b/apps/multiplatform/common/src/commonMain/resources/assets/www/desktop/style.css index 99050bc94f..5110c7c7d6 100644 --- a/apps/multiplatform/common/src/commonMain/resources/assets/www/desktop/style.css +++ b/apps/multiplatform/common/src/commonMain/resources/assets/www/desktop/style.css @@ -15,8 +15,9 @@ body { #remote-video-stream.collapsed { position: absolute; + width: 20%; max-width: 20%; - max-height: 20%; + height: 15.03vw; object-fit: cover; margin: 16px; border-radius: 16px; @@ -47,6 +48,7 @@ body { position: absolute; width: 20%; max-width: 20%; + height: 15.03vw; object-fit: cover; margin: 16px; border-radius: 16px; diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt index 3bd1506b4f..ee415ae82b 100644 --- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt +++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/model/NtfManager.desktop.kt @@ -67,7 +67,7 @@ object NtfManager { ntf.second.close() } catch (e: Exception) { // Can be java.lang.UnsupportedOperationException, for example. May do nothing - println("Failed to close notification: ${e.stackTraceToString()}") + Log.e(TAG, "Failed to close notification: ${e.stackTraceToString()}") }*/ } } @@ -85,7 +85,8 @@ object NtfManager { } fun cancelAllNotifications() { -// prevNtfs.forEach { try { it.second.close() } catch (e: Exception) { println("Failed to close notification: ${e.stackTraceToString()}") } } +// prevNtfs.forEach { try { it.second.close() } catch (e: Exception) { Log.e(TAG, "Failed to close notification: ${e + // .stackTraceToString()}") } } withBGApi { prevNtfsMutex.withLock { prevNtfs.clear() @@ -153,7 +154,7 @@ object NtfManager { ImageIO.write(icon.toAwtImage(), "PNG", newFile.outputStream()) newFile.absolutePath } catch (e: Exception) { - println("Failed to write an icon to tmpDir: ${e.stackTraceToString()}") + Log.e(TAG, "Failed to write an icon to tmpDir: ${e.stackTraceToString()}") null } } else null diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Log.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Log.desktop.kt index 395754c51b..2b75a41cd3 100644 --- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Log.desktop.kt +++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/Log.desktop.kt @@ -1,8 +1,10 @@ package chat.simplex.common.platform +import chat.simplex.common.model.ChatController.appPrefs + actual object Log { - actual fun d(tag: String, text: String) = println("D: $text") - actual fun e(tag: String, text: String) = println("E: $text") - actual fun i(tag: String, text: String) = println("I: $text") - actual fun w(tag: String, text: String) = println("W: $text") + actual fun d(tag: String, text: String) { if (appPrefs.logLevel.get() <= LogLevel.DEBUG && appPrefs.developerTools.get()) println("D: $text") } + actual fun e(tag: String, text: String) { if (appPrefs.logLevel.get() <= LogLevel.ERROR || !appPrefs.developerTools.get()) println("E: $text") } + actual fun i(tag: String, text: String) { if (appPrefs.logLevel.get() <= LogLevel.INFO && appPrefs.developerTools.get()) println("I: $text") } + actual fun w(tag: String, text: String) { if (appPrefs.logLevel.get() <= LogLevel.WARNING || !appPrefs.developerTools.get()) println("W: $text") } } diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.desktop.kt new file mode 100644 index 0000000000..eceb7de9be --- /dev/null +++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIFileView.desktop.kt @@ -0,0 +1,18 @@ +package chat.simplex.common.views.chat.item + +import androidx.compose.runtime.Composable +import androidx.compose.runtime.MutableState +import chat.simplex.common.model.CryptoFile +import java.net.URI + +@Composable +actual fun SaveOrOpenFileMenu( + showMenu: MutableState, + encrypted: Boolean, + ext: String?, + encryptedUri: URI, + fileSource: CryptoFile, + saveFile: () -> Unit +) { + +} diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.desktop.kt index 9789fa3d1a..a1f70213d0 100644 --- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.desktop.kt +++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.desktop.kt @@ -4,8 +4,7 @@ import SectionDivider import androidx.compose.foundation.* import androidx.compose.foundation.interaction.InteractionSource import androidx.compose.foundation.layout.* -import androidx.compose.material.Divider -import androidx.compose.material.MaterialTheme +import androidx.compose.material.* import androidx.compose.runtime.* import androidx.compose.ui.Alignment import androidx.compose.ui.Modifier diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/TagListView.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/TagListView.desktop.kt new file mode 100644 index 0000000000..75a76014a9 --- /dev/null +++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chatlist/TagListView.desktop.kt @@ -0,0 +1,72 @@ +package chat.simplex.common.views.chatlist + +import SectionItemView +import androidx.compose.foundation.layout.* +import androidx.compose.foundation.shape.RoundedCornerShape +import androidx.compose.material.* +import androidx.compose.runtime.* +import androidx.compose.ui.Alignment +import androidx.compose.ui.Modifier +import androidx.compose.ui.graphics.Color +import androidx.compose.ui.text.TextRange +import androidx.compose.ui.text.input.TextFieldValue +import androidx.compose.ui.text.style.TextAlign +import androidx.compose.ui.unit.dp +import androidx.compose.ui.unit.sp +import chat.simplex.common.ui.theme.* +import chat.simplex.common.ui.theme.ThemeManager.colorFromReadableHex +import chat.simplex.common.views.chat.item.isHeartEmoji +import chat.simplex.common.views.chat.item.isShortEmoji +import chat.simplex.common.views.helpers.toDp +import chat.simplex.res.MR +import dev.icerock.moko.resources.compose.painterResource + +@Composable +actual fun ChatTagInput(name: MutableState, showError: State, emoji: MutableState) { + SectionItemView(padding = PaddingValues(horizontal = DEFAULT_PADDING)) { + SingleEmojiInput(emoji) + TagListNameTextField(name, showError = showError) + } +} + +@Composable +private fun SingleEmojiInput( + emoji: MutableState +) { + val state = remember { mutableStateOf(TextFieldValue(emoji.value ?: "")) } + val colors = TextFieldDefaults.textFieldColors( + textColor = if (isHeartEmoji(emoji.value ?: "")) Color(0xffD63C31) else MaterialTheme.colors.onPrimary, + backgroundColor = Color.Unspecified, + focusedIndicatorColor = MaterialTheme.colors.secondary.copy(alpha = 0.6f), + unfocusedIndicatorColor = CurrentColors.value.colors.secondary.copy(alpha = 0.3f), + cursorColor = MaterialTheme.colors.secondary, + ) + TextField( + value = state.value, + onValueChange = { newValue -> + if (newValue.text == emoji.value) { + state.value = newValue + return@TextField + } + val newValueClamped = newValue.text.replace(emoji.value ?: "", "") + val isEmoji = isShortEmoji(newValueClamped) + emoji.value = if (isEmoji) newValueClamped else null + state.value = if (isEmoji) newValue else TextFieldValue() + }, + singleLine = true, + modifier = Modifier + .padding(4.dp) + .size(width = TextFieldDefaults.MinHeight.value.sp.toDp(), height = TextFieldDefaults.MinHeight), + textStyle = LocalTextStyle.current.copy(fontFamily = EmojiFont, textAlign = TextAlign.Center), + placeholder = { + Box(Modifier.fillMaxSize(), contentAlignment = Alignment.Center) { + Icon( + painter = painterResource(MR.images.ic_add_reaction), + contentDescription = null, + tint = MaterialTheme.colors.secondary + ) + } + }, + colors = colors, + ) +} diff --git a/apps/multiplatform/gradle.properties b/apps/multiplatform/gradle.properties index e620b4992d..9af367a5f6 100644 --- a/apps/multiplatform/gradle.properties +++ b/apps/multiplatform/gradle.properties @@ -24,11 +24,11 @@ android.nonTransitiveRClass=true kotlin.mpp.androidSourceSetLayoutVersion=2 kotlin.jvm.target=11 -android.version_name=6.2-beta.6 -android.version_code=258 +android.version_name=6.2.3 +android.version_code=265 -desktop.version_name=6.2-beta.6 -desktop.version_code=81 +desktop.version_name=6.2.3 +desktop.version_code=85 kotlin.version=1.9.23 gradle.plugin.version=8.2.0 diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs index 5351565946..fddad1cf2c 100644 --- a/apps/simplex-chat/Server.hs +++ b/apps/simplex-chat/Server.hs @@ -19,9 +19,9 @@ import GHC.Generics (Generic) import Network.Socket import qualified Network.WebSockets as WS import Numeric.Natural (Natural) -import Simplex.Chat import Simplex.Chat.Controller import Simplex.Chat.Core +import Simplex.Chat.Library.Commands import Simplex.Chat.Options import Simplex.Messaging.Transport.Server (runLocalTCPServer) import Simplex.Messaging.Util (raceAny_) diff --git a/blog/20220404-simplex-chat-instant-notifications.md b/blog/20220404-simplex-chat-instant-notifications.md index ce7dfd613c..7d88a47fa7 100644 --- a/blog/20220404-simplex-chat-instant-notifications.md +++ b/blog/20220404-simplex-chat-instant-notifications.md @@ -68,7 +68,7 @@ So, for Android we can now deliver instant message notifications without comprom Please let us know what needs to be improved - it's only the first version of instant notifications for Android! -## Our iOS approach has one trade-off +## iOS notifications require a server iOS is much more protective of what apps are allowed to run on the devices, and the solution that worked on Android is not viable on iOS. diff --git a/blog/20241016-wired-attack-on-privacy.md b/blog/20241016-wired-attack-on-privacy.md index 3bc69c8176..1c2961e98a 100644 --- a/blog/20241016-wired-attack-on-privacy.md +++ b/blog/20241016-wired-attack-on-privacy.md @@ -10,6 +10,8 @@ permalink: "/blog/20241016-wired-attack-on-privacy.html" # Wired’s Attack on Privacy +**Published:** Oct 16, 2024 + The [Wired article](https://www.wired.com/story/neo-nazis-flee-telegram-encrypted-app-simplex/) by David Gilbert focusing on neo-Nazis moving to SimpleX Chat following the Telegram's changes in privacy policy is biased and misleading. By cherry-picking information from [the report](https://www.isdglobal.org/digital_dispatches/neo-nazi-accelerationists-seek-new-digital-refuge-amid-looming-telegram-crackdown/) by the Institute for Strategic Dialogue (ISD), Wired fails to mention that SimpleX network design prioritizes privacy in order to protect human rights defenders, journalists, and everyday users who value their privacy — many people feel safer using SimpleX than non-private apps, being protected from strangers contacting them. diff --git a/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.md b/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.md index 55de82df47..339fab4d16 100644 --- a/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.md +++ b/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.md @@ -1,23 +1,88 @@ --- layout: layouts/article.html -title: "Servers operated by Flux - true privacy and decentralization for all users" +title: "SimpleX network: preset servers operated by Flux, business chats and more with v6.2 of the apps" date: 2024-12-10 -# previewBody: blog_previews/20241210.html -# image: images/simplexonflux.png -# imageWide: true -draft: true +previewBody: blog_previews/20241210.html +image: images/20241210-operators-1.png permalink: "/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.html" --- # SimpleX network: preset servers operated by Flux, business chats and more with v6.2 of the apps -**Will be published:** Dec 10, 2024 +**Published:** Dec 10, 2024 -This is a placeholder page for the upcoming v6.2 release announcement! +What's new in v6.2: -- Preset servers are now operated by two companies - SimpleX Chat and Flux. Read [this post](./20241125-servers-operated-by-flux-true-privacy-and-decentralization-for-all-users.md). -- Business chats to provide support from your business to users of SimpleX network. Read [this page](../docs/BUSINESS.md). -- and more! +- [SimpleX Chat and Flux](#simplex-chat-and-flux-improve-metadata-privacy-in-simplex-network) improve metadata privacy in SimpleX network. +- [Business chats](#business-chats) to provide support from your business to users of SimpleX network. +- [Better user experience](#better-user-experience): open on the first unread, jump to quoted messages, see who reacted. +- [Improving notifications in iOS app](#improving-notifications-in-ios-app). + +## What's new in v6.2 + +### SimpleX Chat and Flux improve metadata privacy in SimpleX network + + + +SimpleX Chat and [Flux](https://runonflux.com) (Influx Technology Limited) made an agreement to include messaging and file servers operated by Flux into the app. + +SimpleX network is decentralized by design, but in the users of the previous app versions had to find other servers online or host servers themselves to use any other servers than operated by us. + +Now all users can choose between servers of two companies, use both of them, and continue using any other servers they host or available online. + +To use Flux servers enable them when the app offers it, or at any point later via Network & servers settings in the app. + +When both SimpleX Chat and Flux servers are enabled, the app will use servers of both operators in each connection to receive messages and for [private message routing](./20240604-simplex-chat-v5.8-private-message-routing-chat-themes.md), increasing metadata privacy for all users. + +Read more about why SimpleX network benefits from multiple operators in [our previous post](./20241125-servers-operated-by-flux-true-privacy-and-decentralization-for-all-users.md). + +You can also read about our plan [how network operators will make money](https://github.com/simplex-chat/simplex-chat/blob/stable/docs/rfcs/2024-04-26-commercial-model.md), while continuing to protect users privacy, based on network design rather than on trust to operators, and without any cryptocurrency emission. + +### Business chats + + + +We use SimpleX Chat to provide support to SimpleX Chat users, and we also see some other companies offering SimpleX Chat as a support channel. + +One of the problem of providing support via general purpose messengers is that the customers don't see who they talk to, as they can in all dedicated support systems. + +It is not possible in most messengers, including SimpleX Chat prior to v6.2 - every new customer joins a one-to-one conversation, where the customers see that they talk to a company, not knowing who they talk to, and if it's a bot or a human. + +The new business chats in SimpleX Chat solve this problem: to use them enable the toggle under the contact address in your chat profile. It is safe to do, and you can always toggle it off, if needed - the address itself does not change. + +Once you do it, the app will be creating a new business chat with each connecting customer where multiple people can participate. Business chat is a hybrid of one-to-one and group conversation. In the list of chats you will see customer names and avatars, and the customer will see your business name and avatar, like with one-to-one conversations. But inside it works as a group, allowing customer to see who sent the message, and allowing you to add other participants from the business side, for delegation and escalation of customer questions. + +This can be done manually, or you can automate these conversations using bots that can answer some customer questions and then add a human to the conversation when appropriate or requested by the customer. We will be offering more bot-related features to the app and a simpler way to program bots very soon - watch our announcements. + +### Better user experience + + + +**Chat navigation** + +This has been a long-standing complaint from the users: *why does the app opens conversations on the last message, and not on the first unread message*? + +Android and desktop apps now open the chat on the first unread message. It will soon be done in the iOS app too. + +Also, the app can scroll to the replied message anywhere in the conversation (when you tap it), even if it was sent a very long time ago. + +**See who reacted!** + +This is a small but important change - you can now see who reacted to your messages! + +### Improving notifications in iOS app + +iOS notifications in a decentralized network is a complex problem. We [support iOS notifications](./20220404-simplex-chat-instant-notifications.md#ios-notifications-require-a-server) from early versions of the app, focussing on preserving privacy as much as possible. But the reliability of notifications was not good enough. + +We solved several problems of notification delivery in this release: +- messaging servers no longer lose notifications while notification servers are restarted. +- Apple can drop notifications while your device is offline - about 15-20% of notifications are dropped because of it. The servers and the new version of the app work around this problem by delivering several last notifications, to show notifications correctly even when Apple drops them. + +With these changes the iOS notifications remained as private and secure as before. The notifications only contain metadata, without the actual messages, and even the metadata is end-to-end encrypted between SimpleX notification servers and the client device, inaccessible to Apple push notification servers. + +There are two remaining problems we will solve soon: +- iOS only allows to use 25mb of device memory when processing notifications in the background. This limit didn't change for many years, and it is challenging for decentralized design. If the app uses more memory, iOS kills it and the notification is not shown – approximately 10% of notifications can be lost because of that. +- for notifications to work, the app communicates with the notification server. If the user puts the app in background too quickly, the app may fail to enable notification for the new contacts. We plan to change clients and servers to delegate this task to messaging servers, to remove the need for this additional communication entirely, without any impact on privacy and security. This will happen early next year. ## SimpleX network diff --git a/blog/20241218-oppose-digital-ids-they-break-law-lead-to-mass-scale-surveillance.md b/blog/20241218-oppose-digital-ids-they-break-law-lead-to-mass-scale-surveillance.md new file mode 100644 index 0000000000..8a8fffffb4 --- /dev/null +++ b/blog/20241218-oppose-digital-ids-they-break-law-lead-to-mass-scale-surveillance.md @@ -0,0 +1,53 @@ +--- +layout: layouts/article.html +title: "Oppose digital IDs – they break the law and lead to mass scale surveillance" +date: 2024-12-18 +preview: Starting next year, the UK government plans to introduce digital ID cards for the young people to prove their age when visiting pubs. +image: images/20241218-pub.jpg +imageWide: true +permalink: "/blog/20241218-oppose-digital-ids-they-break-law-lead-to-mass-scale-surveillance.html" +--- + +# Oppose digital IDs – they break the law and lead to mass scale surveillance + +**Published:** Dec 18, 2024 + + + +Starting next year, the UK government plans to introduce [digital ID cards](https://www.telegraph.co.uk/politics/2024/12/08/digital-id-to-be-introduced-for-pubs-and-clubs/) for the young people to prove their age when visiting pubs. While officials claim this system will remain optional, it's part of a broader government initiative to move more state functions online so that people can prove their identity for everything from paying taxes to opening a bank account using the government-backed app. This will be a step toward a society where every pub visit, purchase, and social interaction becomes a permanent digital record linked to a government-issued ID – a step to normalizing mass surveillance at scale. + +Digital IDs are promoted as a way to fight law violations, and some politicians support them as [a way to tackle illegal immigration](https://www.telegraph.co.uk/politics/2024/07/10/id-cards-inevitable-tackle-immigration-lord-blunkett-labour/). But digital IDs themselves break the law. Article 8 of the European Convention of Human Rights says: “Everyone has the right to respect for his private and family life”. It means that not only our right to privacy is enshrined in the law, but the right to have our privacy respected is also part of the law. Asking to present a digital ID when visiting a pub, even if it is optional, disrespects our privacy, and is therefore illegal. + +Digital IDs would not stop people who decide to break laws. Pubs already can refuse to serve alcohol to young people and require the ID in case the age is in doubt. And illegal immigration can also be reduced without any digital IDs. But introducing digital IDs and collecting our actions, names and locations in one government-controlled database will result in making this information easier to access for criminals, and being exploited for financial and identity crimes. + +What starts as a "convenient option" is likely to end as a mandatory requirement. The digital ID systems being pushed by governments and corporations aren't about making our lives easier. They're about tracking, monitoring, and controlling every move we make. And we can see [where this road leads in China](https://www.wired.com/story/china-social-credit-system-explained/), when IDs and social scores created for convenience are used to prevent access to basic services and bank accounts as a punishment for legal social media posts that the government disagrees with. What started as a convenience, is now trialed [to track the duration of public toilet visits](https://www.thesun.ie/news/13154812/china-installs-toilet-timers-to-broadcast-time-spent/). + +The United Kingdom is a democratic country, and the law protects our right to privacy and freedom of speech. If we accept digital IDs as something required for simple things, like buying a drink, it leaves the door wide open to a range of privacy violations. + +We call on everyone to oppose the digital ID systems. Do not use them. Do not install these systems in your pub, for as long as it is not legally required. Support local businesses that don’t use them. Protect your privacy and freedom by using software that respects them. Demand that your privacy is respected, as required by law. + +To make your voice heard, email your MP expressing your rejection of digital IDs as a violation of European Convention of Human Rights in three simple steps: + +1. **Copy the text below** or [click this link](mailto:?subject=Please%20oppose%20the%20plan%20for%20Digital%20IDs&body=Dear%20%E2%80%A6%2C%0A%0AI%20object%20to%20the%20introduction%20of%20digital%20IDs%20in%20pubs%20or%20any%20other%20public%20places%20for%20these%20reasons%3A%0A%0A1.%20It%20violates%20the%20European%20Convention%20of%20Human%20Rights%2C%20article%208%3A%20%E2%80%9CEveryone%20has%20the%20right%20to%20respect%20for%20his%20private%20and%20family%20life%E2%80%9D%20(https%3A%2F%2Ffra.europa.eu%2Fen%2Flaw-reference%2Feuropean-convention-human-rights-article-8-0).%0AAsking%20to%20present%20digital%20IDs%20when%20proof%20of%20identity%20is%20not%20legally%20required%2C%20even%20if%20it%20is%20optional%2C%20disrespects%20our%20privacy%2C%20and%20is%20therefore%20illegal.%0A%0A2.%20It%20will%20not%20be%20an%20effective%20measure%20in%20reducing%20the%20violations%20of%20the%20law.%20People%20who%20want%20to%20circumvent%20it%2C%20will%20find%20a%20way.%0A%0A3.%20It%20will%20increase%20crime%2C%20because%20combining%20a%20large%20amount%20of%20private%20information%20in%20a%20single%20system%20increases%20the%20risks%20of%20this%20information%20becoming%20available%20to%20criminals%2C%20who%20will%20exploit%20it%20for%20financial%20crimes%20and%20identity%20theft.%0A%0AI%20kindly%20ask%20you%20to%20oppose%20this%20plan%2C%20both%20publicly%20and%20during%20any%20discussions%20in%20the%20UK%20Parliament.%0A%0ASincerely%20yours%2C%0A%E2%80%A6) to copy it into email app: + +*Dear …,* + +*I object to the introduction of digital IDs in pubs or any other public places for these reasons:* + +1. *It violates the European Convention of Human Rights, article 8: “Everyone has the right to respect for his private and family life” (https://fra.europa.eu/en/law-reference/european-convention-human-rights-article-8-0).* +*Asking to present digital IDs when proof of identity is not legally required, even if it is optional, disrespects our privacy, and is therefore illegal.* +2. *It will not be an effective measure in reducing the violations of the law. People who want to circumvent it, will find a way.* +3. *It will increase crime, because combining a large amount of private information in a single system increases the risks of this information becoming available to criminals, who will exploit it for financial crimes and identity theft.* + +*I kindly ask you to oppose this plan, both publicly and during any discussions in the UK Parliament.* + +*Sincerely yours,* +*…* + +2. [**Find the email address of your MP**](https://members.parliament.uk/members/Commons) and copy it to the email. + +3. Fill in the blanks, edit the text if needed, and **send it**! + +Public opposition changed government decisions in many cases. + +It is your opportunity to tell the government which country you want to live in — please use it! diff --git a/blog/README.md b/blog/README.md index 97ccffda9a..1432d95de5 100644 --- a/blog/README.md +++ b/blog/README.md @@ -1,6 +1,15 @@ # Blog -Nov 25, 2025 [Servers operated by Flux - true privacy and decentralization for all users](./20241125-servers-operated-by-flux-true-privacy-and-decentralization-for-all-users.md) +Dec 10, 2024 [SimpleX network: preset servers operated by Flux, business chats and more with v6.2 of the apps](./20241210-simplex-network-v6-2-servers-by-flux-business-chats.md) + +- SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app to improve metadata privacy in SimpleX network. +- Business chats for better privacy and support of your customers. +- Better user experience: open on the first unread, jump to quoted messages, see who reacted. +- Improving notifications in iOS app. + +-- + +Nov 25, 2024 [Servers operated by Flux - true privacy and decentralization for all users](./20241125-servers-operated-by-flux-true-privacy-and-decentralization-for-all-users.md) - Welcome, Flux - the new servers in v6.2-beta.1! - What's the problem? diff --git a/blog/images/20241210-business.png b/blog/images/20241210-business.png new file mode 100644 index 0000000000..407ed66a94 Binary files /dev/null and b/blog/images/20241210-business.png differ diff --git a/blog/images/20241210-operators-1.png b/blog/images/20241210-operators-1.png new file mode 100644 index 0000000000..863bd00822 Binary files /dev/null and b/blog/images/20241210-operators-1.png differ diff --git a/blog/images/20241210-operators-2.png b/blog/images/20241210-operators-2.png new file mode 100644 index 0000000000..85e599c827 Binary files /dev/null and b/blog/images/20241210-operators-2.png differ diff --git a/blog/images/20241210-reactions.png b/blog/images/20241210-reactions.png new file mode 100644 index 0000000000..6de8ba8f07 Binary files /dev/null and b/blog/images/20241210-reactions.png differ diff --git a/blog/images/20241218-pub.jpg b/blog/images/20241218-pub.jpg new file mode 100644 index 0000000000..0acd5d7dc1 Binary files /dev/null and b/blog/images/20241218-pub.jpg differ diff --git a/cabal.project b/cabal.project index ae24afd374..ec29f320d7 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 79e9447b73cc315ce35042b0a5f210c07ea39b07 + tag: bf289023273f2b94f8649b4c641e1cc9996b8a4b source-repository-package type: git diff --git a/package.yaml b/package.yaml index b476741597..57e67c3329 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: simplex-chat -version: 6.2.0.7 +version: 6.2.2.0 #synopsis: #description: homepage: https://github.com/simplex-chat/simplex-chat#readme @@ -10,6 +10,7 @@ copyright: 2020-22 simplex.chat category: Web, System, Services, Cryptography extra-source-files: - README.md + - PRIVACY.md - cabal.project dependencies: diff --git a/packages/simplex-chat-webrtc/src/android/style.css b/packages/simplex-chat-webrtc/src/android/style.css index a9d1c3785a..377458c184 100644 --- a/packages/simplex-chat-webrtc/src/android/style.css +++ b/packages/simplex-chat-webrtc/src/android/style.css @@ -12,26 +12,60 @@ body { object-fit: cover; } -#remote-video-stream.collapsed { - position: absolute; - max-width: 30%; - max-height: 30%; - object-fit: cover; - margin: 16px; - border-radius: 16px; - bottom: 80px; - right: 0; +@media (orientation: portrait) { + #remote-video-stream.collapsed { + position: absolute; + width: 30%; + max-width: 30%; + height: 39.9vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + bottom: 80px; + right: 0; + } } -#remote-video-stream.collapsed-pip { - position: absolute; - max-width: 50%; - max-height: 50%; - object-fit: cover; - margin: 8px; - border-radius: 8px; - bottom: 0; - right: 0; +@media (orientation: landscape) { + #remote-video-stream.collapsed { + position: absolute; + width: 20%; + max-width: 20%; + height: 15.03vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + bottom: 80px; + right: 0; + } +} + +@media (orientation: portrait) { + #remote-video-stream.collapsed-pip { + position: absolute; + width: 50%; + max-width: 50%; + height: 66.5vw; + object-fit: cover; + margin: 8px; + border-radius: 8px; + bottom: 0; + right: 0; + } +} + +@media (orientation: landscape) { + #remote-video-stream.collapsed-pip { + position: absolute; + width: 50%; + max-width: 50%; + height: 37.59vw; + object-fit: cover; + margin: 8px; + border-radius: 8px; + bottom: 0; + right: 0; + } } #remote-screen-video-stream.inline { @@ -41,15 +75,32 @@ body { object-fit: cover; } -#local-video-stream.inline { - position: absolute; - width: 30%; - max-width: 30%; - object-fit: cover; - margin: 16px; - border-radius: 16px; - top: 0; - right: 0; +@media (orientation: portrait) { + #local-video-stream.inline { + position: absolute; + width: 30%; + max-width: 30%; + height: 39.9vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + top: 0; + right: 0; + } +} + +@media (orientation: landscape) { + #local-video-stream.inline { + position: absolute; + width: 20%; + max-width: 20%; + height: 15.03vw; + object-fit: cover; + margin: 16px; + border-radius: 16px; + top: 0; + right: 0; + } } #local-screen-video-stream.inline { diff --git a/packages/simplex-chat-webrtc/src/call.ts b/packages/simplex-chat-webrtc/src/call.ts index 693ad6bbe5..5f3d2bf332 100644 --- a/packages/simplex-chat-webrtc/src/call.ts +++ b/packages/simplex-chat-webrtc/src/call.ts @@ -593,6 +593,7 @@ const processCommand = (function () { ) const videos = getVideoElements() if (videos) { + setupLocalVideoRatio(videos.local) videos.local.srcObject = localStream videos.local.play().catch((e) => console.log(e)) } @@ -621,9 +622,12 @@ const processCommand = (function () { console.log("starting incoming call - create webrtc session") if (activeCall) endCall() + // It can be already defined on Android when switching calls (if the previous call was outgoing) + notConnectedCall = undefined inactiveCallMediaSources.mic = true inactiveCallMediaSources.camera = command.media == CallMediaType.Video inactiveCallMediaSourcesChanged(inactiveCallMediaSources) + setupLocalVideoRatio(getVideoElements()!.local) const {media, iceServers, relay} = command const encryption = supportsInsertableStreams(useWorker) @@ -827,12 +831,12 @@ const processCommand = (function () { } function endCall() { + shutdownCameraAndMic() try { activeCall?.connection?.close() } catch (e) { console.log(e) } - shutdownCameraAndMic() activeCall = undefined resetVideoElements() } @@ -925,28 +929,21 @@ const processCommand = (function () { } // Without doing it manually Firefox shows black screen but video can be played in Picture-in-Picture videos.local.play().catch((e) => console.log(e)) - setupLocalVideoRatio(videos.local) } function setupLocalVideoRatio(local: HTMLVideoElement) { - const ratio = isDesktop ? 1.33 : 1 / 1.33 - const currentRect = local.getBoundingClientRect() - // better to get percents from here than to hardcode values from styles (the styles can be changed) - const screenWidth = currentRect.left + currentRect.width - const percents = currentRect.width / screenWidth - local.style.width = `${percents * 100}%` - local.style.height = `${(percents / ratio) * 100}vw` - local.addEventListener("loadedmetadata", function () { console.log("Local video videoWidth: " + local.videoWidth + "px, videoHeight: " + local.videoHeight + "px") if (local.videoWidth == 0 || local.videoHeight == 0) return - local.style.height = `${(percents / (local.videoWidth / local.videoHeight)) * 100}vw` + const ratio = local.videoWidth > local.videoHeight ? 0.2 : 0.3 + local.style.height = `${(ratio / (local.videoWidth / local.videoHeight)) * 100}vw` }) local.onresize = function () { console.log("Local video size changed to " + local.videoWidth + "x" + local.videoHeight) if (local.videoWidth == 0 || local.videoHeight == 0) return - local.style.height = `${(percents / (local.videoWidth / local.videoHeight)) * 100}vw` + const ratio = local.videoWidth > local.videoHeight ? 0.2 : 0.3 + local.style.height = `${(ratio / (local.videoWidth / local.videoHeight)) * 100}vw` } } @@ -1441,8 +1438,9 @@ const processCommand = (function () { } function shutdownCameraAndMic() { - if (activeCall?.localStream) { + if (activeCall) { activeCall.localStream.getTracks().forEach((track) => track.stop()) + activeCall.localScreenStream.getTracks().forEach((track) => track.stop()) } } @@ -1614,6 +1612,9 @@ function changeLayout(layout: LayoutType) { break } videos.localScreen.style.visibility = localSources.screenVideo ? "visible" : "hidden" + if (!isDesktop && !localSources.camera) { + resetLocalVideoElementHeight(videos.local) + } } function getVideoElements(): VideoElements | undefined { @@ -1637,6 +1638,12 @@ function getVideoElements(): VideoElements | undefined { return {local, localScreen, remote, remoteScreen} } +// Allow CSS to figure out the size of view by itself on Android because rotating to different orientation +// without dropping override will cause the view to have not normal proportion while no video is present +function resetLocalVideoElementHeight(local: HTMLVideoElement) { + local.style.height = "" +} + function desktopShowPermissionsAlert(mediaType: CallMediaType) { if (!isDesktop) return diff --git a/packages/simplex-chat-webrtc/src/desktop/style.css b/packages/simplex-chat-webrtc/src/desktop/style.css index 99050bc94f..5110c7c7d6 100644 --- a/packages/simplex-chat-webrtc/src/desktop/style.css +++ b/packages/simplex-chat-webrtc/src/desktop/style.css @@ -15,8 +15,9 @@ body { #remote-video-stream.collapsed { position: absolute; + width: 20%; max-width: 20%; - max-height: 20%; + height: 15.03vw; object-fit: cover; margin: 16px; border-radius: 16px; @@ -47,6 +48,7 @@ body { position: absolute; width: 20%; max-width: 20%; + height: 15.03vw; object-fit: cover; margin: 16px; border-radius: 16px; diff --git a/scripts/desktop/make-appimage-linux.sh b/scripts/desktop/make-appimage-linux.sh index 5084a0276d..6cc7aac011 100755 --- a/scripts/desktop/make-appimage-linux.sh +++ b/scripts/desktop/make-appimage-linux.sh @@ -40,10 +40,10 @@ if [ ! -f ../appimagetool-x86_64.AppImage ]; then wget --secure-protocol=TLSv1_3 https://github.com/AppImage/appimagetool/releases/download/continuous/appimagetool-x86_64.AppImage -O ../appimagetool-x86_64.AppImage chmod +x ../appimagetool-x86_64.AppImage fi -if [ ! -f ../runtime-fuse3-x86_64 ]; then - wget --secure-protocol=TLSv1_3 https://github.com/AppImage/type2-runtime/releases/download/old/runtime-fuse3-x86_64 -O ../runtime-fuse3-x86_64 - chmod +x ../runtime-fuse3-x86_64 +if [ ! -f ../runtime-x86_64 ]; then + wget --secure-protocol=TLSv1_3 https://github.com/AppImage/type2-runtime/releases/download/continuous/runtime-x86_64 -O ../runtime-x86_64 + chmod +x ../runtime-x86_64 fi -../appimagetool-x86_64.AppImage --runtime-file ../runtime-fuse3-x86_64 . +../appimagetool-x86_64.AppImage --runtime-file ../runtime-x86_64 . mv *imple*.AppImage ../../ diff --git a/scripts/flatpak/chat.simplex.simplex.metainfo.xml b/scripts/flatpak/chat.simplex.simplex.metainfo.xml index bc90e4e041..182976d030 100644 --- a/scripts/flatpak/chat.simplex.simplex.metainfo.xml +++ b/scripts/flatpak/chat.simplex.simplex.metainfo.xml @@ -38,6 +38,55 @@ + + https://simplex.chat/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.html + +

New in v6.2.1-2:

+
    +
  • important fixes
    • +
  • offer to "fix" encryption when calling or making direct connection with member.
    • +
  • broken layout.
    • +
  • option to enable debug logs (disabled by default).
    • +
  • show who reacted in direct chats.
    • +
+

New in v6.2:

+
    +
  • SimpleX Chat and Flux made an agreement to include servers operated by Flux into the app – to improve metadata privacy.
    • +
  • Business chats – your customers privacy.
    • +
  • Improved user experience in chats: open on the first unread, jump to quoted messages, see who reacted.
    • +
+ + + + https://simplex.chat/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.html + +

New in v6.2.1:

+
    +
  • fixes
    • +
  • offer to "fix" encryption when calling or making direct connection with member.
    • +
  • broken layout.
    • +
  • option to enable debug logs (disabled by default).
    • +
  • show who reacted in direct chats.
    • +
+

New in v6.2:

+
    +
  • SimpleX Chat and Flux made an agreement to include servers operated by Flux into the app – to improve metadata privacy.
    • +
  • Business chats – your customers privacy.
    • +
  • Improved user experience in chats: open on the first unread, jump to quoted messages, see who reacted.
    • +
+ + + + https://simplex.chat/blog/20241210-simplex-network-v6-2-servers-by-flux-business-chats.html + +

New in v6.2:

+
    +
  • SimpleX Chat and Flux made an agreement to include servers operated by Flux into the app – to improve metadata privacy.
    • +
  • Business chats – your customers privacy.
    • +
  • Improved user experience in chats: open on the first unread, jump to quoted messages, see who reacted.
    • +
+ + https://simplex.chat/blog/20241014-simplex-network-v6-1-security-review-better-calls-user-experience.html diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index d0411c584d..d1d3071b63 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."79e9447b73cc315ce35042b0a5f210c07ea39b07" = "16z7z5a3f7gw0h188manykp008d1bqpydlrj7h497mgyjmp4cy9m"; + "https://github.com/simplex-chat/simplexmq.git"."bf289023273f2b94f8649b4c641e1cc9996b8a4b" = "1qcyh8n3mws2vbnjw44ih2ji6s9p1dy5rmhs49zf3ia7llnsqzdl"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 29e748c4e8..feabf61bc8 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: simplex-chat -version: 6.2.0.7 +version: 6.2.2.0 category: Web, System, Services, Cryptography homepage: https://github.com/simplex-chat/simplex-chat#readme author: simplex.chat @@ -16,6 +16,7 @@ license-file: LICENSE build-type: Simple extra-source-files: README.md + PRIVACY.md cabal.project flag swift @@ -35,6 +36,9 @@ library Simplex.Chat.Core Simplex.Chat.Files Simplex.Chat.Help + Simplex.Chat.Library.Commands + Simplex.Chat.Library.Internal + Simplex.Chat.Library.Subscriber Simplex.Chat.Markdown Simplex.Chat.Messages Simplex.Chat.Messages.Batch @@ -155,6 +159,8 @@ library Simplex.Chat.Migrations.M20241125_indexes Simplex.Chat.Migrations.M20241128_business_chats Simplex.Chat.Migrations.M20241205_business_chat_members + Simplex.Chat.Migrations.M20241222_operator_conditions + Simplex.Chat.Migrations.M20241223_chat_tags Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index d5ad68079f..69bdddd220 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1,11 +1,9 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} @@ -13,132 +11,47 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat where -import Control.Applicative (optional, (<|>)) -import Control.Concurrent.STM (retry) import Control.Logger.Simple import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift -import Control.Monad.Reader -import Crypto.Random (ChaChaDRG) -import qualified Data.Aeson as J -import Data.Attoparsec.ByteString.Char8 (Parser) -import qualified Data.Attoparsec.ByteString.Char8 as A -import Data.Bifunctor (bimap, first, second) +import Data.Bifunctor (bimap, second) import Data.ByteArray (ScrubbedBytes) -import qualified Data.ByteArray as BA -import qualified Data.ByteString.Base64 as B64 -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Char8 as LB -import Data.Char -import Data.Constraint (Dict (..)) -import Data.Either (fromRight, lefts, partitionEithers, rights) -import Data.Fixed (div') -import Data.Foldable (foldr') -import Data.Functor (($>)) -import Data.Functor.Identity -import Data.Int (Int64) -import Data.List (find, foldl', isSuffixOf, mapAccumL, partition, sortOn, zipWith4) -import Data.List.NonEmpty (NonEmpty (..), (<|)) +import Data.List (partition, sortOn) +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L -import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) -import qualified Data.Set as S +import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (decodeLatin1, encodeUtf8) -import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime) -import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds) -import Data.Type.Equality -import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as V4 -import Data.Word (Word32) -import qualified Database.SQLite.Simple as SQL -import Simplex.Chat.Archive -import Simplex.Chat.Call +import Data.Time.Clock (getCurrentTime) import Simplex.Chat.Controller -import Simplex.Chat.Files -import Simplex.Chat.Markdown -import Simplex.Chat.Messages -import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages) -import Simplex.Chat.Messages.CIContent -import Simplex.Chat.Messages.CIContent.Events +import Simplex.Chat.Library.Commands import Simplex.Chat.Operators import Simplex.Chat.Options -import Simplex.Chat.ProfileGenerator (generateRandomProfile) import Simplex.Chat.Protocol -import Simplex.Chat.Remote -import Simplex.Chat.Remote.Types -import Simplex.Chat.Stats import Simplex.Chat.Store -import Simplex.Chat.Store.AppSettings -import Simplex.Chat.Store.Connections -import Simplex.Chat.Store.Direct -import Simplex.Chat.Store.Files -import Simplex.Chat.Store.Groups -import Simplex.Chat.Store.Messages -import Simplex.Chat.Store.NoteFolders import Simplex.Chat.Store.Profiles -import Simplex.Chat.Store.Shared import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared import Simplex.Chat.Util (encryptFile, liftIOEither, shuffle) import qualified Simplex.Chat.Util as U -import Simplex.FileTransfer.Client.Main (maxFileSize, maxFileSizeHard) +import Simplex.FileTransfer.Description (maxFileSize, maxFileSizeHard) import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) -import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription) -import qualified Simplex.FileTransfer.Description as FD -import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI) -import qualified Simplex.FileTransfer.Transport as XFTP -import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId) import Simplex.Messaging.Agent as Agent -import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getFastNetworkConfig, ipAddressProtected, withLockMap) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), ServerRoles (..), allRoles, createAgentStore, defaultAgentConfig, presetServerCfg) -import Simplex.Messaging.Agent.Lock (withLock) import Simplex.Messaging.Agent.Protocol -import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..)) -import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, SQLiteStore (dbNew), execSQL, upMigration, withConnection) -import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) +import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, SQLiteStore (dbNew)) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations -import Simplex.Messaging.Client (NetworkConfig (..), ProxyClientError (..), SocksMode (SMAlways), defaultNetworkConfig, textToHostMode) +import Simplex.Messaging.Client (defaultNetworkConfig) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) -import qualified Simplex.Messaging.Crypto.File as CF -import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) -import qualified Simplex.Messaging.Crypto.Ratchet as CR -import Simplex.Messaging.Encoding -import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (base64P) -import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol) -import qualified Simplex.Messaging.Protocol as SMP -import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) +import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolType (..), SProtocolType (..), SubscriptionMode (..), UserProtocol) import qualified Simplex.Messaging.TMap as TM -import Simplex.Messaging.Transport (TransportError (..)) -import Simplex.Messaging.Transport.Client (defaultSocksProxyWithAuth) -import Simplex.Messaging.Util -import Simplex.Messaging.Version -import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..)) -import Simplex.RemoteControl.Types (RCCtrlAddress (..)) -import System.Exit (ExitCode, exitSuccess) -import System.FilePath (takeFileName, ()) -import qualified System.FilePath as FP -import System.IO (Handle, IOMode (..), SeekMode (..), hFlush) -import System.Random (randomRIO) -import Text.Read (readMaybe) -import UnliftIO.Async -import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay) -import UnliftIO.Directory import qualified UnliftIO.Exception as E -import UnliftIO.IO (hClose, hSeek, hTell, openFile) import UnliftIO.STM operatorSimpleXChat :: NewServerOperator @@ -270,28 +183,6 @@ fluxXFTPServers = "xftp://0AznwoyfX8Od9T_acp1QeeKtxUi676IBIiQjXVwbdyU=@xftp6.simplexonflux.com,upvzf23ou6nrmaf3qgnhd6cn3d74tvivlmz3p7wdfwq6fhthjrjiiqid.onion" ] -_defaultNtfServers :: [NtfServer] -_defaultNtfServers = - [ "ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,5ex3mupcazy3zlky64ab27phjhijpemsiby33qzq3pliejipbtx5xgad.onion" - -- "ntf://KmpZNNXiVZJx_G2T7jRUmDFxWXM3OAnunz3uLT0tqAA=@ntf3.simplex.im,pxculznuryunjdvtvh6s6szmanyadumpbmvevgdpe4wk5c65unyt4yid.onion", - -- "ntf://CJ5o7X6fCxj2FFYRU2KuCo70y4jSqz7td2HYhLnXWbU=@ntf4.simplex.im,wtvuhdj26jwprmomnyfu5wfuq2hjkzfcc72u44vi6gdhrwxldt6xauad.onion" - ] - -maxImageSize :: Integer -maxImageSize = 261120 * 2 -- auto-receive on mobiles - -imageExtensions :: [String] -imageExtensions = [".jpg", ".jpeg", ".png", ".gif"] - -maxMsgReactions :: Int -maxMsgReactions = 3 - -fixedImagePreview :: ImageData -fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg==" - -smallGroupsRcptsMemLimit :: Int -smallGroupsRcptsMemLimit = 20 - logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} @@ -443,62 +334,6 @@ newChatController let auId = aUserId user' pure $ bimap (auId,) (auId,) $ useServers as opDomains uss' -updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig -updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} = - let cfg1 = maybe cfg (\smpProxyMode -> cfg {smpProxyMode}) smpProxyMode_ - cfg2 = maybe cfg1 (\smpProxyFallback -> cfg1 {smpProxyFallback}) smpProxyFallback_ - cfg3 = maybe cfg2 (\tcpTimeout -> cfg2 {tcpTimeout, tcpConnectTimeout = (tcpTimeout * 3) `div` 2}) tcpTimeout_ - in cfg3 {socksProxy, socksMode, hostMode, requiredHostMode, smpWebPort, logTLSErrors} - -withChatLock :: String -> CM a -> CM a -withChatLock name action = asks chatLock >>= \l -> withLock l name action - -withEntityLock :: String -> ChatLockEntity -> CM a -> CM a -withEntityLock name entity action = do - chatLock <- asks chatLock - ls <- asks entityLocks - atomically $ unlessM (isEmptyTMVar chatLock) retry - withLockMap ls entity name action - -withInvitationLock :: String -> ByteString -> CM a -> CM a -withInvitationLock name = withEntityLock name . CLInvitation -{-# INLINE withInvitationLock #-} - -withConnectionLock :: String -> Int64 -> CM a -> CM a -withConnectionLock name = withEntityLock name . CLConnection -{-# INLINE withConnectionLock #-} - -withContactLock :: String -> ContactId -> CM a -> CM a -withContactLock name = withEntityLock name . CLContact -{-# INLINE withContactLock #-} - -withGroupLock :: String -> GroupId -> CM a -> CM a -withGroupLock name = withEntityLock name . CLGroup -{-# INLINE withGroupLock #-} - -withUserContactLock :: String -> Int64 -> CM a -> CM a -withUserContactLock name = withEntityLock name . CLUserContact -{-# INLINE withUserContactLock #-} - -withFileLock :: String -> Int64 -> CM a -> CM a -withFileLock name = withEntityLock name . CLFile -{-# INLINE withFileLock #-} - -useServers :: Foldable f => RandomAgentServers -> [(Text, ServerOperator)] -> f UserOperatorServers -> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)) -useServers as opDomains uss = - let smp' = useServerCfgs SPSMP as opDomains $ concatMap (servers' SPSMP) uss - xftp' = useServerCfgs SPXFTP as opDomains $ concatMap (servers' SPXFTP) uss - in (smp', xftp') - -useServerCfgs :: forall p. UserProtocol p => SProtocolType p -> RandomAgentServers -> [(Text, ServerOperator)] -> [UserServer p] -> NonEmpty (ServerCfg p) -useServerCfgs p RandomAgentServers {smpServers, xftpServers} opDomains = - fromMaybe (rndAgentServers p) . L.nonEmpty . agentServerCfgs p opDomains - where - rndAgentServers :: SProtocolType p -> NonEmpty (ServerCfg p) - rndAgentServers = \case - SPSMP -> smpServers - SPXFTP -> xftpServers - chooseRandomServers :: PresetServers -> IO (NonEmpty PresetOperator) chooseRandomServers PresetServers {operators} = forM operators $ \op -> do @@ -525,8383 +360,3 @@ toJustOrError name = \case Nothing -> do putStrLn $ name <> ": expected Just, exiting" E.throwIO $ userError name - --- enableSndFiles has no effect when mainApp is True -startChatController :: Bool -> Bool -> CM' (Async ()) -startChatController mainApp enableSndFiles = do - asks smpAgent >>= liftIO . resumeAgentClient - unless mainApp $ chatWriteVar' subscriptionMode SMOnlyCreate - users <- fromRight [] <$> runExceptT (withFastStore' getUsers) - restoreCalls - s <- asks agentAsync - readTVarIO s >>= maybe (start s users) (pure . fst) - where - start s users = do - a1 <- async agentSubscriber - a2 <- - if mainApp - then Just <$> async (subscribeUsers False users) - else pure Nothing - atomically . writeTVar s $ Just (a1, a2) - if mainApp - then do - startXFTP xftpStartWorkers - void $ forkIO $ startFilesToReceive users - startCleanupManager - void $ forkIO $ startExpireCIs users - else when enableSndFiles $ startXFTP xftpStartSndWorkers - pure a1 - startXFTP startWorkers = do - tmp <- readTVarIO =<< asks tempDirectory - runExceptT (withAgent $ \a -> startWorkers a tmp) >>= \case - Left e -> liftIO $ putStrLn $ "Error starting XFTP workers: " <> show e - Right _ -> pure () - startCleanupManager = do - cleanupAsync <- asks cleanupManagerAsync - readTVarIO cleanupAsync >>= \case - Nothing -> do - a <- Just <$> async (void $ runExceptT cleanupManager) - atomically $ writeTVar cleanupAsync a - _ -> pure () - startExpireCIs users = - forM_ users $ \user -> do - ttl <- fromRight Nothing <$> runExceptT (withStore' (`getChatItemTTL` user)) - forM_ ttl $ \_ -> do - startExpireCIThread user - setExpireCIFlag user True - -subscribeUsers :: Bool -> [User] -> CM' () -subscribeUsers onlyNeeded users = do - let (us, us') = partition activeUser users - vr <- chatVersionRange' - subscribe vr us - subscribe vr us' - where - subscribe :: VersionRangeChat -> [User] -> CM' () - subscribe vr = mapM_ $ runExceptT . subscribeUserConnections vr onlyNeeded Agent.subscribeConnections - -startFilesToReceive :: [User] -> CM' () -startFilesToReceive users = do - let (us, us') = partition activeUser users - startReceive us - startReceive us' - where - startReceive :: [User] -> CM' () - startReceive = mapM_ $ runExceptT . startReceiveUserFiles - -startReceiveUserFiles :: User -> CM () -startReceiveUserFiles user = do - filesToReceive <- withStore' (`getRcvFilesToReceive` user) - forM_ filesToReceive $ \ft -> - flip catchChatError (toView . CRChatError (Just user)) $ - toView =<< receiveFile' user ft False Nothing Nothing - -restoreCalls :: CM' () -restoreCalls = do - savedCalls <- fromRight [] <$> runExceptT (withFastStore' getCalls) - let callsMap = M.fromList $ map (\call@Call {contactId} -> (contactId, call)) savedCalls - calls <- asks currentCalls - atomically $ writeTVar calls callsMap - -stopChatController :: ChatController -> IO () -stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do - readTVarIO remoteHostSessions >>= mapM_ (cancelRemoteHost False . snd) - atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (cancelRemoteCtrl False . snd) - disconnectAgentClient smpAgent - readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2) - closeFiles sndFiles - closeFiles rcvFiles - atomically $ do - keys <- M.keys <$> readTVar expireCIFlags - forM_ keys $ \k -> TM.insert k False expireCIFlags - writeTVar s Nothing - where - closeFiles :: TVar (Map Int64 Handle) -> IO () - closeFiles files = do - fs <- readTVarIO files - mapM_ hClose fs - atomically $ writeTVar files M.empty - -execChatCommand :: Maybe RemoteHostId -> ByteString -> CM' ChatResponse -execChatCommand rh s = do - u <- readTVarIO =<< asks currentUser - case parseChatCommand s of - Left e -> pure $ chatCmdError u e - Right cmd -> case rh of - Just rhId - | allowRemoteCommand cmd -> execRemoteCommand u rhId cmd s - | otherwise -> pure $ CRChatCmdError u $ ChatErrorRemoteHost (RHId rhId) $ RHELocalCommand - _ -> do - cc@ChatController {config = ChatConfig {chatHooks}} <- ask - liftIO (preCmdHook chatHooks cc cmd) >>= either pure (execChatCommand_ u) - -execChatCommand' :: ChatCommand -> CM' ChatResponse -execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd) - -execChatCommand_ :: Maybe User -> ChatCommand -> CM' ChatResponse -execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd - -execRemoteCommand :: Maybe User -> RemoteHostId -> ChatCommand -> ByteString -> CM' ChatResponse -execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostClient rhId >>= \rh -> processRemoteCommand rhId rh cmd s - -handleCommandError :: Maybe User -> CM ChatResponse -> CM' ChatResponse -handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catches` ioErrors) - where - ioErrors = - [ E.Handler $ \(e :: ExitCode) -> E.throwIO e, - E.Handler $ pure . Left . mkChatError - ] - -parseChatCommand :: ByteString -> Either String ChatCommand -parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace - --- | Chat API commands interpreted in context of a local zone -processChatCommand :: ChatCommand -> CM ChatResponse -processChatCommand cmd = - chatVersionRange >>= (`processChatCommand'` cmd) -{-# INLINE processChatCommand #-} - -processChatCommand' :: VersionRangeChat -> ChatCommand -> CM ChatResponse -processChatCommand' vr = \case - ShowActiveUser -> withUser' $ pure . CRActiveUser - CreateActiveUser NewUser {profile, pastTimestamp} -> do - forM_ profile $ \Profile {displayName} -> checkValidName displayName - p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile - u <- asks currentUser - users <- withFastStore' getUsers - forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} -> - when (n == displayName) . throwChatError $ - if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""} - (uss, (smp', xftp')) <- chooseServers =<< readTVarIO u - auId <- withAgent $ \a -> createUser a smp' xftp' - ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure - user <- withFastStore $ \db -> do - user <- createUserRecordAt db (AgentUserId auId) p True ts - mapM_ (setUserServers db user ts) uss - createPresetContactCards db user `catchStoreError` \_ -> pure () - createNoteFolder db user - pure user - atomically . writeTVar u $ Just user - pure $ CRActiveUser user - where - createPresetContactCards :: DB.Connection -> User -> ExceptT StoreError IO () - createPresetContactCards db user = do - createContact db user simplexStatusContactProfile - createContact db user simplexTeamContactProfile - chooseServers :: Maybe User -> CM ([UpdatedUserOperatorServers], (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))) - chooseServers user_ = do - as <- asks randomAgentServers - mapM (withFastStore . flip getUserServers >=> liftIO . groupByOperator) user_ >>= \case - Just uss -> do - let opDomains = operatorDomains $ mapMaybe operator' uss - uss' = map copyServers uss - pure $ (uss',) $ useServers as opDomains uss - Nothing -> do - ps <- asks randomPresetServers - uss <- presetUserServers <$> withFastStore' (\db -> getUpdateServerOperators db ps True) - let RandomAgentServers {smpServers = smp', xftpServers = xftp'} = as - pure (uss, (smp', xftp')) - copyServers :: UserOperatorServers -> UpdatedUserOperatorServers - copyServers UserOperatorServers {operator, smpServers, xftpServers} = - let new srv = AUS SDBNew srv {serverId = DBNewEntity} - in UpdatedUserOperatorServers {operator, smpServers = map new smpServers, xftpServers = map new xftpServers} - coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day) - day = 86400 - ListUsers -> CRUsersList <$> withFastStore' getUsersInfo - APISetActiveUser userId' viewPwd_ -> do - unlessM (lift chatStarted) $ throwChatError CEChatNotStarted - user_ <- chatReadVar currentUser - user' <- privateGetUser userId' - validateUserPassword_ user_ user' viewPwd_ - user'' <- withFastStore' (`setActiveUser` user') - chatWriteVar currentUser $ Just user'' - pure $ CRActiveUser user'' - SetActiveUser uName viewPwd_ -> do - tryChatError (withFastStore (`getUserIdByName` uName)) >>= \case - Left _ -> throwChatError CEUserUnknown - Right userId -> processChatCommand $ APISetActiveUser userId viewPwd_ - SetAllContactReceipts onOff -> withUser $ \_ -> withFastStore' (`updateAllContactReceipts` onOff) >> ok_ - APISetUserContactReceipts userId' settings -> withUser $ \user -> do - user' <- privateGetUser userId' - validateUserPassword user user' Nothing - withFastStore' $ \db -> updateUserContactReceipts db user' settings - ok user - SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserContactReceipts userId settings - APISetUserGroupReceipts userId' settings -> withUser $ \user -> do - user' <- privateGetUser userId' - validateUserPassword user user' Nothing - withFastStore' $ \db -> updateUserGroupReceipts db user' settings - ok user - SetUserGroupReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserGroupReceipts userId settings - APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do - user' <- privateGetUser userId' - case viewPwdHash user' of - Just _ -> throwChatError $ CEUserAlreadyHidden userId' - _ -> do - when (T.null viewPwd) $ throwChatError $ CEEmptyUserPassword userId' - users <- withFastStore' getUsers - unless (length (filter (isNothing . viewPwdHash) users) > 1) $ throwChatError $ CECantHideLastUser userId' - viewPwdHash' <- hashPassword - setUserPrivacy user user' {viewPwdHash = viewPwdHash', showNtfs = False} - where - hashPassword = do - salt <- drgRandomBytes 16 - let hash = B64UrlByteString $ C.sha512Hash $ encodeUtf8 viewPwd <> salt - pure $ Just UserPwdHash {hash, salt = B64UrlByteString salt} - APIUnhideUser userId' viewPwd@(UserPwd pwd) -> withUser $ \user -> do - user' <- privateGetUser userId' - case viewPwdHash user' of - Nothing -> throwChatError $ CEUserNotHidden userId' - _ -> do - when (T.null pwd) $ throwChatError $ CEEmptyUserPassword userId' - validateUserPassword user user' $ Just viewPwd - setUserPrivacy user user' {viewPwdHash = Nothing, showNtfs = True} - APIMuteUser userId' -> setUserNotifications userId' False - APIUnmuteUser userId' -> setUserNotifications userId' True - HideUser viewPwd -> withUser $ \User {userId} -> processChatCommand $ APIHideUser userId viewPwd - UnhideUser viewPwd -> withUser $ \User {userId} -> processChatCommand $ APIUnhideUser userId viewPwd - MuteUser -> withUser $ \User {userId} -> processChatCommand $ APIMuteUser userId - UnmuteUser -> withUser $ \User {userId} -> processChatCommand $ APIUnmuteUser userId - APIDeleteUser userId' delSMPQueues viewPwd_ -> withUser $ \user -> do - user' <- privateGetUser userId' - validateUserPassword user user' viewPwd_ - checkDeleteChatUser user' - withChatLock "deleteUser" . procCmd $ deleteChatUser user' delSMPQueues - DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_ - StartChat {mainApp, enableSndFiles} -> withUser' $ \_ -> - asks agentAsync >>= readTVarIO >>= \case - Just _ -> pure CRChatRunning - _ -> checkStoreNotChanged . lift $ startChatController mainApp enableSndFiles $> CRChatStarted - CheckChatRunning -> maybe CRChatStopped (const CRChatRunning) <$> chatReadVar agentAsync - APIStopChat -> do - ask >>= liftIO . stopChatController - pure CRChatStopped - APIActivateChat restoreChat -> withUser $ \_ -> do - lift $ when restoreChat restoreCalls - lift $ withAgent' foregroundAgent - chatWriteVar chatActivated True - when restoreChat $ do - users <- withFastStore' getUsers - lift $ do - void . forkIO $ subscribeUsers True users - void . forkIO $ startFilesToReceive users - setAllExpireCIFlags True - ok_ - APISuspendChat t -> do - chatWriteVar chatActivated False - lift $ setAllExpireCIFlags False - stopRemoteCtrl - lift $ withAgent' (`suspendAgent` t) - ok_ - ResubscribeAllConnections -> withStore' getUsers >>= lift . subscribeUsers False >> ok_ - -- has to be called before StartChat - SetTempFolder tf -> do - createDirectoryIfMissing True tf - asks tempDirectory >>= atomically . (`writeTVar` Just tf) - ok_ - SetFilesFolder ff -> do - createDirectoryIfMissing True ff - asks filesFolder >>= atomically . (`writeTVar` Just ff) - ok_ - SetRemoteHostsFolder rf -> do - createDirectoryIfMissing True rf - chatWriteVar remoteHostsFolder $ Just rf - ok_ - -- has to be called before StartChat - APISetAppFilePaths cfg -> do - setFolder filesFolder $ appFilesFolder cfg - setFolder tempDirectory $ appTempFolder cfg - setFolder assetsDirectory $ appAssetsFolder cfg - mapM_ (setFolder remoteHostsFolder) $ appRemoteHostsFolder cfg - ok_ - where - setFolder sel f = do - createDirectoryIfMissing True f - chatWriteVar sel $ Just f - APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_ - SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_ - APIExportArchive cfg -> checkChatStopped $ CRArchiveExported <$> lift (exportArchive cfg) - ExportArchive -> do - ts <- liftIO getCurrentTime - let filePath = "simplex-chat." <> formatTime defaultTimeLocale "%FT%H%M%SZ" ts <> ".zip" - processChatCommand $ APIExportArchive $ ArchiveConfig filePath Nothing Nothing - APIImportArchive cfg -> checkChatStopped $ do - fileErrs <- lift $ importArchive cfg - setStoreChanged - pure $ CRArchiveImported fileErrs - APISaveAppSettings as -> withFastStore' (`saveAppSettings` as) >> ok_ - APIGetAppSettings platformDefaults -> CRAppSettings <$> withFastStore' (`getAppSettings` platformDefaults) - APIDeleteStorage -> withStoreChanged deleteStorage - APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg - TestStorageEncryption key -> sqlCipherTestKey key >> ok_ - ExecChatStoreSQL query -> CRSQLResult <$> withStore' (`execSQL` query) - ExecAgentStoreSQL query -> CRSQLResult <$> withAgent (`execAgentStoreSQL` query) - SlowSQLQueries -> do - ChatController {chatStore, smpAgent} <- ask - chatQueries <- slowQueries chatStore - agentQueries <- slowQueries $ agentClientStore smpAgent - pure CRSlowSQLQueries {chatQueries, agentQueries} - where - slowQueries st = - liftIO $ - map (uncurry SlowSQLQuery . first SQL.fromQuery) - . sortOn (timeAvg . snd) - . M.assocs - <$> withConnection st (readTVarIO . DB.slow) - APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do - (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user pendingConnections pagination query) - unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs) - pure $ CRApiChats user previews - APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of - -- TODO optimize queries calculating ChatStats, currently they're disabled - CTDirect -> do - (directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId pagination search) - pure $ CRApiChat user (AChat SCTDirect directChat) navInfo - CTGroup -> do - (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId pagination search) - pure $ CRApiChat user (AChat SCTGroup groupChat) navInfo - CTLocal -> do - (localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search) - pure $ CRApiChat user (AChat SCTLocal localChat) navInfo - CTContactRequest -> pure $ chatCmdError (Just user) "not implemented" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - APIGetChatItems pagination search -> withUser $ \user -> do - chatItems <- withFastStore $ \db -> getAllChatItems db vr user pagination search - pure $ CRChatItems user Nothing chatItems - APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do - (aci@(AChatItem cType dir _ ci), versions) <- withFastStore $ \db -> - (,) <$> getAChatItem db vr user chatRef itemId <*> liftIO (getChatItemVersions db itemId) - let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions - memberDeliveryStatuses <- case (cType, dir) of - (SCTGroup, SMDSnd) -> L.nonEmpty <$> withFastStore' (`getGroupSndStatuses` itemId) - _ -> pure Nothing - forwardedFromChatItem <- getForwardedFromItem user ci - pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses, forwardedFromChatItem} - where - getForwardedFromItem :: User -> ChatItem c d -> CM (Maybe AChatItem) - getForwardedFromItem user ChatItem {meta = CIMeta {itemForwarded}} = case itemForwarded of - Just (CIFFContact _ _ (Just ctId) (Just fwdItemId)) -> - Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTDirect ctId) fwdItemId) - Just (CIFFGroup _ _ (Just gId) (Just fwdItemId)) -> - Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTGroup gId) fwdItemId) - _ -> pure Nothing - APISendMessages (ChatRef cType chatId) live itemTTL cms -> withUser $ \user -> case cType of - CTDirect -> - withContactLock "sendMessage" chatId $ - sendContactContentMessages user chatId live itemTTL (L.map (,Nothing) cms) - CTGroup -> - withGroupLock "sendMessage" chatId $ - sendGroupContentMessages user chatId live itemTTL (L.map (,Nothing) cms) - CTLocal -> pure $ chatCmdError (Just user) "not supported" - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - APICreateChatItems folderId cms -> withUser $ \user -> - createNoteFolderContentItems user folderId (L.map (,Nothing) cms) - APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> case cType of - CTDirect -> withContactLock "updateChatItem" chatId $ do - ct@Contact {contactId} <- withFastStore $ \db -> getContact db vr user chatId - assertDirectAllowed user MDSnd ct XMsgUpdate_ - cci <- withFastStore $ \db -> getDirectCIWithReactions db user ct itemId - case cci of - CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do - case (ciContent, itemSharedMsgId, editable) of - (CISndMsgContent oldMC, Just itemSharedMId, True) -> do - let changed = mc /= oldMC - if changed || fromMaybe False itemLive - then do - (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) - ci' <- withFastStore' $ \db -> do - currentTs <- liftIO getCurrentTime - when changed $ - addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) - let edited = itemLive /= Just True - updateDirectChatItem' db user contactId ci (CISndMsgContent mc) edited live Nothing $ Just msgId - startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' - pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci') - else pure $ CRChatItemNotChanged user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) - _ -> throwChatError CEInvalidChatItemUpdate - CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate - CTGroup -> withGroupLock "updateChatItem" chatId $ do - Group gInfo@GroupInfo {groupId, membership} ms <- withFastStore $ \db -> getGroup db vr user chatId - assertUserGroupRole gInfo GRAuthor - if prohibitedSimplexLinks gInfo membership mc - then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFSimplexLinks)) - else do - cci <- withFastStore $ \db -> getGroupCIWithReactions db user gInfo itemId - case cci of - CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do - case (ciContent, itemSharedMsgId, editable) of - (CISndMsgContent oldMC, Just itemSharedMId, True) -> do - let changed = mc /= oldMC - if changed || fromMaybe False itemLive - then do - SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) - ci' <- withFastStore' $ \db -> do - currentTs <- liftIO getCurrentTime - when changed $ - addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) - let edited = itemLive /= Just True - updateGroupChatItem db user groupId ci (CISndMsgContent mc) edited live $ Just msgId - startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' - pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci') - else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) - _ -> throwChatError CEInvalidChatItemUpdate - CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate - CTLocal -> do - (nf@NoteFolder {noteFolderId}, cci) <- withFastStore $ \db -> (,) <$> getNoteFolder db user chatId <*> getLocalChatItem db user chatId itemId - case cci of - CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent oldMC} - | mc == oldMC -> pure $ CRChatItemNotChanged user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci) - | otherwise -> withFastStore' $ \db -> do - currentTs <- getCurrentTime - addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) - ci' <- updateLocalChatItem' db user noteFolderId ci (CISndMsgContent mc) True - pure $ CRChatItemUpdated user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci') - _ -> throwChatError CEInvalidChatItemUpdate - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - APIDeleteChatItem (ChatRef cType chatId) itemIds mode -> withUser $ \user -> case cType of - CTDirect -> withContactLock "deleteChatItem" chatId $ do - (ct, items) <- getCommandDirectChatItems user chatId itemIds - case mode of - CIDMInternal -> deleteDirectCIs user ct items True False - CIDMBroadcast -> do - assertDeletable items - assertDirectAllowed user MDSnd ct XMsgDel_ - let msgIds = itemsMsgIds items - events = map (\msgId -> XMsgDel msgId Nothing) msgIds - forM_ (L.nonEmpty events) $ \events' -> - sendDirectContactMessages user ct events' - if featureAllowed SCFFullDelete forUser ct - then deleteDirectCIs user ct items True False - else markDirectCIsDeleted user ct items True =<< liftIO getCurrentTime - CTGroup -> withGroupLock "deleteChatItem" chatId $ do - (gInfo, items) <- getCommandGroupChatItems user chatId itemIds - ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo - case mode of - CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime - CIDMBroadcast -> do - assertDeletable items - assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier - let msgIds = itemsMsgIds items - events = L.nonEmpty $ map (`XMsgDel` Nothing) msgIds - mapM_ (sendGroupMessages user gInfo ms) events - delGroupChatItems user gInfo items Nothing - CTLocal -> do - (nf, items) <- getCommandLocalChatItems user chatId itemIds - deleteLocalCIs user nf items True False - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - where - assertDeletable :: forall c. ChatTypeI c => [CChatItem c] -> CM () - assertDeletable items = do - currentTs <- liftIO getCurrentTime - unless (all (itemDeletable currentTs) items) $ throwChatError CEInvalidChatItemDelete - where - itemDeletable :: UTCTime -> CChatItem c -> Bool - itemDeletable currentTs (CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, itemTs, itemDeleted}, content}) = - case msgDir of - -- We check with a 6 hour margin compared to CIMeta deletable to account for deletion on the border - SMDSnd -> isJust itemSharedMsgId && deletable' content itemDeleted itemTs (nominalDay + 6 * 3600) currentTs - SMDRcv -> False - itemsMsgIds :: [CChatItem c] -> [SharedMsgId] - itemsMsgIds = mapMaybe (\(CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId}}) -> itemSharedMsgId) - APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do - (gInfo@GroupInfo {membership}, items) <- getCommandGroupChatItems user gId itemIds - ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo - assertDeletable gInfo items - assertUserGroupRole gInfo GRAdmin - let msgMemIds = itemsMsgMemIds gInfo items - events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds - mapM_ (sendGroupMessages user gInfo ms) events - delGroupChatItems user gInfo items (Just membership) - where - assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM () - assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items = - unless (all itemDeletable items) $ throwChatError CEInvalidChatItemDelete - where - itemDeletable :: CChatItem 'CTGroup -> Bool - itemDeletable (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = - case chatDir of - CIGroupRcv GroupMember {memberRole} -> membershipMemRole >= memberRole && isJust itemSharedMsgId - CIGroupSnd -> isJust itemSharedMsgId - itemsMsgMemIds :: GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)] - itemsMsgMemIds GroupInfo {membership = GroupMember {memberId = membershipMemId}} = mapMaybe itemMsgMemIds - where - itemMsgMemIds :: CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId) - itemMsgMemIds (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = - join <$> forM itemSharedMsgId $ \msgId -> Just $ case chatDir of - CIGroupRcv GroupMember {memberId} -> (msgId, memberId) - CIGroupSnd -> (msgId, membershipMemId) - APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> case cType of - CTDirect -> - withContactLock "chatItemReaction" chatId $ - withFastStore (\db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId) >>= \case - (ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do - unless (featureAllowed SCFReactions forUser ct) $ - throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)) - unless (ciReactionAllowed ci) $ - throwChatError (CECommandError "reaction not allowed - chat item has no content") - rs <- withFastStore' $ \db -> getDirectReactions db ct itemSharedMId True - checkReactionAllowed rs - (SndMessage {msgId}, _) <- sendDirectContactMessage user ct $ XMsgReact itemSharedMId Nothing reaction add - createdAt <- liftIO getCurrentTime - reactions <- withFastStore' $ \db -> do - setDirectReaction db ct itemSharedMId True reaction add msgId createdAt - liftIO $ getDirectCIReactions db ct itemSharedMId - let ci' = CChatItem md ci {reactions} - r = ACIReaction SCTDirect SMDSnd (DirectChat ct) $ CIReaction CIDirectSnd ci' createdAt reaction - pure $ CRChatItemReaction user add r - _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" - CTGroup -> - withGroupLock "chatItemReaction" chatId $ - withFastStore (\db -> (,) <$> getGroup db vr user chatId <*> getGroupChatItem db user chatId itemId) >>= \case - (Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do - unless (groupFeatureAllowed SGFReactions g) $ - throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)) - unless (ciReactionAllowed ci) $ - throwChatError (CECommandError "reaction not allowed - chat item has no content") - let GroupMember {memberId = itemMemberId} = chatItemMember g ci - rs <- withFastStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True - checkReactionAllowed rs - SndMessage {msgId} <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add) - createdAt <- liftIO getCurrentTime - reactions <- withFastStore' $ \db -> do - setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt - liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId - let ci' = CChatItem md ci {reactions} - r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction - pure $ CRChatItemReaction user add r - _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" - CTLocal -> pure $ chatCmdError (Just user) "not supported" - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - where - checkReactionAllowed rs = do - when ((reaction `elem` rs) == add) $ - throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed") - when (add && length rs >= maxMsgReactions) $ - throwChatError (CECommandError "too many reactions") - APIGetReactionMembers userId groupId itemId reaction -> withUserId userId $ \user -> do - memberReactions <- withStore $ \db -> do - CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}} <- getGroupChatItem db user groupId itemId - liftIO $ getReactionMembers db vr user groupId itemSharedMId reaction - pure $ CRReactionMembers user memberReactions - APIPlanForwardChatItems (ChatRef fromCType fromChatId) itemIds -> withUser $ \user -> case fromCType of - CTDirect -> planForward user . snd =<< getCommandDirectChatItems user fromChatId itemIds - CTGroup -> planForward user . snd =<< getCommandGroupChatItems user fromChatId itemIds - CTLocal -> planForward user . snd =<< getCommandLocalChatItems user fromChatId itemIds - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - where - planForward :: User -> [CChatItem c] -> CM ChatResponse - planForward user items = do - (itemIds', forwardErrors) <- unzip <$> mapM planItemForward items - let forwardConfirmation = case catMaybes forwardErrors of - [] -> Nothing - errs -> Just $ case mainErr of - FFENotAccepted _ -> FCFilesNotAccepted fileIds - FFEInProgress -> FCFilesInProgress filesCount - FFEMissing -> FCFilesMissing filesCount - FFEFailed -> FCFilesFailed filesCount - where - mainErr = minimum errs - fileIds = catMaybes $ map (\case FFENotAccepted ftId -> Just ftId; _ -> Nothing) errs - filesCount = length $ filter (mainErr ==) errs - pure CRForwardPlan {user, itemsCount = length itemIds, chatItemIds = catMaybes itemIds', forwardConfirmation} - where - planItemForward :: CChatItem c -> CM (Maybe ChatItemId, Maybe ForwardFileError) - planItemForward (CChatItem _ ci) = forwardMsgContent ci >>= maybe (pure (Nothing, Nothing)) (forwardContentPlan ci) - forwardContentPlan :: ChatItem c d -> MsgContent -> CM (Maybe ChatItemId, Maybe ForwardFileError) - forwardContentPlan ChatItem {file, meta = CIMeta {itemId}} mc = case file of - Nothing -> pure (Just itemId, Nothing) - Just CIFile {fileId, fileStatus, fileSource} -> case ciFileForwardError fileId fileStatus of - Just err -> pure $ itemIdWithoutFile err - Nothing -> case fileSource of - Just CryptoFile {filePath} -> do - exists <- doesFileExist =<< lift (toFSFilePath filePath) - pure $ if exists then (Just itemId, Nothing) else itemIdWithoutFile FFEMissing - Nothing -> pure $ itemIdWithoutFile FFEMissing - where - itemIdWithoutFile err = (if hasContent then Just itemId else Nothing, Just err) - hasContent = case mc of - MCText _ -> True - MCLink {} -> True - MCImage {} -> True - MCVideo {text} -> text /= "" - MCVoice {text} -> text /= "" - MCFile t -> t /= "" - MCUnknown {} -> True - APIForwardChatItems (ChatRef toCType toChatId) (ChatRef fromCType fromChatId) itemIds itemTTL -> withUser $ \user -> case toCType of - CTDirect -> do - cmrs <- prepareForward user - case L.nonEmpty cmrs of - Just cmrs' -> - withContactLock "forwardChatItem, to contact" toChatId $ - sendContactContentMessages user toChatId False itemTTL cmrs' - Nothing -> pure $ CRNewChatItems user [] - CTGroup -> do - cmrs <- prepareForward user - case L.nonEmpty cmrs of - Just cmrs' -> - withGroupLock "forwardChatItem, to group" toChatId $ - sendGroupContentMessages user toChatId False itemTTL cmrs' - Nothing -> pure $ CRNewChatItems user [] - CTLocal -> do - cmrs <- prepareForward user - case L.nonEmpty cmrs of - Just cmrs' -> - createNoteFolderContentItems user toChatId cmrs' - Nothing -> pure $ CRNewChatItems user [] - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - where - prepareForward :: User -> CM [ComposeMessageReq] - prepareForward user = case fromCType of - CTDirect -> withContactLock "forwardChatItem, from contact" fromChatId $ do - (ct, items) <- getCommandDirectChatItems user fromChatId itemIds - catMaybes <$> mapM (\ci -> ciComposeMsgReq ct ci <$$> prepareMsgReq ci) items - where - ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq - ciComposeMsgReq ct (CChatItem md ci) (mc', file) = - let itemId = chatItemId' ci - ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) (toMsgDirection md) (Just fromChatId) (Just itemId)) - in (ComposedMessage file Nothing mc', ciff) - where - forwardName :: Contact -> ContactName - forwardName Contact {profile = LocalProfile {displayName, localAlias}} - | localAlias /= "" = localAlias - | otherwise = displayName - CTGroup -> withGroupLock "forwardChatItem, from group" fromChatId $ do - (gInfo, items) <- getCommandGroupChatItems user fromChatId itemIds - catMaybes <$> mapM (\ci -> ciComposeMsgReq gInfo ci <$$> prepareMsgReq ci) items - where - ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq - ciComposeMsgReq gInfo (CChatItem md ci) (mc', file) = do - let itemId = chatItemId' ci - ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) (toMsgDirection md) (Just fromChatId) (Just itemId)) - in (ComposedMessage file Nothing mc', ciff) - where - forwardName :: GroupInfo -> ContactName - forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName - CTLocal -> do - (_, items) <- getCommandLocalChatItems user fromChatId itemIds - catMaybes <$> mapM (\ci -> ciComposeMsgReq ci <$$> prepareMsgReq ci) items - where - ciComposeMsgReq :: CChatItem 'CTLocal -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq - ciComposeMsgReq (CChatItem _ ci) (mc', file) = - let ciff = forwardCIFF ci Nothing - in (ComposedMessage file Nothing mc', ciff) - CTContactRequest -> throwChatError $ CECommandError "not supported" - CTContactConnection -> throwChatError $ CECommandError "not supported" - where - prepareMsgReq :: CChatItem c -> CM (Maybe (MsgContent, Maybe CryptoFile)) - prepareMsgReq (CChatItem _ ci) = forwardMsgContent ci $>>= forwardContent ci - forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom - forwardCIFF ChatItem {meta = CIMeta {itemForwarded}} ciff = case itemForwarded of - Nothing -> ciff - Just CIFFUnknown -> ciff - Just prevCIFF -> Just prevCIFF - forwardContent :: ChatItem c d -> MsgContent -> CM (Maybe (MsgContent, Maybe CryptoFile)) - forwardContent ChatItem {file} mc = case file of - Nothing -> pure $ Just (mc, Nothing) - Just CIFile {fileName, fileStatus, fileSource = Just fromCF@CryptoFile {filePath}} - | ciFileLoaded fileStatus -> - chatReadVar filesFolder >>= \case - Nothing -> - ifM (doesFileExist filePath) (pure $ Just (mc, Just fromCF)) (pure contentWithoutFile) - Just filesFolder -> do - let fsFromPath = filesFolder filePath - ifM - (doesFileExist fsFromPath) - ( do - fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName - liftIO $ B.writeFile fsNewPath "" -- create empty file - encrypt <- chatReadVar encryptLocalFiles - cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing - let toCF = CryptoFile fsNewPath cfArgs - -- to keep forwarded file in case original is deleted - liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ copyCryptoFile (fromCF {filePath = fsFromPath} :: CryptoFile) toCF - pure $ Just (mc, Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile)) - ) - (pure contentWithoutFile) - _ -> pure contentWithoutFile - where - contentWithoutFile = case mc of - MCImage {} -> Just (mc, Nothing) - MCLink {} -> Just (mc, Nothing) - _ | contentText /= "" -> Just (MCText contentText, Nothing) - _ -> Nothing - contentText = msgContentText mc - copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT CF.FTCryptoError IO () - copyCryptoFile fromCF@CryptoFile {filePath = fsFromPath, cryptoArgs = fromArgs} toCF@CryptoFile {cryptoArgs = toArgs} = do - fromSizeFull <- getFileSize fsFromPath - let fromSize = fromSizeFull - maybe 0 (const $ toInteger C.authTagSize) fromArgs - CF.withFile fromCF ReadMode $ \fromH -> - CF.withFile toCF WriteMode $ \toH -> do - copyChunks fromH toH fromSize - forM_ fromArgs $ \_ -> CF.hGetTag fromH - forM_ toArgs $ \_ -> liftIO $ CF.hPutTag toH - where - copyChunks :: CF.CryptoFileHandle -> CF.CryptoFileHandle -> Integer -> ExceptT CF.FTCryptoError IO () - copyChunks r w size = do - let chSize = min size U.chunkSize - chSize' = fromIntegral chSize - size' = size - chSize - ch <- liftIO $ CF.hGet r chSize' - when (B.length ch /= chSize') $ throwError $ CF.FTCEFileIOError "encrypting file: unexpected EOF" - liftIO . CF.hPut w $ LB.fromStrict ch - when (size' > 0) $ copyChunks r w size' - APIUserRead userId -> withUserId userId $ \user -> withFastStore' (`setUserChatsRead` user) >> ok user - UserRead -> withUser $ \User {userId} -> processChatCommand $ APIUserRead userId - APIChatRead chatRef@(ChatRef cType chatId) -> withUser $ \_ -> case cType of - CTDirect -> do - user <- withFastStore $ \db -> getUserByContactId db chatId - ts <- liftIO getCurrentTime - timedItems <- withFastStore' $ \db -> do - timedItems <- getDirectUnreadTimedItems db user chatId - updateDirectChatItemsRead db user chatId - setDirectChatItemsDeleteAt db user chatId timedItems ts - forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt - ok user - CTGroup -> do - user <- withFastStore $ \db -> getUserByGroupId db chatId - ts <- liftIO getCurrentTime - timedItems <- withFastStore' $ \db -> do - timedItems <- getGroupUnreadTimedItems db user chatId - updateGroupChatItemsRead db user chatId - setGroupChatItemsDeleteAt db user chatId timedItems ts - forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt - ok user - CTLocal -> do - user <- withFastStore $ \db -> getUserByNoteFolderId db chatId - withFastStore' $ \db -> updateLocalChatItemsRead db user chatId - ok user - CTContactRequest -> pure $ chatCmdError Nothing "not supported" - CTContactConnection -> pure $ chatCmdError Nothing "not supported" - APIChatItemsRead chatRef@(ChatRef cType chatId) itemIds -> withUser $ \_ -> case cType of - CTDirect -> do - user <- withFastStore $ \db -> getUserByContactId db chatId - timedItems <- withFastStore' $ \db -> do - timedItems <- updateDirectChatItemsReadList db user chatId itemIds - setDirectChatItemsDeleteAt db user chatId timedItems =<< getCurrentTime - forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt - ok user - CTGroup -> do - user <- withFastStore $ \db -> getUserByGroupId db chatId - timedItems <- withFastStore' $ \db -> do - timedItems <- updateGroupChatItemsReadList db user chatId itemIds - setGroupChatItemsDeleteAt db user chatId timedItems =<< getCurrentTime - forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt - ok user - CTLocal -> pure $ chatCmdError Nothing "not supported" - CTContactRequest -> pure $ chatCmdError Nothing "not supported" - CTContactConnection -> pure $ chatCmdError Nothing "not supported" - APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of - CTDirect -> do - withFastStore $ \db -> do - ct <- getContact db vr user chatId - liftIO $ updateContactUnreadChat db user ct unreadChat - ok user - CTGroup -> do - withFastStore $ \db -> do - Group {groupInfo} <- getGroup db vr user chatId - liftIO $ updateGroupUnreadChat db user groupInfo unreadChat - ok user - CTLocal -> do - withFastStore $ \db -> do - nf <- getNoteFolder db user chatId - liftIO $ updateNoteFolderUnreadChat db user nf unreadChat - ok user - _ -> pure $ chatCmdError (Just user) "not supported" - APIDeleteChat cRef@(ChatRef cType chatId) cdm -> withUser $ \user@User {userId} -> case cType of - CTDirect -> do - ct <- withFastStore $ \db -> getContact db vr user chatId - filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct - withContactLock "deleteChat direct" chatId . procCmd $ - case cdm of - CDMFull notify -> do - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - sendDelDeleteConns ct notify - -- functions below are called in separate transactions to prevent crashes on android - -- (possibly, race condition on integrity check?) - withFastStore' $ \db -> do - deleteContactConnections db user ct - deleteContactFiles db user ct - withFastStore $ \db -> deleteContact db user ct - pure $ CRContactDeleted user ct - CDMEntity notify -> do - cancelFilesInProgress user filesInfo - sendDelDeleteConns ct notify - ct' <- withFastStore $ \db -> do - liftIO $ deleteContactConnections db user ct - liftIO $ void $ updateContactStatus db user ct CSDeletedByUser - getContact db vr user chatId - pure $ CRContactDeleted user ct' - CDMMessages -> do - void $ processChatCommand $ APIClearChat cRef - withFastStore' $ \db -> setContactChatDeleted db user ct True - pure $ CRContactDeleted user ct {chatDeleted = True} - where - sendDelDeleteConns ct notify = do - let doSendDel = contactReady ct && contactActive ct && notify - when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ()) - contactConnIds <- map aConnId <$> withFastStore' (\db -> getContactConnections db vr userId ct) - deleteAgentConnectionsAsync' user contactConnIds doSendDel - CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId . procCmd $ do - conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withFastStore $ \db -> getPendingContactConnection db userId chatId - deleteAgentConnectionAsync user acId - withFastStore' $ \db -> deletePendingContactConnection db userId chatId - pure $ CRContactConnectionDeleted user conn - CTGroup -> do - Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user chatId - let GroupMember {memberRole = membershipMemRole} = membership - let isOwner = membershipMemRole == GROwner - canDelete = isOwner || not (memberCurrent membership) - unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner - filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo - withGroupLock "deleteChat group" chatId . procCmd $ do - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - let doSendDel = memberActive membership && isOwner - when doSendDel . void $ sendGroupMessage' user gInfo members XGrpDel - deleteGroupLinkIfExists user gInfo - deleteMembersConnections' user members doSendDel - updateCIGroupInvitationStatus user gInfo CIGISRejected `catchChatError` \_ -> pure () - -- functions below are called in separate transactions to prevent crashes on android - -- (possibly, race condition on integrity check?) - withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members - withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo members - withStore' $ \db -> deleteGroup db user gInfo - let contactIds = mapMaybe memberContactId members - (errs1, (errs2, connIds)) <- lift $ second unzip . partitionEithers <$> withStoreBatch (\db -> map (deleteUnusedContact db) contactIds) - let errs = errs1 <> mapMaybe (fmap ChatErrorStore) errs2 - unless (null errs) $ toView $ CRChatErrors (Just user) errs - deleteAgentConnectionsAsync user $ concat connIds - pure $ CRGroupDeletedUser user gInfo - where - deleteUnusedContact :: DB.Connection -> ContactId -> IO (Either ChatError (Maybe StoreError, [ConnId])) - deleteUnusedContact db contactId = runExceptT . withExceptT ChatErrorStore $ do - ct <- getContact db vr user contactId - ifM - ((directOrUsed ct ||) . isJust <$> liftIO (checkContactHasGroups db user ct)) - (pure (Nothing, [])) - (getConnections ct) - where - getConnections :: Contact -> ExceptT StoreError IO (Maybe StoreError, [ConnId]) - getConnections ct = do - conns <- liftIO $ getContactConnections db vr userId ct - e_ <- (setContactDeleted db user ct $> Nothing) `catchStoreError` (pure . Just) - pure (e_, map aConnId conns) - CTLocal -> pure $ chatCmdError (Just user) "not supported" - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of - CTDirect -> do - ct <- withFastStore $ \db -> getContact db vr user chatId - filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - withFastStore' $ \db -> deleteContactCIs db user ct - pure $ CRChatCleared user (AChatInfo SCTDirect $ DirectChat ct) - CTGroup -> do - gInfo <- withFastStore $ \db -> getGroupInfo db vr user chatId - filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - withFastStore' $ \db -> deleteGroupChatItemsMessages db user gInfo - membersToDelete <- withFastStore' $ \db -> getGroupMembersForExpiration db vr user gInfo - forM_ membersToDelete $ \m -> withFastStore' $ \db -> deleteGroupMember db user m - pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo) - CTLocal -> do - nf <- withFastStore $ \db -> getNoteFolder db user chatId - filesInfo <- withFastStore' $ \db -> getNoteFolderFileInfo db user nf - deleteFilesLocally filesInfo - withFastStore' $ \db -> deleteNoteFolderFiles db userId nf - withFastStore' $ \db -> deleteNoteFolderCIs db user nf - pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf) - CTContactConnection -> pure $ chatCmdError (Just user) "not supported" - CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - APIAcceptContact incognito connReqId -> withUser $ \_ -> do - userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId - withUserContactLock "acceptContact" userContactLinkId $ do - (user@User {userId}, cReq) <- withFastStore $ \db -> getContactRequest' db connReqId - (ct, conn@Connection {connId}, sqSecured) <- acceptContactRequest user cReq incognito - ucl <- withFastStore $ \db -> getUserContactLinkById db userId userContactLinkId - let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl - ct' <- withStore' $ \db -> do - deleteContactRequestRec db user cReq - updateContactAccepted db user ct contactUsed - conn' <- - if sqSecured - then conn {connStatus = ConnSndReady} <$ updateConnectionStatusFromTo db connId ConnNew ConnSndReady - else pure conn - pure ct {contactUsed, activeConn = Just conn'} - pure $ CRAcceptingContactRequest user ct' - APIRejectContact connReqId -> withUser $ \user -> do - userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId - withUserContactLock "rejectContact" userContactLinkId $ do - cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <- - withFastStore $ \db -> - getContactRequest db user connReqId - `storeFinally` liftIO (deleteContactRequest db user connReqId) - withAgent $ \a -> rejectContact a connId invId - pure $ CRContactRequestRejected user cReq - APISendCallInvitation contactId callType -> withUser $ \user -> do - -- party initiating call - ct <- withFastStore $ \db -> getContact db vr user contactId - assertDirectAllowed user MDSnd ct XCallInv_ - if featureAllowed SCFCalls forUser ct - then do - calls <- asks currentCalls - withContactLock "sendCallInvitation" contactId $ do - g <- asks random - callId <- atomically $ CallId <$> C.randomBytes 16 g - callUUID <- UUID.toText <$> liftIO V4.nextRandom - dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing - let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair} - callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair} - (msg, _) <- sendDirectContactMessage user ct (XCallInv callId invitation) - ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) - let call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci} - call_ <- atomically $ TM.lookupInsert contactId call' calls - forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing - toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] - ok user - else pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFCalls)) - SendCallInvitation cName callType -> withUser $ \user -> do - contactId <- withFastStore $ \db -> getContactIdByName db user cName - processChatCommand $ APISendCallInvitation contactId callType - APIRejectCall contactId -> - -- party accepting call - withCurrentCall contactId $ \user ct Call {chatItemId, callState} -> case callState of - CallInvitationReceived {} -> do - let aciContent = ACIContent SMDRcv $ CIRcvCall CISCallRejected 0 - withFastStore' $ \db -> setDirectChatItemRead db user contactId chatItemId - timed_ <- contactCITimed ct - updateDirectChatItemView user ct chatItemId aciContent False False timed_ Nothing - forM_ (timed_ >>= timedDeleteAt') $ - startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId) - pure Nothing - _ -> throwChatError . CECallState $ callStateTag callState - APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} -> - -- party accepting call - withCurrentCall contactId $ \user ct call@Call {callId, chatItemId, callState} -> case callState of - CallInvitationReceived {peerCallType, localDhPubKey, sharedKey} -> do - let callDhPubKey = if encryptedCall callType then localDhPubKey else Nothing - offer = CallOffer {callType, rtcSession, callDhPubKey} - callState' = CallOfferSent {localCallType = callType, peerCallType, localCallSession = rtcSession, sharedKey} - aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0 - (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallOffer callId offer) - withFastStore' $ \db -> setDirectChatItemRead db user contactId chatItemId - updateDirectChatItemView user ct chatItemId aciContent False False Nothing $ Just msgId - pure $ Just call {callState = callState'} - _ -> throwChatError . CECallState $ callStateTag callState - APISendCallAnswer contactId rtcSession -> - -- party initiating call - withCurrentCall contactId $ \user ct call@Call {callId, chatItemId, callState} -> case callState of - CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} -> do - let callState' = CallNegotiated {localCallType, peerCallType, localCallSession = rtcSession, peerCallSession, sharedKey} - aciContent = ACIContent SMDSnd $ CISndCall CISCallNegotiated 0 - (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallAnswer callId CallAnswer {rtcSession}) - updateDirectChatItemView user ct chatItemId aciContent False False Nothing $ Just msgId - pure $ Just call {callState = callState'} - _ -> throwChatError . CECallState $ callStateTag callState - APISendCallExtraInfo contactId rtcExtraInfo -> - -- any call party - withCurrentCall contactId $ \user ct call@Call {callId, callState} -> case callState of - CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} -> do - -- TODO update the list of ice servers in localCallSession - void . sendDirectContactMessage user ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} - let callState' = CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} - pure $ Just call {callState = callState'} - CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} -> do - -- TODO update the list of ice servers in localCallSession - void . sendDirectContactMessage user ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} - let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} - pure $ Just call {callState = callState'} - _ -> throwChatError . CECallState $ callStateTag callState - APIEndCall contactId -> - -- any call party - withCurrentCall contactId $ \user ct call@Call {callId} -> do - (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallEnd callId) - updateCallItemStatus user ct call WCSDisconnected $ Just msgId - pure Nothing - APIGetCallInvitations -> withUser' $ \_ -> lift $ do - calls <- asks currentCalls >>= readTVarIO - let invs = mapMaybe callInvitation $ M.elems calls - rcvCallInvitations <- rights <$> mapM rcvCallInvitation invs - pure $ CRCallInvitations rcvCallInvitations - where - callInvitation Call {contactId, callUUID, callState, callTs} = case callState of - CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callUUID, callTs, peerCallType, sharedKey) - _ -> Nothing - rcvCallInvitation (contactId, callUUID, callTs, peerCallType, sharedKey) = runExceptT . withFastStore $ \db -> do - user <- getUserByContactId db contactId - contact <- getContact db vr user contactId - pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callUUID, callTs} - APIGetNetworkStatuses -> withUser $ \_ -> - CRNetworkStatuses Nothing . map (uncurry ConnNetworkStatus) . M.toList <$> chatReadVar connNetworkStatuses - APICallStatus contactId receivedStatus -> - withCurrentCall contactId $ \user ct call -> - updateCallItemStatus user ct call receivedStatus Nothing $> Just call - APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile) - APISetContactPrefs contactId prefs' -> withUser $ \user -> do - ct <- withFastStore $ \db -> getContact db vr user contactId - updateContactPrefs user ct prefs' - APISetContactAlias contactId localAlias -> withUser $ \user@User {userId} -> do - ct' <- withFastStore $ \db -> do - ct <- getContact db vr user contactId - liftIO $ updateContactAlias db userId ct localAlias - pure $ CRContactAliasUpdated user ct' - APISetConnectionAlias connId localAlias -> withUser $ \user@User {userId} -> do - conn' <- withFastStore $ \db -> do - conn <- getPendingContactConnection db userId connId - liftIO $ updateContactConnectionAlias db userId conn localAlias - pure $ CRConnectionAliasUpdated user conn' - APISetUserUIThemes uId uiThemes -> withUser $ \user@User {userId} -> do - user'@User {userId = uId'} <- withFastStore $ \db -> do - user' <- getUser db uId - liftIO $ setUserUIThemes db user uiThemes - pure user' - when (userId == uId') $ chatWriteVar currentUser $ Just (user :: User) {uiThemes} - ok user' - APISetChatUIThemes (ChatRef cType chatId) uiThemes -> withUser $ \user -> case cType of - CTDirect -> do - withFastStore $ \db -> do - ct <- getContact db vr user chatId - liftIO $ setContactUIThemes db user ct uiThemes - ok user - CTGroup -> do - withFastStore $ \db -> do - g <- getGroupInfo db vr user chatId - liftIO $ setGroupUIThemes db user g uiThemes - ok user - _ -> pure $ chatCmdError (Just user) "not supported" - APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text - APIGetNtfToken -> withUser' $ \_ -> crNtfToken <$> withAgent getNtfToken - APIRegisterToken token mode -> withUser $ \_ -> - CRNtfTokenStatus <$> withAgent (\a -> registerNtfToken a token mode) - APIVerifyToken token nonce code -> withUser $ \_ -> withAgent (\a -> verifyNtfToken a token nonce code) >> ok_ - APIDeleteToken token -> withUser $ \_ -> withAgent (`deleteNtfToken` token) >> ok_ - APIGetNtfConns nonce encNtfInfo -> withUser $ \user -> do - ntfInfos <- withAgent $ \a -> getNotificationConns a nonce encNtfInfo - (errs, ntfMsgs) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (getMsgConn db) (L.toList ntfInfos)) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure $ CRNtfConns ntfMsgs - where - getMsgConn :: DB.Connection -> NotificationInfo -> IO NtfConn - getMsgConn db NotificationInfo {ntfConnId, ntfMsgMeta = nMsgMeta} = do - let agentConnId = AgentConnId ntfConnId - user_ <- getUserByAConnId db agentConnId - connEntity_ <- - pure user_ $>>= \user -> - eitherToMaybe <$> runExceptT (getConnectionEntity db vr user agentConnId) - pure $ - NtfConn - { user_, - connEntity_, - -- Decrypted ntf meta of the expected message (the one notification was sent for) - expectedMsg_ = expectedMsgInfo <$> nMsgMeta - } - ApiGetConnNtfMessages connIds -> withUser $ \_ -> do - let acIds = L.map (\(AgentConnId acId) -> acId) connIds - msgs <- lift $ withAgent' $ \a -> getConnectionMessages a acIds - let ntfMsgs = L.map (\msg -> receivedMsgInfo <$> msg) msgs - pure $ CRConnNtfMessages ntfMsgs - GetUserProtoServers (AProtocolType p) -> withUser $ \user -> withServerProtocol p $ do - srvs <- withFastStore (`getUserServers` user) - liftIO $ CRUserServers user <$> groupByOperator (protocolServers p srvs) - SetUserProtoServers (AProtocolType (p :: SProtocolType p)) srvs -> withUser $ \user@User {userId} -> withServerProtocol p $ do - userServers_ <- liftIO . groupByOperator =<< withFastStore (`getUserServers` user) - case L.nonEmpty userServers_ of - Nothing -> throwChatError $ CECommandError "no servers" - Just userServers -> case srvs of - [] -> throwChatError $ CECommandError "no servers" - _ -> do - srvs' <- mapM aUserServer srvs - processChatCommand $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers - where - aUserServer :: AProtoServerWithAuth -> CM (AUserServer p) - aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of - Just Refl -> pure $ AUS SDBNew $ newUserServer srv - Nothing -> throwChatError $ CECommandError $ "incorrect server protocol: " <> B.unpack (strEncode srv) - APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user -> - lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server) - TestProtoServer srv -> withUser $ \User {userId} -> - processChatCommand $ APITestProtoServer userId srv - APIGetServerOperators -> CRServerOperatorConditions <$> withFastStore getServerOperators - APISetServerOperators operators -> do - as <- asks randomAgentServers - (opsConds, srvs) <- withFastStore $ \db -> do - liftIO $ setServerOperators db operators - opsConds <- getServerOperators db - let ops = serverOperators opsConds - ops' = map Just ops <> [Nothing] - opDomains = operatorDomains ops - liftIO $ fmap (opsConds,) . mapM (getServers db as ops' opDomains) =<< getUsers db - lift $ withAgent' $ \a -> forM_ srvs $ \(auId, (smp', xftp')) -> do - setProtocolServers a auId smp' - setProtocolServers a auId xftp' - pure $ CRServerOperatorConditions opsConds - where - getServers :: DB.Connection -> RandomAgentServers -> [Maybe ServerOperator] -> [(Text, ServerOperator)] -> User -> IO (UserId, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))) - getServers db as ops opDomains user = do - smpSrvs <- getProtocolServers db SPSMP user - xftpSrvs <- getProtocolServers db SPXFTP user - uss <- groupByOperator (ops, smpSrvs, xftpSrvs) - pure $ (aUserId user,) $ useServers as opDomains uss - SetServerOperators operatorsRoles -> do - ops <- serverOperators <$> withFastStore getServerOperators - ops' <- mapM (updateOp ops) operatorsRoles - processChatCommand $ APISetServerOperators ops' - where - updateOp :: [ServerOperator] -> ServerOperatorRoles -> CM ServerOperator - updateOp ops r = - case find (\ServerOperator {operatorId = DBEntityId opId} -> operatorId' r == opId) ops of - Just op -> pure op {enabled = enabled' r, smpRoles = smpRoles' r, xftpRoles = xftpRoles' r} - Nothing -> throwError $ ChatErrorStore $ SEOperatorNotFound $ operatorId' r - APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db -> do - CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user) - APISetUserServers userId userServers -> withUserId userId $ \user -> do - errors <- validateAllUsersServers userId $ L.toList userServers - unless (null errors) $ throwChatError (CECommandError $ "user servers validation error(s): " <> show errors) - uss <- withFastStore $ \db -> do - ts <- liftIO getCurrentTime - mapM (setUserServers db user ts) userServers - as <- asks randomAgentServers - lift $ withAgent' $ \a -> do - let auId = aUserId user - opDomains = operatorDomains $ mapMaybe operator' $ L.toList uss - (smp', xftp') = useServers as opDomains uss - setProtocolServers a auId smp' - setProtocolServers a auId xftp' - ok_ - APIValidateServers userId userServers -> withUserId userId $ \user -> - CRUserServersValidation user <$> validateAllUsersServers userId userServers - APIGetUsageConditions -> do - (usageConditions, acceptedConditions) <- withFastStore $ \db -> do - usageConditions <- getCurrentUsageConditions db - acceptedConditions <- liftIO $ getLatestAcceptedConditions db - pure (usageConditions, acceptedConditions) - -- TODO if db commit is different from source commit, conditionsText should be nothing in response - pure - CRUsageConditions - { usageConditions, - conditionsText = usageConditionsText, - acceptedConditions - } - APISetConditionsNotified condId -> do - currentTs <- liftIO getCurrentTime - withFastStore' $ \db -> setConditionsNotified db condId currentTs - ok_ - APIAcceptConditions condId opIds -> withFastStore $ \db -> do - currentTs <- liftIO getCurrentTime - acceptConditions db condId opIds currentTs - CRServerOperatorConditions <$> getServerOperators db - APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user -> - checkStoreNotChanged $ - withChatLock "setChatItemTTL" $ do - case newTTL_ of - Nothing -> do - withFastStore' $ \db -> setChatItemTTL db user newTTL_ - lift $ setExpireCIFlag user False - Just newTTL -> do - oldTTL <- withFastStore' (`getChatItemTTL` user) - when (maybe True (newTTL <) oldTTL) $ do - lift $ setExpireCIFlag user False - expireChatItems user newTTL True - withFastStore' $ \db -> setChatItemTTL db user newTTL_ - lift $ startExpireCIThread user - lift . whenM chatStarted $ setExpireCIFlag user True - ok user - SetChatItemTTL newTTL_ -> withUser' $ \User {userId} -> do - processChatCommand $ APISetChatItemTTL userId newTTL_ - APIGetChatItemTTL userId -> withUserId' userId $ \user -> do - ttl <- withFastStore' (`getChatItemTTL` user) - pure $ CRChatItemTTL user ttl - GetChatItemTTL -> withUser' $ \User {userId} -> do - processChatCommand $ APIGetChatItemTTL userId - APISetNetworkConfig cfg -> withUser' $ \_ -> lift (withAgent' (`setNetworkConfig` cfg)) >> ok_ - APIGetNetworkConfig -> withUser' $ \_ -> - CRNetworkConfig <$> lift getNetworkConfig - SetNetworkConfig simpleNetCfg -> do - cfg <- (`updateNetworkConfig` simpleNetCfg) <$> lift getNetworkConfig - void . processChatCommand $ APISetNetworkConfig cfg - pure $ CRNetworkConfig cfg - APISetNetworkInfo info -> lift (withAgent' (`setUserNetworkInfo` info)) >> ok_ - ReconnectAllServers -> withUser' $ \_ -> lift (withAgent' reconnectAllServers) >> ok_ - ReconnectServer userId srv -> withUserId userId $ \user -> do - lift (withAgent' $ \a -> reconnectSMPServer a (aUserId user) srv) - ok_ - APISetChatSettings (ChatRef cType chatId) chatSettings -> withUser $ \user -> case cType of - CTDirect -> do - ct <- withFastStore $ \db -> do - ct <- getContact db vr user chatId - liftIO $ updateContactSettings db user chatId chatSettings - pure ct - forM_ (contactConnId ct) $ \connId -> - withAgent $ \a -> toggleConnectionNtfs a connId (chatHasNtfs chatSettings) - ok user - CTGroup -> do - ms <- withFastStore $ \db -> do - Group _ ms <- getGroup db vr user chatId - liftIO $ updateGroupSettings db user chatId chatSettings - pure ms - forM_ (filter memberActive ms) $ \m -> forM_ (memberConnId m) $ \connId -> - withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchChatError` (toView . CRChatError (Just user)) - ok user - _ -> pure $ chatCmdError (Just user) "not supported" - APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do - m <- withFastStore $ \db -> do - liftIO $ updateGroupMemberSettings db user gId gMemberId settings - getGroupMember db vr user gId gMemberId - let ntfOn = showMessages $ memberSettings m - toggleNtf user m ntfOn - ok user - APIContactInfo contactId -> withUser $ \user@User {userId} -> do - -- [incognito] print user's incognito profile for this contact - ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId - incognitoProfile <- case activeConn of - Nothing -> pure Nothing - Just Connection {customUserProfileId} -> - forM customUserProfileId $ \profileId -> withFastStore (\db -> getProfileById db userId profileId) - connectionStats <- mapM (withAgent . flip getConnectionServers) (contactConnId ct) - pure $ CRContactInfo user ct connectionStats (fmap fromLocalProfile incognitoProfile) - APIContactQueueInfo contactId -> withUser $ \user -> do - ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId - case activeConn of - Just conn -> getConnQueueInfo user conn - Nothing -> throwChatError $ CEContactNotActive ct - APIGroupInfo gId -> withUser $ \user -> do - (g, s) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> liftIO (getGroupSummary db user gId) - pure $ CRGroupInfo user g s - APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do - (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId - connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) - pure $ CRGroupMemberInfo user g m connectionStats - APIGroupMemberQueueInfo gId gMemberId -> withUser $ \user -> do - GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId - case activeConn of - Just conn -> getConnQueueInfo user conn - Nothing -> throwChatError CEGroupMemberNotActive - APISwitchContact contactId -> withUser $ \user -> do - ct <- withFastStore $ \db -> getContact db vr user contactId - case contactConnId ct of - Just connId -> do - connectionStats <- withAgent $ \a -> switchConnectionAsync a "" connId - pure $ CRContactSwitchStarted user ct connectionStats - Nothing -> throwChatError $ CEContactNotActive ct - APISwitchGroupMember gId gMemberId -> withUser $ \user -> do - (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId - case memberConnId m of - Just connId -> do - connectionStats <- withAgent (\a -> switchConnectionAsync a "" connId) - pure $ CRGroupMemberSwitchStarted user g m connectionStats - _ -> throwChatError CEGroupMemberNotActive - APIAbortSwitchContact contactId -> withUser $ \user -> do - ct <- withFastStore $ \db -> getContact db vr user contactId - case contactConnId ct of - Just connId -> do - connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId - pure $ CRContactSwitchAborted user ct connectionStats - Nothing -> throwChatError $ CEContactNotActive ct - APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do - (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId - case memberConnId m of - Just connId -> do - connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId - pure $ CRGroupMemberSwitchAborted user g m connectionStats - _ -> throwChatError CEGroupMemberNotActive - APISyncContactRatchet contactId force -> withUser $ \user -> withContactLock "syncContactRatchet" contactId $ do - ct <- withFastStore $ \db -> getContact db vr user contactId - case contactConn ct of - Just conn@Connection {pqSupport} -> do - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) pqSupport force - createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing - pure $ CRContactRatchetSyncStarted user ct cStats - Nothing -> throwChatError $ CEContactNotActive ct - APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withGroupLock "syncGroupMemberRatchet" gId $ do - (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId - case memberConnId m of - Just connId -> do - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId PQSupportOff force - createInternalChatItem user (CDGroupSnd g) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing - pure $ CRGroupMemberRatchetSyncStarted user g m cStats - _ -> throwChatError CEGroupMemberNotActive - APIGetContactCode contactId -> withUser $ \user -> do - ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId - case activeConn of - Just conn@Connection {connId} -> do - code <- getConnectionCode $ aConnId conn - ct' <- case contactSecurityCode ct of - Just SecurityCode {securityCode} - | sameVerificationCode code securityCode -> pure ct - | otherwise -> do - withFastStore' $ \db -> setConnectionVerified db user connId Nothing - pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} - _ -> pure ct - pure $ CRContactCode user ct' code - Nothing -> throwChatError $ CEContactNotActive ct - APIGetGroupMemberCode gId gMemberId -> withUser $ \user -> do - (g, m@GroupMember {activeConn}) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId - case activeConn of - Just conn@Connection {connId} -> do - code <- getConnectionCode $ aConnId conn - m' <- case memberSecurityCode m of - Just SecurityCode {securityCode} - | sameVerificationCode code securityCode -> pure m - | otherwise -> do - withFastStore' $ \db -> setConnectionVerified db user connId Nothing - pure (m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} - _ -> pure m - pure $ CRGroupMemberCode user g m' code - _ -> throwChatError CEGroupMemberNotActive - APIVerifyContact contactId code -> withUser $ \user -> do - ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId - case activeConn of - Just conn -> verifyConnectionCode user conn code - Nothing -> throwChatError $ CEContactNotActive ct - APIVerifyGroupMember gId gMemberId code -> withUser $ \user -> do - GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId - case activeConn of - Just conn -> verifyConnectionCode user conn code - _ -> throwChatError CEGroupMemberNotActive - APIEnableContact contactId -> withUser $ \user -> do - ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId - case activeConn of - Just conn -> do - withFastStore' $ \db -> setAuthErrCounter db user conn 0 - ok user - Nothing -> throwChatError $ CEContactNotActive ct - APIEnableGroupMember gId gMemberId -> withUser $ \user -> do - GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId - case activeConn of - Just conn -> do - withFastStore' $ \db -> setAuthErrCounter db user conn 0 - ok user - _ -> throwChatError CEGroupMemberNotActive - SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn}) - SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_}) - SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do - (gId, mId) <- getGroupAndMemberId user gName mName - gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId - m <- withFastStore $ \db -> getGroupMember db vr user gId mId - let GroupInfo {membership = GroupMember {memberRole = membershipRole}} = gInfo - when (membershipRole >= GRAdmin) $ throwChatError $ CECantBlockMemberForSelf gInfo m showMessages - let settings = (memberSettings m) {showMessages} - processChatCommand $ APISetMemberSettings gId mId settings - ContactInfo cName -> withContactName cName APIContactInfo - ShowGroupInfo gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIGroupInfo groupId - GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo - ContactQueueInfo cName -> withContactName cName APIContactQueueInfo - GroupMemberQueueInfo gName mName -> withMemberName gName mName APIGroupMemberQueueInfo - SwitchContact cName -> withContactName cName APISwitchContact - SwitchGroupMember gName mName -> withMemberName gName mName APISwitchGroupMember - AbortSwitchContact cName -> withContactName cName APIAbortSwitchContact - AbortSwitchGroupMember gName mName -> withMemberName gName mName APIAbortSwitchGroupMember - SyncContactRatchet cName force -> withContactName cName $ \ctId -> APISyncContactRatchet ctId force - SyncGroupMemberRatchet gName mName force -> withMemberName gName mName $ \gId mId -> APISyncGroupMemberRatchet gId mId force - GetContactCode cName -> withContactName cName APIGetContactCode - GetGroupMemberCode gName mName -> withMemberName gName mName APIGetGroupMemberCode - VerifyContact cName code -> withContactName cName (`APIVerifyContact` code) - VerifyGroupMember gName mName code -> withMemberName gName mName $ \gId mId -> APIVerifyGroupMember gId mId code - EnableContact cName -> withContactName cName APIEnableContact - EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId - ChatHelp section -> pure $ CRChatHelp section - Welcome -> withUser $ pure . CRWelcome - APIAddContact userId incognito -> withUserId userId $ \user -> procCmd $ do - -- [incognito] generate profile for connection - incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOn subMode - -- TODO PQ pass minVersion from the current range - conn <- withFastStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode initialChatVersion PQSupportOn - pure $ CRInvitation user cReq conn - AddContact incognito -> withUser $ \User {userId} -> - processChatCommand $ APIAddContact userId incognito - APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do - conn'_ <- withFastStore $ \db -> do - conn@PendingContactConnection {pccConnStatus, customUserProfileId} <- getPendingContactConnection db userId connId - case (pccConnStatus, customUserProfileId, incognito) of - (ConnNew, Nothing, True) -> liftIO $ do - incognitoProfile <- generateRandomProfile - pId <- createIncognitoProfile db user incognitoProfile - Just <$> updatePCCIncognito db user conn (Just pId) - (ConnNew, Just pId, False) -> liftIO $ do - deletePCCIncognitoProfile db user pId - Just <$> updatePCCIncognito db user conn Nothing - _ -> pure Nothing - case conn'_ of - Just conn' -> pure $ CRConnectionIncognitoUpdated user conn' - Nothing -> throwChatError CEConnectionIncognitoChangeProhibited - APIChangeConnectionUser connId newUserId -> withUser $ \user@User {userId} -> do - conn <- withFastStore $ \db -> getPendingContactConnection db userId connId - let PendingContactConnection {pccConnStatus, connReqInv} = conn - case (pccConnStatus, connReqInv) of - (ConnNew, Just cReqInv) -> do - newUser <- privateGetUser newUserId - conn' <- ifM (canKeepLink cReqInv newUser) (updateConnRecord user conn newUser) (recreateConn user conn newUser) - pure $ CRConnectionUserChanged user conn conn' newUser - _ -> throwChatError CEConnectionUserChangeProhibited - where - canKeepLink :: ConnReqInvitation -> User -> CM Bool - canKeepLink (CRInvitationUri crData _) newUser = do - let ConnReqUriData {crSmpQueues = q :| _} = crData - SMPQueueUri {queueAddress = SMPQueueAddress {smpServer}} = q - newUserServers <- - map protoServer' . L.filter (\ServerCfg {enabled} -> enabled) - <$> getKnownAgentServers SPSMP newUser - pure $ smpServer `elem` newUserServers - updateConnRecord user@User {userId} conn@PendingContactConnection {customUserProfileId} newUser = do - withAgent $ \a -> changeConnectionUser a (aUserId user) (aConnId' conn) (aUserId newUser) - withFastStore' $ \db -> do - conn' <- updatePCCUser db userId conn newUserId - forM_ customUserProfileId $ \profileId -> - deletePCCIncognitoProfile db user profileId - pure conn' - recreateConn user conn@PendingContactConnection {customUserProfileId} newUser = do - subMode <- chatReadVar subscriptionMode - (agConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId newUser) True SCMInvitation Nothing IKPQOn subMode - conn' <- withFastStore' $ \db -> do - deleteConnectionRecord db user connId - forM_ customUserProfileId $ \profileId -> - deletePCCIncognitoProfile db user profileId - createDirectConnection db newUser agConnId cReq ConnNew Nothing subMode initialChatVersion PQSupportOn - deleteAgentConnectionAsync user (aConnId' conn) - pure conn' - APIConnectPlan userId cReqUri -> withUserId userId $ \user -> - CRConnectionPlan user <$> connectPlan user cReqUri - APIConnect userId incognito (Just (ACR SCMInvitation cReq@(CRInvitationUri crData e2e))) -> withUserId userId $ \user -> withInvitationLock "connect" (strEncode cReq) . procCmd $ do - subMode <- chatReadVar subscriptionMode - -- [incognito] generate profile to send - incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - let profileToSend = userProfileToSend user incognitoProfile Nothing False - lift (withAgent' $ \a -> connRequestPQSupport a PQSupportOn cReq) >>= \case - Nothing -> throwChatError CEInvalidConnReq - -- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan - Just (agentV, pqSup') -> do - let chatV = agentToChatVersion agentV - dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend - withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqs) >>= \case - Nothing -> joinNewConn chatV dm - Just (RcvDirectMsgConnection conn@Connection {connId, connStatus, contactConnInitiated} Nothing) - | connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV dm -- own connection link - | connStatus == ConnPrepared -> do - -- retrying join after error - pcc <- withFastStore $ \db -> getPendingContactConnection db userId connId - joinPreparedConn (aConnId conn) pcc dm - Just ent -> throwChatError $ CECommandError $ "connection exists: " <> show (connEntityInfo ent) - where - joinNewConn chatV dm = do - connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup' - pcc <- withFastStore' $ \db -> createDirectConnection db user connId cReq ConnPrepared (incognitoProfile $> profileToSend) subMode chatV pqSup' - joinPreparedConn connId pcc dm - joinPreparedConn connId pcc@PendingContactConnection {pccConnId} dm = do - void $ withAgent $ \a -> joinConnection a (aUserId user) connId True cReq dm pqSup' subMode - withFastStore' $ \db -> updateConnectionStatusFromTo db pccConnId ConnPrepared ConnJoined - pure $ CRSentConfirmation user pcc {pccConnStatus = ConnJoined} - cReqs = - ( CRInvitationUri crData {crScheme = SSSimplex} e2e, - CRInvitationUri crData {crScheme = simplexChat} e2e - ) - APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq - APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq - Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do - plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk) - unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan) - case plan of - CPContactAddress (CAPContactViaAddress Contact {contactId}) -> - processChatCommand $ APIConnectContactViaAddress userId incognito contactId - _ -> processChatCommand $ APIConnect userId incognito aCReqUri - Connect _ Nothing -> throwChatError CEInvalidConnReq - APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do - ct@Contact {activeConn, profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db vr user contactId - when (isJust activeConn) $ throwChatError (CECommandError "contact already has connection") - case contactLink of - Just cReq -> connectContactViaAddress user incognito ct cReq - Nothing -> throwChatError (CECommandError "no address in contact profile") - ConnectSimplex incognito -> withUser $ \user@User {userId} -> do - let cReqUri = ACR SCMContact adminContactReq - plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk) - unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan) - case plan of - CPContactAddress (CAPContactViaAddress Contact {contactId}) -> - processChatCommand $ APIConnectContactViaAddress userId incognito contactId - _ -> processChatCommand $ APIConnect userId incognito (Just cReqUri) - DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) cdm - ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect - APIListContacts userId -> withUserId userId $ \user -> - CRContactsList user <$> withFastStore' (\db -> getUserContacts db vr user) - ListContacts -> withUser $ \User {userId} -> - processChatCommand $ APIListContacts userId - APICreateMyAddress userId -> withUserId userId $ \user -> procCmd $ do - subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing IKPQOn subMode - withFastStore $ \db -> createUserContactLink db user connId cReq subMode - pure $ CRUserContactLinkCreated user cReq - CreateMyAddress -> withUser $ \User {userId} -> - processChatCommand $ APICreateMyAddress userId - APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do - conns <- withFastStore $ \db -> getUserAddressConnections db vr user - withChatLock "deleteMyAddress" $ do - deleteAgentConnectionsAsync user $ map aConnId conns - withFastStore' (`deleteUserAddress` user) - let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} - r <- updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing - let user' = case r of - CRUserProfileUpdated u' _ _ _ -> u' - _ -> user - pure $ CRUserContactLinkDeleted user' - DeleteMyAddress -> withUser $ \User {userId} -> - processChatCommand $ APIDeleteMyAddress userId - APIShowMyAddress userId -> withUserId' userId $ \user -> - CRUserContactLink user <$> withFastStore (`getUserAddress` user) - ShowMyAddress -> withUser' $ \User {userId} -> - processChatCommand $ APIShowMyAddress userId - APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do - let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} - updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing - APISetProfileAddress userId True -> withUserId userId $ \user@User {profile = p} -> do - ucl@UserContactLink {connReqContact} <- withFastStore (`getUserAddress` user) - let p' = (fromLocalProfile p :: Profile) {contactLink = Just connReqContact} - updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl - SetProfileAddress onOff -> withUser $ \User {userId} -> - processChatCommand $ APISetProfileAddress userId onOff - APIAddressAutoAccept userId autoAccept_ -> withUserId userId $ \user -> do - forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} -> - when (businessAddress && acceptIncognito) $ throwChatError $ CECommandError "requests to business address cannot be accepted incognito" - contactLink <- withFastStore (\db -> updateUserAddressAutoAccept db user autoAccept_) - pure $ CRUserContactLinkUpdated user contactLink - AddressAutoAccept autoAccept_ -> withUser $ \User {userId} -> - processChatCommand $ APIAddressAutoAccept userId autoAccept_ - AcceptContact incognito cName -> withUser $ \User {userId} -> do - connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName - processChatCommand $ APIAcceptContact incognito connReqId - RejectContact cName -> withUser $ \User {userId} -> do - connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName - processChatCommand $ APIRejectContact connReqId - ForwardMessage toChatName fromContactName forwardedMsg -> withUser $ \user -> do - contactId <- withFastStore $ \db -> getContactIdByName db user fromContactName - forwardedItemId <- withFastStore $ \db -> getDirectChatItemIdByText' db user contactId forwardedMsg - toChatRef <- getChatRef user toChatName - processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTDirect contactId) (forwardedItemId :| []) Nothing - ForwardGroupMessage toChatName fromGroupName fromMemberName_ forwardedMsg -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user fromGroupName - forwardedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId fromMemberName_ forwardedMsg - toChatRef <- getChatRef user toChatName - processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTGroup groupId) (forwardedItemId :| []) Nothing - ForwardLocalMessage toChatName forwardedMsg -> withUser $ \user -> do - folderId <- withFastStore (`getUserNoteFolderId` user) - forwardedItemId <- withFastStore $ \db -> getLocalChatItemIdByText' db user folderId forwardedMsg - toChatRef <- getChatRef user toChatName - processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTLocal folderId) (forwardedItemId :| []) Nothing - SendMessage (ChatName cType name) msg -> withUser $ \user -> do - let mc = MCText msg - case cType of - CTDirect -> - withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case - Right ctId -> do - let chatRef = ChatRef CTDirect ctId - processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| []) - Left _ -> - withFastStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case - Right [(gInfo, member)] -> do - let GroupInfo {localDisplayName = gName} = gInfo - GroupMember {localDisplayName = mName} = member - processChatCommand $ SendMemberContactMessage gName mName msg - Right (suspectedMember : _) -> - throwChatError $ CEContactNotFound name (Just suspectedMember) - _ -> - throwChatError $ CEContactNotFound name Nothing - CTGroup -> do - gId <- withFastStore $ \db -> getGroupIdByName db user name - let chatRef = ChatRef CTGroup gId - processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| []) - CTLocal - | name == "" -> do - folderId <- withFastStore (`getUserNoteFolderId` user) - processChatCommand $ APICreateChatItems folderId (ComposedMessage Nothing Nothing mc :| []) - | otherwise -> throwChatError $ CECommandError "not supported" - _ -> throwChatError $ CECommandError "not supported" - SendMemberContactMessage gName mName msg -> withUser $ \user -> do - (gId, mId) <- getGroupAndMemberId user gName mName - m <- withFastStore $ \db -> getGroupMember db vr user gId mId - let mc = MCText msg - case memberContactId m of - Nothing -> do - g <- withFastStore $ \db -> getGroupInfo db vr user gId - unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwChatError $ CECommandError "direct messages not allowed" - toView $ CRNoMemberContactCreating user g m - processChatCommand (APICreateMemberContact gId mId) >>= \case - cr@(CRNewMemberContact _ Contact {contactId} _ _) -> do - toView cr - processChatCommand $ APISendMemberContactInvitation contactId (Just mc) - cr -> pure cr - Just ctId -> do - let chatRef = ChatRef CTDirect ctId - processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| []) - SendLiveMessage chatName msg -> withUser $ \user -> do - chatRef <- getChatRef user chatName - let mc = MCText msg - processChatCommand $ APISendMessages chatRef True Nothing (ComposedMessage Nothing Nothing mc :| []) - SendMessageBroadcast msg -> withUser $ \user -> do - contacts <- withFastStore' $ \db -> getUserContacts db vr user - withChatLock "sendMessageBroadcast" . procCmd $ do - let ctConns_ = L.nonEmpty $ foldr addContactConn [] contacts - case ctConns_ of - Nothing -> do - timestamp <- liftIO getCurrentTime - pure CRBroadcastSent {user, msgContent = mc, successes = 0, failures = 0, timestamp} - Just (ctConns :: NonEmpty (Contact, Connection)) -> do - let idsEvts = L.map ctSndEvent ctConns - sndMsgs <- lift $ createSndMessages idsEvts - let msgReqs_ :: NonEmpty (Either ChatError ChatMsgReq) = L.zipWith (fmap . ctMsgReq) ctConns sndMsgs - (errs, ctSndMsgs :: [(Contact, SndMessage)]) <- - partitionEithers . L.toList . zipWith3' combineResults ctConns sndMsgs <$> deliverMessagesB msgReqs_ - timestamp <- liftIO getCurrentTime - lift . void $ withStoreBatch' $ \db -> map (createCI db user timestamp) ctSndMsgs - pure CRBroadcastSent {user, msgContent = mc, successes = length ctSndMsgs, failures = length errs, timestamp} - where - mc = MCText msg - addContactConn :: Contact -> [(Contact, Connection)] -> [(Contact, Connection)] - addContactConn ct ctConns = case contactSendConn_ ct of - Right conn | directOrUsed ct -> (ct, conn) : ctConns - _ -> ctConns - ctSndEvent :: (Contact, Connection) -> (ConnOrGroupId, ChatMsgEvent 'Json) - ctSndEvent (_, Connection {connId}) = (ConnectionId connId, XMsgNew $ MCSimple (extMsgContent mc Nothing)) - ctMsgReq :: (Contact, Connection) -> SndMessage -> ChatMsgReq - ctMsgReq (_, conn) SndMessage {msgId, msgBody} = (conn, MsgFlags {notification = hasNotification XMsgNew_}, msgBody, [msgId]) - zipWith3' :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d - zipWith3' f ~(x :| xs) ~(y :| ys) ~(z :| zs) = f x y z :| zipWith3 f xs ys zs - combineResults :: (Contact, Connection) -> Either ChatError SndMessage -> Either ChatError ([Int64], PQEncryption) -> Either ChatError (Contact, SndMessage) - combineResults (ct, _) (Right msg') (Right _) = Right (ct, msg') - combineResults _ (Left e) _ = Left e - combineResults _ _ (Left e) = Left e - createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO () - createCI db user createdAt (ct, sndMsg) = - void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt - SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do - contactId <- withFastStore $ \db -> getContactIdByName db user cName - quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg - let mc = MCText msg - processChatCommand $ APISendMessages (ChatRef CTDirect contactId) False Nothing (ComposedMessage Nothing (Just quotedItemId) mc :| []) - DeleteMessage chatName deletedMsg -> withUser $ \user -> do - chatRef <- getChatRef user chatName - deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg - processChatCommand $ APIDeleteChatItem chatRef (deletedItemId :| []) CIDMBroadcast - DeleteMemberMessage gName mName deletedMsg -> withUser $ \user -> do - gId <- withFastStore $ \db -> getGroupIdByName db user gName - deletedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId (Just mName) deletedMsg - processChatCommand $ APIDeleteMemberChatItem gId (deletedItemId :| []) - EditMessage chatName editedMsg msg -> withUser $ \user -> do - chatRef <- getChatRef user chatName - editedItemId <- getSentChatItemIdByText user chatRef editedMsg - let mc = MCText msg - processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc - UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do - chatRef <- getChatRef user chatName - let mc = MCText msg - processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc - ReactToMessage add reaction chatName msg -> withUser $ \user -> do - chatRef <- getChatRef user chatName - chatItemId <- getChatItemIdByText user chatRef msg - processChatCommand $ APIChatItemReaction chatRef chatItemId add reaction - APINewGroup userId incognito gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do - checkValidName displayName - gVar <- asks random - -- [incognito] generate incognito profile for group membership - incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - gInfo <- withFastStore $ \db -> createNewGroup db vr gVar user gProfile incognitoProfile - let cd = CDGroupSnd gInfo - createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing - createGroupFeatureItems user cd CISndGroupFeature gInfo - pure $ CRGroupCreated user gInfo - NewGroup incognito gProfile -> withUser $ \User {userId} -> - processChatCommand $ APINewGroup userId incognito gProfile - APIAddMember groupId contactId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do - -- TODO for large groups: no need to load all members to determine if contact is a member - (group, contact) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId - assertDirectAllowed user MDSnd contact XGrpInv_ - let Group gInfo members = group - Contact {localDisplayName = cName} = contact - assertUserGroupRole gInfo $ max GRAdmin memRole - -- [incognito] forbid to invite contact to whom user is connected incognito - when (contactConnIncognito contact) $ throwChatError CEContactIncognitoCantInvite - -- [incognito] forbid to invite contacts if user joined the group using an incognito profile - when (incognitoMembership gInfo) $ throwChatError CEGroupIncognitoCantInvite - let sendInvitation = sendGrpInvitation user contact gInfo - case contactMember contact members of - Nothing -> do - gVar <- asks random - subMode <- chatReadVar subscriptionMode - (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode - member <- withFastStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode - sendInvitation member cReq - pure $ CRSentGroupInvitation user gInfo contact member - Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole} - | memberStatus == GSMemInvited -> do - unless (mRole == memRole) $ withFastStore' $ \db -> updateGroupMemberRole db user member memRole - withFastStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case - Just cReq -> do - sendInvitation member {memberRole = memRole} cReq - pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole} - Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName - | otherwise -> throwChatError $ CEGroupDuplicateMember cName - APIJoinGroup groupId -> withUser $ \user@User {userId} -> do - withGroupLock "joinGroup" groupId . procCmd $ do - (invitation, ct) <- withFastStore $ \db -> do - inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId - (inv,) <$> getContactViaMember db vr user fromMember - let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation - GroupMember {memberId = membershipMemId} = membership - Contact {activeConn} = ct - case activeConn of - Just Connection {peerChatVRange} -> do - subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XGrpAcpt membershipMemId - agentConnId <- case memberConn fromMember of - Nothing -> do - agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff - let chatV = vr `peerConnChatVersion` peerChatVRange - void $ withFastStore' $ \db -> createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode - pure agentConnId - Just conn -> pure $ aConnId conn - withFastStore' $ \db -> do - updateGroupMemberStatus db userId fromMember GSMemAccepted - updateGroupMemberStatus db userId membership GSMemAccepted - void (withAgent $ \a -> joinConnection a (aUserId user) agentConnId True connRequest dm PQSupportOff subMode) - `catchChatError` \e -> do - withFastStore' $ \db -> do - updateGroupMemberStatus db userId fromMember GSMemInvited - updateGroupMemberStatus db userId membership GSMemInvited - throwError e - updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user)) - pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing - Nothing -> throwChatError $ CEContactNotActive ct - APIMemberRole groupId memberId memRole -> withUser $ \user -> do - Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId - if memberId == groupMemberId' membership - then changeMemberRole user gInfo members membership $ SGEUserRole memRole - else case find ((== memberId) . groupMemberId') members of - Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole - _ -> throwChatError CEGroupMemberNotFound - where - changeMemberRole user gInfo members m gEvent = do - let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m - assertUserGroupRole gInfo $ maximum ([GRAdmin, mRole, memRole] :: [GroupMemberRole]) - withGroupLock "memberRole" groupId . procCmd $ do - unless (mRole == memRole) $ do - withFastStore' $ \db -> updateGroupMemberRole db user m memRole - case mStatus of - GSMemInvited -> do - withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case - (Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq - _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName - _ -> do - msg <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] - pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole} - APIBlockMemberForAll groupId memberId blocked -> withUser $ \user -> do - Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId - when (memberId == groupMemberId' membership) $ throwChatError $ CECommandError "can't block/unblock self" - case splitMember memberId members of - Nothing -> throwChatError $ CEException "expected to find a single blocked member" - Just (bm, remainingMembers) -> do - let GroupMember {memberId = bmMemberId, memberRole = bmRole, memberProfile = bmp} = bm - assertUserGroupRole gInfo $ max GRAdmin bmRole - when (blocked == blockedByAdmin bm) $ throwChatError $ CECommandError $ if blocked then "already blocked" else "already unblocked" - withGroupLock "blockForAll" groupId . procCmd $ do - let mrs = if blocked then MRSBlocked else MRSUnrestricted - event = XGrpMemRestrict bmMemberId MemberRestrictions {restriction = mrs} - msg <- sendGroupMessage' user gInfo remainingMembers event - let ciContent = CISndGroupEvent $ SGEMemberBlocked memberId (fromLocalProfile bmp) blocked - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] - bm' <- withFastStore $ \db -> do - liftIO $ updateGroupMemberBlocked db user groupId memberId mrs - getGroupMember db vr user groupId memberId - toggleNtf user bm' (not blocked) - pure CRMemberBlockedForAllUser {user, groupInfo = gInfo, member = bm', blocked} - where - splitMember mId ms = case break ((== mId) . groupMemberId') ms of - (_, []) -> Nothing - (ms1, bm : ms2) -> Just (bm, ms1 <> ms2) - APIRemoveMember groupId memberId -> withUser $ \user -> do - Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId - case find ((== memberId) . groupMemberId') members of - Nothing -> throwChatError CEGroupMemberNotFound - Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do - assertUserGroupRole gInfo $ max GRAdmin mRole - withGroupLock "removeMember" groupId . procCmd $ do - case mStatus of - GSMemInvited -> do - deleteMemberConnection user m - withFastStore' $ \db -> deleteGroupMember db user m - _ -> do - msg <- sendGroupMessage user gInfo members $ XGrpMemDel mId - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] - deleteMemberConnection' user m True - -- undeleted "member connected" chat item will prevent deletion of member record - deleteOrUpdateMemberRecord user m - pure $ CRUserDeletedMember user gInfo m {memberStatus = GSMemRemoved} - APILeaveGroup groupId -> withUser $ \user@User {userId} -> do - Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId - filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo - withGroupLock "leaveGroup" groupId . procCmd $ do - cancelFilesInProgress user filesInfo - msg <- sendGroupMessage' user gInfo members XGrpLeave - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] - -- TODO delete direct connections that were unused - deleteGroupLinkIfExists user gInfo - -- member records are not deleted to keep history - deleteMembersConnections' user members True - withFastStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft - pure $ CRLeftMemberUser user gInfo {membership = membership {memberStatus = GSMemLeft}} - APIListMembers groupId -> withUser $ \user -> - CRGroupMembers user <$> withFastStore (\db -> getGroup db vr user groupId) - AddMember gName cName memRole -> withUser $ \user -> do - (groupId, contactId) <- withFastStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db user cName - processChatCommand $ APIAddMember groupId contactId memRole - JoinGroup gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIJoinGroup groupId - MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMemberRole gId gMemberId memRole - BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMemberForAll gId gMemberId blocked - RemoveMember gName gMemberName -> withMemberName gName gMemberName APIRemoveMember - LeaveGroup gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APILeaveGroup groupId - DeleteGroup gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) (CDMFull True) - ClearGroup gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIClearChat (ChatRef CTGroup groupId) - ListMembers gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIListMembers groupId - APIListGroups userId contactId_ search_ -> withUserId userId $ \user -> - CRGroupsList user <$> withFastStore' (\db -> getUserGroupsWithSummary db vr user contactId_ search_) - ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do - ct_ <- forM cName_ $ \cName -> withFastStore $ \db -> getContactByName db vr user cName - processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_ - APIUpdateGroupProfile groupId p' -> withUser $ \user -> do - g <- withFastStore $ \db -> getGroup db vr user groupId - runUpdateGroupProfile user g p' - UpdateGroupNames gName GroupProfile {displayName, fullName} -> - updateGroupProfileByName gName $ \p -> p {displayName, fullName} - ShowGroupProfile gName -> withUser $ \user -> - CRGroupProfile user <$> withFastStore (\db -> getGroupInfoByName db vr user gName) - UpdateGroupDescription gName description -> - updateGroupProfileByName gName $ \p -> p {description} - ShowGroupDescription gName -> withUser $ \user -> - CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db vr user gName) - APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do - gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId - assertUserGroupRole gInfo GRAdmin - when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole - groupLinkId <- GroupLinkId <$> drgRandomBytes 16 - subMode <- chatReadVar subscriptionMode - let crClientData = encodeJSON $ CRDataGroup groupLinkId - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) IKPQOff subMode - withFastStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode - pure $ CRGroupLinkCreated user gInfo cReq mRole - APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withGroupLock "groupLinkMemberRole" groupId $ do - gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId - (groupLinkId, groupLink, mRole) <- withFastStore $ \db -> getGroupLink db user gInfo - assertUserGroupRole gInfo GRAdmin - when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole' - when (mRole' /= mRole) $ withFastStore' $ \db -> setGroupLinkMemberRole db user groupLinkId mRole' - pure $ CRGroupLink user gInfo groupLink mRole' - APIDeleteGroupLink groupId -> withUser $ \user -> withGroupLock "deleteGroupLink" groupId $ do - gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId - deleteGroupLink' user gInfo - pure $ CRGroupLinkDeleted user gInfo - APIGetGroupLink groupId -> withUser $ \user -> do - gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId - (_, groupLink, mRole) <- withFastStore $ \db -> getGroupLink db user gInfo - pure $ CRGroupLink user gInfo groupLink mRole - APICreateMemberContact gId gMemberId -> withUser $ \user -> do - (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId - assertUserGroupRole g GRAuthor - unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwChatError $ CECommandError "direct messages not allowed" - case memberConn m of - Just mConn@Connection {peerChatVRange} -> do - unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible - when (isJust $ memberContactId m) $ throwChatError $ CECommandError "member contact already exists" - subMode <- chatReadVar subscriptionMode - -- TODO PQ should negotitate contact connection with PQSupportOn? - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode - -- [incognito] reuse membership incognito profile - ct <- withFastStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode - -- TODO not sure it is correct to set connections status here? - lift $ setContactNetworkStatus ct NSConnected - pure $ CRNewMemberContact user ct g m - _ -> throwChatError CEGroupMemberNotActive - APISendMemberContactInvitation contactId msgContent_ -> withUser $ \user -> do - (g@GroupInfo {groupId}, m, ct, cReq) <- withFastStore $ \db -> getMemberContact db vr user contactId - when (contactGrpInvSent ct) $ throwChatError $ CECommandError "x.grp.direct.inv already sent" - case memberConn m of - Just mConn -> do - let msg = XGrpDirectInv cReq msgContent_ - (sndMsg, _, _) <- sendDirectMemberMessage mConn msg groupId - withFastStore' $ \db -> setContactGrpInvSent db ct True - let ct' = ct {contactGrpInvSent = True} - forM_ msgContent_ $ \mc -> do - ci <- saveSndChatItem user (CDDirectSnd ct') sndMsg (CISndMsgContent mc) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci] - pure $ CRNewMemberContactSentInv user ct' g m - _ -> throwChatError CEGroupMemberNotActive - CreateGroupLink gName mRole -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APICreateGroupLink groupId mRole - GroupLinkMemberRole gName mRole -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIGroupLinkMemberRole groupId mRole - DeleteGroupLink gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIDeleteGroupLink groupId - ShowGroupLink gName -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - processChatCommand $ APIGetGroupLink groupId - SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do - groupId <- withFastStore $ \db -> getGroupIdByName db user gName - quotedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg - let mc = MCText msg - processChatCommand $ APISendMessages (ChatRef CTGroup groupId) False Nothing (ComposedMessage Nothing (Just quotedItemId) mc :| []) - ClearNoteFolder -> withUser $ \user -> do - folderId <- withFastStore (`getUserNoteFolderId` user) - processChatCommand $ APIClearChat (ChatRef CTLocal folderId) - LastChats count_ -> withUser' $ \user -> do - let count = fromMaybe 5000 count_ - (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user False (PTLast count) clqNoFilters) - unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs) - pure $ CRChats previews - LastMessages (Just chatName) count search -> withUser $ \user -> do - chatRef <- getChatRef user chatName - chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search - pure $ CRChatItems user (Just chatName) (aChatItems . chat $ chatResp) - LastMessages Nothing count search -> withUser $ \user -> do - chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast count) search - pure $ CRChatItems user Nothing chatItems - LastChatItemId (Just chatName) index -> withUser $ \user -> do - chatRef <- getChatRef user chatName - chatResp <- processChatCommand (APIGetChat chatRef (CPLast $ index + 1) Nothing) - pure $ CRChatItemId user (fmap aChatItemId . listToMaybe . aChatItems . chat $ chatResp) - LastChatItemId Nothing index -> withUser $ \user -> do - chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast $ index + 1) Nothing - pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems) - ShowChatItem (Just itemId) -> withUser $ \user -> do - chatItem <- withFastStore $ \db -> do - chatRef <- getChatRefViaItemId db user itemId - getAChatItem db vr user chatRef itemId - pure $ CRChatItems user Nothing ((: []) chatItem) - ShowChatItem Nothing -> withUser $ \user -> do - chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast 1) Nothing - pure $ CRChatItems user Nothing chatItems - ShowChatItemInfo chatName msg -> withUser $ \user -> do - chatRef <- getChatRef user chatName - itemId <- getChatItemIdByText user chatRef msg - processChatCommand $ APIGetChatItemInfo chatRef itemId - ShowLiveItems on -> withUser $ \_ -> - asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_ - SendFile chatName f -> withUser $ \user -> do - chatRef <- getChatRef user chatName - case chatRef of - ChatRef CTLocal folderId -> processChatCommand $ APICreateChatItems folderId (ComposedMessage (Just f) Nothing (MCFile "") :| []) - _ -> processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage (Just f) Nothing (MCFile "") :| []) - SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do - chatRef <- getChatRef user chatName - filePath <- lift $ toFSFilePath fPath - unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath} - fileSize <- getFileSize filePath - unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} - -- TODO include file description for preview - processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview) :| []) - ForwardFile chatName fileId -> forwardFile chatName fileId SendFile - ForwardImage chatName fileId -> forwardFile chatName fileId SendImage - SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO" - -- TODO to use priority transactions we need a parameter that differentiates manual and automatic acceptance - ReceiveFile fileId userApprovedRelays encrypted_ rcvInline_ filePath_ -> withUser $ \_ -> - withFileLock "receiveFile" fileId . procCmd $ do - (user, ft@RcvFileTransfer {fileStatus}) <- withStore (`getRcvFileTransferById` fileId) - encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles - ft' <- (if encrypt && fileStatus == RFSNew then setFileToEncrypt else pure) ft - receiveFile' user ft' userApprovedRelays rcvInline_ filePath_ - SetFileToReceive fileId userApprovedRelays encrypted_ -> withUser $ \_ -> do - withFileLock "setFileToReceive" fileId . procCmd $ do - encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles - cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing - withStore' $ \db -> setRcvFileToReceive db fileId userApprovedRelays cfArgs - ok_ - CancelFile fileId -> withUser $ \user@User {userId} -> - withFileLock "cancelFile" fileId . procCmd $ - withFastStore (\db -> getFileTransfer db user fileId) >>= \case - FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts - | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" - | not (null fts) && all fileCancelledOrCompleteSMP fts -> - throwChatError $ CEFileCancel fileId "file transfer is complete" - | otherwise -> do - fileAgentConnIds <- cancelSndFile user ftm fts True - deleteAgentConnectionsAsync user fileAgentConnIds - withFastStore (\db -> liftIO $ lookupChatRefByFileId db user fileId) >>= \case - Nothing -> pure () - Just (ChatRef CTDirect contactId) -> do - (contact, sharedMsgId) <- withFastStore $ \db -> (,) <$> getContact db vr user contactId <*> getSharedMsgIdByFileId db userId fileId - void . sendDirectContactMessage user contact $ XFileCancel sharedMsgId - Just (ChatRef CTGroup groupId) -> do - (Group gInfo ms, sharedMsgId) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getSharedMsgIdByFileId db userId fileId - void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId - Just _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" - ci <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId - pure $ CRSndFileCancelled user ci ftm fts - where - fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} = - s == FSCancelled || (s == FSComplete && isNothing xftpSndFile) - FTRcv ftr@RcvFileTransfer {cancelled, fileStatus, xftpRcvFile} - | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" - | rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete" - | otherwise -> case xftpRcvFile of - Nothing -> do - cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId - pure $ CRRcvFileCancelled user ci ftr - Just XFTPRcvFile {agentRcvFileId} -> do - forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do - fsFilePath <- lift $ toFSFilePath filePath - liftIO $ removeFile fsFilePath `catchAll_` pure () - lift . forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) -> - withAgent' (`xftpDeleteRcvFile` aFileId) - aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation - pure $ CRRcvFileCancelled user aci_ ftr - FileStatus fileId -> withUser $ \user -> do - withFastStore (\db -> lookupChatItemByFileId db vr user fileId) >>= \case - Nothing -> do - fileStatus <- withFastStore $ \db -> getFileTransferProgress db user fileId - pure $ CRFileTransferStatus user fileStatus - Just ci@(AChatItem _ _ _ ChatItem {file}) -> case file of - Just CIFile {fileProtocol = FPLocal} -> - throwChatError $ CECommandError "not supported for local files" - Just CIFile {fileProtocol = FPXFTP} -> - pure $ CRFileTransferStatusXFTP user ci - _ -> do - fileStatus <- withFastStore $ \db -> getFileTransferProgress db user fileId - pure $ CRFileTransferStatus user fileStatus - ShowProfile -> withUser $ \user@User {profile} -> pure $ CRUserProfile user (fromLocalProfile profile) - UpdateProfile displayName fullName -> withUser $ \user@User {profile} -> do - let p = (fromLocalProfile profile :: Profile) {displayName = displayName, fullName = fullName} - updateProfile user p - UpdateProfileImage image -> withUser $ \user@User {profile} -> do - let p = (fromLocalProfile profile :: Profile) {image} - updateProfile user p - ShowProfileImage -> withUser $ \user@User {profile} -> pure $ CRUserProfileImage user $ fromLocalProfile profile - SetUserFeature (ACF f) allowed -> withUser $ \user@User {profile} -> do - let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user} - updateProfile user p - SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do - ct@Contact {userPreferences} <- withFastStore $ \db -> getContactByName db vr user cName - let prefs' = setPreference f allowed_ $ Just userPreferences - updateContactPrefs user ct prefs' - SetGroupFeature (AGFNR f) gName enabled -> - updateGroupProfileByName gName $ \p -> - p {groupPreferences = Just . setGroupPreference f enabled $ groupPreferences p} - SetGroupFeatureRole (AGFR f) gName enabled role -> - updateGroupProfileByName gName $ \p -> - p {groupPreferences = Just . setGroupPreferenceRole f enabled role $ groupPreferences p} - SetUserTimedMessages onOff -> withUser $ \user@User {profile} -> do - let allowed = if onOff then FAYes else FANo - pref = TimedMessagesPreference allowed Nothing - p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user} - updateProfile user p - SetContactTimedMessages cName timedMessagesEnabled_ -> withUser $ \user -> do - ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withFastStore $ \db -> getContactByName db vr user cName - let currentTTL = timedMessages >>= \TimedMessagesPreference {ttl} -> ttl - pref_ = tmeToPref currentTTL <$> timedMessagesEnabled_ - prefs' = setPreference' SCFTimedMessages pref_ $ Just userPreferences - updateContactPrefs user ct prefs' - SetGroupTimedMessages gName ttl_ -> do - let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_ - updateGroupProfileByName gName $ \p -> - p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p} - SetLocalDeviceName name -> chatWriteVar localDeviceName name >> ok_ - ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts - SwitchRemoteHost rh_ -> CRCurrentRemoteHost <$> switchRemoteHost rh_ - StartRemoteHost rh_ ca_ bp_ -> do - (localAddrs, remoteHost_, inv@RCSignedInvitation {invitation = RCInvitation {port}}) <- startRemoteHost rh_ ca_ bp_ - pure CRRemoteHostStarted {remoteHost_, invitation = decodeLatin1 $ strEncode inv, ctrlPort = show port, localAddrs} - StopRemoteHost rh_ -> closeRemoteHost rh_ >> ok_ - DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_ - StoreRemoteFile rh encrypted_ localPath -> CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath - GetRemoteFile rh rf -> getRemoteFile rh rf >> ok_ - ConnectRemoteCtrl inv -> withUser_ $ do - (remoteCtrl_, ctrlAppInfo) <- connectRemoteCtrlURI inv - pure CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion = currentAppVersion} - FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl >> ok_ - ConfirmRemoteCtrl rcId -> withUser_ $ do - (rc, ctrlAppInfo) <- confirmRemoteCtrl rcId - pure CRRemoteCtrlConnecting {remoteCtrl_ = Just rc, ctrlAppInfo, appVersion = currentAppVersion} - VerifyRemoteCtrlSession sessId -> withUser_ $ CRRemoteCtrlConnected <$> verifyRemoteCtrlSession (execChatCommand Nothing) sessId - StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_ - ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls - DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_ - APIUploadStandaloneFile userId file@CryptoFile {filePath} -> withUserId userId $ \user -> do - fsFilePath <- lift $ toFSFilePath filePath - fileSize <- liftIO $ CF.getFileContentsSize file {filePath = fsFilePath} - when (fileSize > toInteger maxFileSizeHard) $ throwChatError $ CEFileSize filePath - (_, _, fileTransferMeta) <- xftpSndFileTransfer_ user file fileSize 1 Nothing - pure CRSndStandaloneFileCreated {user, fileTransferMeta} - APIStandaloneFileInfo FileDescriptionURI {clientData} -> pure . CRStandaloneFileInfo $ clientData >>= J.decodeStrict . encodeUtf8 - APIDownloadStandaloneFile userId uri file -> withUserId userId $ \user -> do - ft <- receiveViaURI user uri file - pure $ CRRcvStandaloneFileCreated user ft - QuitChat -> liftIO exitSuccess - ShowVersion -> do - -- simplexmqCommitQ makes iOS builds crash m( - let versionInfo = coreVersionInfo "" - chatMigrations <- map upMigration <$> withFastStore' (Migrations.getCurrent . DB.conn) - agentMigrations <- withAgent getAgentMigrations - pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations} - DebugLocks -> lift $ do - chatLockName <- atomically . tryReadTMVar =<< asks chatLock - chatEntityLocks <- getLocks =<< asks entityLocks - agentLocks <- withAgent' debugAgentLocks - pure CRDebugLocks {chatLockName, chatEntityLocks, agentLocks} - where - getLocks ls = atomically $ M.mapKeys enityLockString . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls) - enityLockString cle = case cle of - CLInvitation bs -> "Invitation " <> B.unpack bs - CLConnection connId -> "Connection " <> show connId - CLContact ctId -> "Contact " <> show ctId - CLGroup gId -> "Group " <> show gId - CLUserContact ucId -> "UserContact " <> show ucId - CLFile fId -> "File " <> show fId - DebugEvent event -> toView event >> ok_ - GetAgentSubsTotal userId -> withUserId userId $ \user -> do - users <- withStore' $ \db -> getUsers db - let userIds = map aUserId $ filter (\u -> isNothing (viewPwdHash u) || aUserId u == aUserId user) users - (subsTotal, hasSession) <- lift $ withAgent' $ \a -> getAgentSubsTotal a userIds - pure $ CRAgentSubsTotal user subsTotal hasSession - GetAgentServersSummary userId -> withUserId userId $ \user -> do - agentServersSummary <- lift $ withAgent' getAgentServersSummary - withStore' $ \db -> do - users <- getUsers db - smpServers <- getServers db user SPSMP - xftpServers <- getServers db user SPXFTP - let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers - pure $ CRAgentServersSummary user presentedServersSummary - where - getServers :: ProtocolTypeI p => DB.Connection -> User -> SProtocolType p -> IO [ProtocolServer p] - getServers db user p = map (\UserServer {server} -> protoServer server) <$> getProtocolServers db p user - ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_ - GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary - GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails - GetAgentSubs -> lift $ summary <$> withAgent' getAgentSubscriptions - where - summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} = - CRAgentSubs - { activeSubs = foldl' countSubs M.empty activeSubscriptions, - pendingSubs = foldl' countSubs M.empty pendingSubscriptions, - removedSubs = foldl' accSubErrors M.empty removedSubscriptions - } - where - countSubs m SubInfo {server} = M.alter (Just . maybe 1 (+ 1)) server m - accSubErrors m = \case - SubInfo {server, subError = Just e} -> M.alter (Just . maybe [e] (e :)) server m - _ -> m - GetAgentSubsDetails -> lift $ CRAgentSubsDetails <$> withAgent' getAgentSubscriptions - GetAgentQueuesInfo -> lift $ CRAgentQueuesInfo <$> withAgent' getAgentQueuesInfo - -- CustomChatCommand is unsupported, it can be processed in preCmdHook - -- in a modified CLI app or core - the hook should return Either ChatResponse ChatCommand - CustomChatCommand _cmd -> withUser $ \user -> pure $ chatCmdError (Just user) "not supported" - where - -- below code would make command responses asynchronous where they can be slow - -- in View.hs `r'` should be defined as `id` in this case - -- procCmd :: m ChatResponse -> m ChatResponse - -- procCmd action = do - -- ChatController {chatLock = l, smpAgent = a, outputQ = q, random = gVar} <- ask - -- corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8 - -- void . forkIO $ - -- withAgentLock a . withLock l name $ - -- (atomically . writeTBQueue q) . (Just corrId,) =<< (action `catchChatError` (pure . CRChatError)) - -- pure $ CRCmdAccepted corrId - -- use function below to make commands "synchronous" - procCmd :: CM ChatResponse -> CM ChatResponse - procCmd = id - ok_ = pure $ CRCmdOk Nothing - ok = pure . CRCmdOk . Just - getChatRef :: User -> ChatName -> CM ChatRef - getChatRef user (ChatName cType name) = - ChatRef cType <$> case cType of - CTDirect -> withFastStore $ \db -> getContactIdByName db user name - CTGroup -> withFastStore $ \db -> getGroupIdByName db user name - CTLocal - | name == "" -> withFastStore (`getUserNoteFolderId` user) - | otherwise -> throwChatError $ CECommandError "not supported" - _ -> throwChatError $ CECommandError "not supported" - checkChatStopped :: CM ChatResponse -> CM ChatResponse - checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped) - setStoreChanged :: CM () - setStoreChanged = asks chatStoreChanged >>= atomically . (`writeTVar` True) - withStoreChanged :: CM () -> CM ChatResponse - withStoreChanged a = checkChatStopped $ a >> setStoreChanged >> ok_ - checkStoreNotChanged :: CM ChatResponse -> CM ChatResponse - checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged) - withUserName :: UserName -> (UserId -> ChatCommand) -> CM ChatResponse - withUserName uName cmd = withFastStore (`getUserIdByName` uName) >>= processChatCommand . cmd - withContactName :: ContactName -> (ContactId -> ChatCommand) -> CM ChatResponse - withContactName cName cmd = withUser $ \user -> - withFastStore (\db -> getContactIdByName db user cName) >>= processChatCommand . cmd - withMemberName :: GroupName -> ContactName -> (GroupId -> GroupMemberId -> ChatCommand) -> CM ChatResponse - withMemberName gName mName cmd = withUser $ \user -> - getGroupAndMemberId user gName mName >>= processChatCommand . uncurry cmd - getConnectionCode :: ConnId -> CM Text - getConnectionCode connId = verificationCode <$> withAgent (`getConnectionRatchetAdHash` connId) - verifyConnectionCode :: User -> Connection -> Maybe Text -> CM ChatResponse - verifyConnectionCode user conn@Connection {connId} (Just code) = do - code' <- getConnectionCode $ aConnId conn - let verified = sameVerificationCode code code' - when verified . withFastStore' $ \db -> setConnectionVerified db user connId $ Just code' - pure $ CRConnectionVerified user verified code' - verifyConnectionCode user conn@Connection {connId} _ = do - code' <- getConnectionCode $ aConnId conn - withFastStore' $ \db -> setConnectionVerified db user connId Nothing - pure $ CRConnectionVerified user False code' - getSentChatItemIdByText :: User -> ChatRef -> Text -> CM Int64 - getSentChatItemIdByText user@User {userId, localDisplayName} (ChatRef cType cId) msg = case cType of - CTDirect -> withFastStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg - CTGroup -> withFastStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg - CTLocal -> withFastStore $ \db -> getLocalChatItemIdByText db user cId SMDSnd msg - _ -> throwChatError $ CECommandError "not supported" - getChatItemIdByText :: User -> ChatRef -> Text -> CM Int64 - getChatItemIdByText user (ChatRef cType cId) msg = case cType of - CTDirect -> withFastStore $ \db -> getDirectChatItemIdByText' db user cId msg - CTGroup -> withFastStore $ \db -> getGroupChatItemIdByText' db user cId msg - CTLocal -> withFastStore $ \db -> getLocalChatItemIdByText' db user cId msg - _ -> throwChatError $ CECommandError "not supported" - connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> CM ChatResponse - connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withInvitationLock "connectViaContact" (strEncode cReq) $ do - let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli - cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq - case groupLinkId of - -- contact address - Nothing -> - withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case - (Just contact, _) -> pure $ CRContactAlreadyExists user contact - (_, xContactId_) -> procCmd $ do - let randomXContactId = XContactId <$> drgRandomBytes 16 - xContactId <- maybe randomXContactId pure xContactId_ - connect' Nothing cReqHash xContactId False - -- group link - Just gLinkId -> - withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case - (Just _contact, _) -> procCmd $ do - -- allow repeat contact request - newXContactId <- XContactId <$> drgRandomBytes 16 - connect' (Just gLinkId) cReqHash newXContactId True - (_, xContactId_) -> procCmd $ do - let randomXContactId = XContactId <$> drgRandomBytes 16 - xContactId <- maybe randomXContactId pure xContactId_ - connect' (Just gLinkId) cReqHash xContactId True - where - connect' groupLinkId cReqHash xContactId inGroup = do - let pqSup = if inGroup then PQSupportOff else PQSupportOn - (connId, chatV) <- prepareContact user cReq pqSup - -- [incognito] generate profile to send - incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - subMode <- chatReadVar subscriptionMode - conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup - joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV - pure $ CRSentInvitation user conn incognitoProfile - connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> CM ChatResponse - connectContactViaAddress user incognito ct cReq = - withInvitationLock "connectContactViaAddress" (strEncode cReq) $ do - newXContactId <- XContactId <$> drgRandomBytes 16 - let pqSup = PQSupportOn - (connId, chatV) <- prepareContact user cReq pqSup - let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq - -- [incognito] generate profile to send - incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - subMode <- chatReadVar subscriptionMode - (pccConnId, ct') <- withFastStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup - joinContact user pccConnId connId cReq incognitoProfile newXContactId False pqSup chatV - pure $ CRSentInvitationToContact user ct' incognitoProfile - prepareContact :: User -> ConnectionRequestUri 'CMContact -> PQSupport -> CM (ConnId, VersionChat) - prepareContact user cReq pqSup = do - -- 0) toggle disabled - PQSupportOff - -- 1) toggle enabled, address supports PQ (connRequestPQSupport returns Just True) - PQSupportOn, enable support with compression - -- 2) toggle enabled, address doesn't support PQ - PQSupportOn but without compression, with version range indicating support - lift (withAgent' $ \a -> connRequestPQSupport a pqSup cReq) >>= \case - Nothing -> throwChatError CEInvalidConnReq - Just (agentV, _) -> do - let chatV = agentToChatVersion agentV - connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup - pure (connId, chatV) - joinContact :: User -> Int64 -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM () - joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV = do - let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup - dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId) - subMode <- chatReadVar subscriptionMode - joinPreparedAgentConnection user pccConnId connId cReq dm pqSup subMode - joinPreparedAgentConnection :: User -> Int64 -> ConnId -> ConnectionRequestUri m -> ByteString -> PQSupport -> SubscriptionMode -> CM () - joinPreparedAgentConnection user pccConnId connId cReq connInfo pqSup subMode = do - void (withAgent $ \a -> joinConnection a (aUserId user) connId True cReq connInfo pqSup subMode) - `catchChatError` \e -> do - withFastStore' $ \db -> deleteConnectionRecord db user pccConnId - withAgent $ \a -> deleteConnectionAsync a False connId - throwError e - contactMember :: Contact -> [GroupMember] -> Maybe GroupMember - contactMember Contact {contactId} = - find $ \GroupMember {memberContactId = cId, memberStatus = s} -> - cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft - checkSndFile :: CryptoFile -> CM Integer - checkSndFile (CryptoFile f cfArgs) = do - fsFilePath <- lift $ toFSFilePath f - unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f - fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs - when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f - pure fileSize - updateProfile :: User -> Profile -> CM ChatResponse - updateProfile user p' = updateProfile_ user p' $ withFastStore $ \db -> updateUserProfile db user p' - updateProfile_ :: User -> Profile -> CM User -> CM ChatResponse - updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser - | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user - | otherwise = do - when (n /= n') $ checkValidName n' - -- read contacts before user update to correctly merge preferences - contacts <- withFastStore' $ \db -> getUserContacts db vr user - user' <- updateUser - asks currentUser >>= atomically . (`writeTVar` Just user') - withChatLock "updateProfile" . procCmd $ do - let changedCts_ = L.nonEmpty $ foldr (addChangedProfileContact user') [] contacts - summary <- case changedCts_ of - Nothing -> pure $ UserProfileUpdateSummary 0 0 [] - Just changedCts -> do - let idsEvts = L.map ctSndEvent changedCts - msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts - (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ - unless (null errs) $ toView $ CRChatErrors (Just user) errs - let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts - lift $ createContactsSndFeatureItems user' changedCts' - pure - UserProfileUpdateSummary - { updateSuccesses = length cts, - updateFailures = length errs, - changedContacts = map (\ChangedProfileContact {ct'} -> ct') changedCts' - } - pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary - where - -- [incognito] filter out contacts with whom user has incognito connections - addChangedProfileContact :: User -> Contact -> [ChangedProfileContact] -> [ChangedProfileContact] - addChangedProfileContact user' ct changedCts = case contactSendConn_ ct' of - Right conn - | not (connIncognito conn) && mergedProfile' /= mergedProfile -> - ChangedProfileContact ct ct' mergedProfile' conn : changedCts - _ -> changedCts - where - mergedProfile = userProfileToSend user Nothing (Just ct) False - ct' = updateMergedPreferences user' ct - mergedProfile' = userProfileToSend user' Nothing (Just ct') False - ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json) - ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile') - ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq - ctMsgReq ChangedProfileContact {conn} = - fmap $ \SndMessage {msgId, msgBody} -> - (conn, MsgFlags {notification = hasNotification XInfo_}, msgBody, [msgId]) - updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse - updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct - updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' - | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct - | otherwise = do - assertDirectAllowed user MDSnd ct XInfo_ - ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs' - incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId - let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) False - mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False - when (mergedProfile' /= mergedProfile) $ - withContactLock "updateProfile" (contactId' ct) $ do - void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) - lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' - pure $ CRContactPrefsUpdated user ct ct' - runUpdateGroupProfile :: User -> Group -> GroupProfile -> CM ChatResponse - runUpdateGroupProfile user (Group g@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} ms) p'@GroupProfile {displayName = n'} = do - assertUserGroupRole g GROwner - when (n /= n') $ checkValidName n' - g' <- withStore $ \db -> updateGroupProfile db user g p' - msg <- case businessChat of - Just BusinessChatInfo {businessId} -> do - let (newMs, oldMs) = partition (\m -> maxVersion (memberChatVRange m) >= businessChatPrefsVersion) ms - -- this is a fallback to send the members with the old version correct profile of the business when preferences change - unless (null oldMs) $ do - GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} <- - withStore $ \db -> getGroupMemberByMemberId db vr user g businessId - let p'' = p' {displayName, fullName, image} :: GroupProfile - void $ sendGroupMessage user g' oldMs (XGrpInfo p'') - let ps' = fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' - sendGroupMessage user g' newMs $ XGrpPrefs ps' - Nothing -> sendGroupMessage user g' ms (XGrpInfo p') - let cd = CDGroupSnd g' - unless (sameGroupProfileInfo p p') $ do - ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat g') ci] - createGroupFeatureChangedItems user cd CISndGroupFeature g g' - pure $ CRGroupUpdated user g g' Nothing - checkValidName :: GroupName -> CM () - checkValidName displayName = do - when (T.null displayName) $ throwChatError CEInvalidDisplayName {displayName, validName = ""} - let validName = T.pack $ mkValidName $ T.unpack displayName - when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName} - assertUserGroupRole :: GroupInfo -> GroupMemberRole -> CM () - assertUserGroupRole g@GroupInfo {membership} requiredRole = do - let GroupMember {memberRole = membershipMemRole} = membership - when (membershipMemRole < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole - when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) - when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved - unless (memberActive membership) $ throwChatError CEGroupMemberNotActive - delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> CM ChatResponse - delGroupChatItems user gInfo items byGroupMember = do - deletedTs <- liftIO getCurrentTime - if groupFeatureAllowed SGFFullDelete gInfo - then deleteGroupCIs user gInfo items True False byGroupMember deletedTs - else markGroupCIsDeleted user gInfo items True byGroupMember deletedTs - updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse - updateGroupProfileByName gName update = withUser $ \user -> do - g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db -> - getGroupIdByName db user gName >>= getGroup db vr user - runUpdateGroupProfile user g $ update p - withCurrentCall :: ContactId -> (User -> Contact -> Call -> CM (Maybe Call)) -> CM ChatResponse - withCurrentCall ctId action = do - (user, ct) <- withStore $ \db -> do - user <- getUserByContactId db ctId - (user,) <$> getContact db vr user ctId - calls <- asks currentCalls - withContactLock "currentCall" ctId $ - atomically (TM.lookup ctId calls) >>= \case - Nothing -> throwChatError CENoCurrentCall - Just call@Call {contactId} - | ctId == contactId -> do - call_ <- action user ct call - case call_ of - Just call' -> do - unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId - atomically $ TM.insert ctId call' calls - _ -> do - withStore' $ \db -> deleteCalls db user ctId - atomically $ TM.delete ctId calls - ok user - | otherwise -> throwChatError $ CECallContact contactId - withServerProtocol :: ProtocolTypeI p => SProtocolType p -> (UserProtocol p => CM a) -> CM a - withServerProtocol p action = case userProtocol p of - Just Dict -> action - _ -> throwChatError $ CEServerProtocol $ AProtocolType p - validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError] - validateAllUsersServers currUserId userServers = withFastStore $ \db -> do - users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db) - others <- mapM (getUserOperatorServers db) users' - pure $ validateUserServers userServers others - where - getUserOperatorServers :: DB.Connection -> User -> ExceptT StoreError IO (User, [UserOperatorServers]) - getUserOperatorServers db user = do - uss <- liftIO . groupByOperator =<< getUserServers db user - pure (user, map updatedUserSrvs uss) - updatedUserSrvs uss = uss {operator = updatedOp <$> operator' uss} :: UserOperatorServers - updatedOp op = fromMaybe op $ find matchingOp $ mapMaybe operator' userServers - where - matchingOp op' = operatorId op' == operatorId op - forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> CM ChatResponse - forwardFile chatName fileId sendCommand = withUser $ \user -> do - withStore (\db -> getFileTransfer db user fileId) >>= \case - FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}, cryptoArgs} -> forward filePath cryptoArgs - FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs - _ -> throwChatError CEFileNotReceived {fileId} - where - forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs - getGroupAndMemberId :: User -> GroupName -> ContactName -> CM (GroupId, GroupMemberId) - getGroupAndMemberId user gName groupMemberName = - withStore $ \db -> do - groupId <- getGroupIdByName db user gName - groupMemberId <- getGroupMemberIdByName db user groupId groupMemberName - pure (groupId, groupMemberId) - sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> CM () - sendGrpInvitation user ct@Contact {contactId, localDisplayName} gInfo@GroupInfo {groupId, groupProfile, membership, businessChat} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do - currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo - let GroupMember {memberRole = userRole, memberId = userMemberId} = membership - groupInv = - GroupInvitation - { fromMember = MemberIdRole userMemberId userRole, - invitedMember = MemberIdRole memberId memRole, - connRequest = cReq, - groupProfile, - business = businessChat, - groupLinkId = Nothing, - groupSize = Just currentMemCount - } - (msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv - let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole - timed_ <- contactCITimed ct - ci <- saveSndChatItem' user (CDDirectSnd ct) msg content Nothing Nothing Nothing timed_ False - toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] - forM_ (timed_ >>= timedDeleteAt') $ - startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) - drgRandomBytes :: Int -> CM ByteString - drgRandomBytes n = asks random >>= atomically . C.randomBytes n - privateGetUser :: UserId -> CM User - privateGetUser userId = - tryChatError (withStore (`getUser` userId)) >>= \case - Left _ -> throwChatError CEUserUnknown - Right user -> pure user - validateUserPassword :: User -> User -> Maybe UserPwd -> CM () - validateUserPassword = validateUserPassword_ . Just - validateUserPassword_ :: Maybe User -> User -> Maybe UserPwd -> CM () - validateUserPassword_ user_ User {userId = userId', viewPwdHash} viewPwd_ = - forM_ viewPwdHash $ \pwdHash -> - let userId_ = (\User {userId} -> userId) <$> user_ - pwdOk = case viewPwd_ of - Nothing -> userId_ == Just userId' - Just (UserPwd viewPwd) -> validPassword viewPwd pwdHash - in unless pwdOk $ throwChatError CEUserUnknown - validPassword :: Text -> UserPwdHash -> Bool - validPassword pwd UserPwdHash {hash = B64UrlByteString hash, salt = B64UrlByteString salt} = - hash == C.sha512Hash (encodeUtf8 pwd <> salt) - setUserNotifications :: UserId -> Bool -> CM ChatResponse - setUserNotifications userId' showNtfs = withUser $ \user -> do - user' <- privateGetUser userId' - case viewPwdHash user' of - Just _ -> throwChatError $ CEHiddenUserAlwaysMuted userId' - _ -> setUserPrivacy user user' {showNtfs} - setUserPrivacy :: User -> User -> CM ChatResponse - setUserPrivacy user@User {userId} user'@User {userId = userId'} - | userId == userId' = do - asks currentUser >>= atomically . (`writeTVar` Just user') - withFastStore' (`updateUserPrivacy` user') - pure $ CRUserPrivacy {user = user', updatedUser = user'} - | otherwise = do - withFastStore' (`updateUserPrivacy` user') - pure $ CRUserPrivacy {user, updatedUser = user'} - checkDeleteChatUser :: User -> CM () - checkDeleteChatUser user@User {userId} = do - users <- withFastStore' getUsers - let otherVisible = filter (\User {userId = userId', viewPwdHash} -> userId /= userId' && isNothing viewPwdHash) users - when (activeUser user && length otherVisible > 0) $ throwChatError (CECantDeleteActiveUser userId) - deleteChatUser :: User -> Bool -> CM ChatResponse - deleteChatUser user delSMPQueues = do - filesInfo <- withFastStore' (`getUserFileInfo` user) - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - withAgent (\a -> deleteUser a (aUserId user) delSMPQueues) - `catchChatError` \case - e@(ChatErrorAgent NO_USER _) -> toView $ CRChatError (Just user) e - e -> throwError e - withFastStore' (`deleteUserRecord` user) - when (activeUser user) $ chatWriteVar currentUser Nothing - ok_ - updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> CM ChatResponse - updateChatSettings (ChatName cType name) updateSettings = withUser $ \user -> do - (chatId, chatSettings) <- case cType of - CTDirect -> withFastStore $ \db -> do - ctId <- getContactIdByName db user name - Contact {chatSettings} <- getContact db vr user ctId - pure (ctId, chatSettings) - CTGroup -> - withFastStore $ \db -> do - gId <- getGroupIdByName db user name - GroupInfo {chatSettings} <- getGroupInfo db vr user gId - pure (gId, chatSettings) - _ -> throwChatError $ CECommandError "not supported" - processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings - connectPlan :: User -> AConnectionRequestUri -> CM ConnectionPlan - connectPlan user (ACR SCMInvitation (CRInvitationUri crData e2e)) = do - withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqSchemas) >>= \case - Nothing -> pure $ CPInvitationLink ILPOk - Just (RcvDirectMsgConnection Connection {connStatus = ConnPrepared} Nothing) -> - pure $ CPInvitationLink ILPOk - Just (RcvDirectMsgConnection conn ct_) -> do - let Connection {connStatus, contactConnInitiated} = conn - if - | connStatus == ConnNew && contactConnInitiated -> - pure $ CPInvitationLink ILPOwnLink - | not (connReady conn) -> - pure $ CPInvitationLink (ILPConnecting ct_) - | otherwise -> case ct_ of - Just ct -> pure $ CPInvitationLink (ILPKnown ct) - Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact" - Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" - where - cReqSchemas :: (ConnReqInvitation, ConnReqInvitation) - cReqSchemas = - ( CRInvitationUri crData {crScheme = SSSimplex} e2e, - CRInvitationUri crData {crScheme = simplexChat} e2e - ) - connectPlan user (ACR SCMContact (CRContactUri crData)) = do - let ConnReqUriData {crClientData} = crData - groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli - case groupLinkId of - -- contact address - Nothing -> - withFastStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case - Just _ -> pure $ CPContactAddress CAPOwnLink - Nothing -> - withFastStore' (\db -> getContactConnEntityByConnReqHash db vr user cReqHashes) >>= \case - Nothing -> - withFastStore' (\db -> getContactWithoutConnViaAddress db vr user cReqSchemas) >>= \case - Nothing -> pure $ CPContactAddress CAPOk - Just ct -> pure $ CPContactAddress (CAPContactViaAddress ct) - Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect - Just (RcvDirectMsgConnection _ (Just ct)) - | not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct) - | contactDeleted ct -> pure $ CPContactAddress CAPOk - | otherwise -> pure $ CPContactAddress (CAPKnown ct) - Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo - Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection" - -- group link - Just _ -> - withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db vr user cReqSchemas) >>= \case - Just g -> pure $ CPGroupLink (GLPOwnLink g) - Nothing -> do - connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db vr user cReqHashes - gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db vr user cReqHashes - case (gInfo_, connEnt_) of - (Nothing, Nothing) -> pure $ CPGroupLink GLPOk - (Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect - (Nothing, Just (RcvDirectMsgConnection _ (Just ct))) - | not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_) - | otherwise -> pure $ CPGroupLink GLPOk - (Nothing, Just _) -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" - (Just gInfo, _) -> groupPlan gInfo - where - groupPlan gInfo@GroupInfo {membership} - | not (memberActive membership) && not (memberRemoved membership) = - pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo) - | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo) - | otherwise = pure $ CPGroupLink GLPOk - cReqSchemas :: (ConnReqContact, ConnReqContact) - cReqSchemas = - ( CRContactUri crData {crScheme = SSSimplex}, - CRContactUri crData {crScheme = simplexChat} - ) - cReqHashes :: (ConnReqUriHash, ConnReqUriHash) - cReqHashes = bimap hash hash cReqSchemas - hash = ConnReqUriHash . C.sha256Hash . strEncode - updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do - AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db vr user groupId - case (cInfo, content) of - (DirectChat ct@Contact {contactId}, CIRcvGroupInvitation ciGroupInv@CIGroupInvitation {status} memRole) - | status == CIGISPending -> do - let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = newStatus} memRole - timed_ <- contactCITimed ct - updateDirectChatItemView user ct itemId aciContent False False timed_ Nothing - forM_ (timed_ >>= timedDeleteAt') $ - startProximateTimedItemThread user (ChatRef CTDirect contactId, itemId) - _ -> pure () -- prohibited - sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse - sendContactContentMessages user contactId live itemTTL cmrs = do - assertMultiSendable live cmrs - ct@Contact {contactUsed} <- withFastStore $ \db -> getContact db vr user contactId - assertDirectAllowed user MDSnd ct XMsgNew_ - assertVoiceAllowed ct - unless contactUsed $ withFastStore' $ \db -> updateContactUsed db user ct - processComposedMessages ct - where - assertVoiceAllowed :: Contact -> CM () - assertVoiceAllowed ct = - when (not (featureAllowed SCFVoice forUser ct) && any (\(ComposedMessage {msgContent}, _) -> isVoice msgContent) cmrs) $ - throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFVoice)) - processComposedMessages :: Contact -> CM ChatResponse - processComposedMessages ct = do - (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers - timed_ <- sndContactCITimed live ct itemTTL - (msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ - msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers - let itemsData = prepareSndItemsData msgs_ cmrs ciFiles_ quotedItems_ - when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch" - r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live - processSendErrs user r - forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> - forM_ cis $ \ci -> - startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) deleteAt - pure $ CRNewChatItems user (map (AChatItem SCTDirect SMDSnd (DirectChat ct)) cis) - where - setupSndFileTransfers :: CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))) - setupSndFileTransfers = - forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> case file_ of - Just file -> do - fileSize <- checkSndFile file - (fInv, ciFile) <- xftpSndFileTransfer user file fileSize 1 $ CGContact ct - pure (Just fInv, Just ciFile) - Nothing -> pure (Nothing, Nothing) - prepareMsgs :: NonEmpty (ComposeMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))) - prepareMsgs cmsFileInvs timed_ = - forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded), fInv_) -> - case (quotedItemId, itemForwarded) of - (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Just qiId, Nothing) -> do - CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- - withFastStore $ \db -> getDirectChatItem db user contactId qiId - (origQmc, qd, sent) <- quoteData qci - let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing} - qmc = quoteContent mc origQmc file - quotedItem = CIQuote {chatDir = qd, itemId = Just qiId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} - pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem) - (Just _, Just _) -> throwChatError CEInvalidQuote - where - quoteData :: ChatItem c d -> CM (MsgContent, CIQDirection 'CTDirect, Bool) - quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote - quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True) - quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) - quoteData _ = throwChatError CEInvalidQuote - sendGroupContentMessages :: User -> GroupId -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse - sendGroupContentMessages user groupId live itemTTL cmrs = do - assertMultiSendable live cmrs - g@(Group gInfo _) <- withFastStore $ \db -> getGroup db vr user groupId - assertUserGroupRole gInfo GRAuthor - assertGroupContentAllowed gInfo - processComposedMessages g - where - assertGroupContentAllowed :: GroupInfo -> CM () - assertGroupContentAllowed gInfo@GroupInfo {membership} = - case findProhibited (L.toList cmrs) of - Just f -> throwChatError (CECommandError $ "feature not allowed " <> T.unpack (groupFeatureNameText f)) - Nothing -> pure () - where - findProhibited :: [ComposeMessageReq] -> Maybe GroupFeature - findProhibited = - foldr' - (\(ComposedMessage {fileSource, msgContent = mc}, _) acc -> prohibitedGroupContent gInfo membership mc fileSource <|> acc) - Nothing - processComposedMessages :: Group -> CM ChatResponse - processComposedMessages g@(Group gInfo ms) = do - (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length $ filter memberCurrent ms) - timed_ <- sndGroupCITimed live gInfo itemTTL - (msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ - (msgs_, gsr) <- sendGroupMessages user gInfo ms $ L.map XMsgNew msgContainers - let itemsData = prepareSndItemsData (L.toList msgs_) cmrs ciFiles_ quotedItems_ - cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live - when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" - createMemberSndStatuses cis_ msgs_ gsr - let r@(_, cis) = partitionEithers cis_ - processSendErrs user r - forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> - forM_ cis $ \ci -> - startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) deleteAt - pure $ CRNewChatItems user (map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) cis) - where - setupSndFileTransfers :: Int -> CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))) - setupSndFileTransfers n = - forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> case file_ of - Just file -> do - fileSize <- checkSndFile file - (fInv, ciFile) <- xftpSndFileTransfer user file fileSize n $ CGGroup g - pure (Just fInv, Just ciFile) - Nothing -> pure (Nothing, Nothing) - prepareMsgs :: NonEmpty (ComposeMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTGroup))) - prepareMsgs cmsFileInvs timed_ = - forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded), fInv_) -> - prepareGroupMsg user gInfo mc quotedItemId itemForwarded fInv_ timed_ live - createMemberSndStatuses :: - [Either ChatError (ChatItem 'CTGroup 'MDSnd)] -> - NonEmpty (Either ChatError SndMessage) -> - GroupSndResult -> - CM () - createMemberSndStatuses cis_ msgs_ GroupSndResult {sentTo, pending, forwarded} = do - let msgToItem = mapMsgToItem - withFastStore' $ \db -> do - forM_ sentTo (processSentTo db msgToItem) - forM_ forwarded (processForwarded db) - forM_ pending (processPending db msgToItem) - where - mapMsgToItem :: Map MessageId ChatItemId - mapMsgToItem = foldr' addItem M.empty (zip (L.toList msgs_) cis_) - where - addItem (Right SndMessage {msgId}, Right ci) m = M.insert msgId (chatItemId' ci) m - addItem _ m = m - processSentTo :: DB.Connection -> Map MessageId ChatItemId -> (GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption)) -> IO () - processSentTo db msgToItem (mId, msgIds_, deliveryResult) = forM_ msgIds_ $ \msgIds -> do - let ciIds = mapMaybe (`M.lookup` msgToItem) msgIds - status = case deliveryResult of - Right _ -> GSSNew - Left e -> GSSError $ SndErrOther $ tshow e - forM_ ciIds $ \ciId -> createGroupSndStatus db ciId mId status - processForwarded :: DB.Connection -> GroupMember -> IO () - processForwarded db GroupMember {groupMemberId} = - forM_ cis_ $ \ci_ -> - forM_ ci_ $ \ci -> createGroupSndStatus db (chatItemId' ci) groupMemberId GSSForwarded - processPending :: DB.Connection -> Map MessageId ChatItemId -> (GroupMemberId, Either ChatError MessageId, Either ChatError ()) -> IO () - processPending db msgToItem (mId, msgId_, pendingResult) = forM_ msgId_ $ \msgId -> do - let ciId_ = M.lookup msgId msgToItem - status = case pendingResult of - Right _ -> GSSInactive - Left e -> GSSError $ SndErrOther $ tshow e - forM_ ciId_ $ \ciId -> createGroupSndStatus db ciId mId status - assertMultiSendable :: Bool -> NonEmpty ComposeMessageReq -> CM () - assertMultiSendable live cmrs - | length cmrs == 1 = pure () - | otherwise = - -- When sending multiple messages only single quote is allowed. - -- This is to support case of sending multiple attachments while also quoting another message. - -- UI doesn't allow composing with multiple quotes, so api prohibits it as well, and doesn't bother - -- batching retrieval of quoted messages (prepareMsgs). - when (live || length (L.filter (\(ComposedMessage {quotedItemId}, _) -> isJust quotedItemId) cmrs) > 1) $ - throwChatError (CECommandError "invalid multi send: live and more than one quote not supported") - xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd) - xftpSndFileTransfer user file fileSize n contactOrGroup = do - (fInv, ciFile, ft) <- xftpSndFileTransfer_ user file fileSize n $ Just contactOrGroup - case contactOrGroup of - CGContact Contact {activeConn} -> forM_ activeConn $ \conn -> - withFastStore' $ \db -> createSndFTDescrXFTP db user Nothing conn ft dummyFileDescr - CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CRChatError (Just user)) - where - -- we are not sending files to pending members, same as with inline files - saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} = - when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $ - withFastStore' $ - \db -> createSndFTDescrXFTP db user (Just m) conn ft dummyFileDescr - saveMemberFD _ = pure () - pure (fInv, ciFile) - prepareSndItemsData :: - [Either ChatError SndMessage] -> - NonEmpty ComposeMessageReq -> - NonEmpty (Maybe (CIFile 'MDSnd)) -> - NonEmpty (Maybe (CIQuote c)) -> - [Either ChatError (NewSndChatItemData c)] - prepareSndItemsData msgs_ cmrs' ciFiles_ quotedItems_ = - [ ( case msg_ of - Right msg -> Right $ NewSndChatItemData msg (CISndMsgContent msgContent) f q itemForwarded - Left e -> Left e -- step over original error - ) - | (msg_, (ComposedMessage {msgContent}, itemForwarded), f, q) <- - zipWith4 (,,,) msgs_ (L.toList cmrs') (L.toList ciFiles_) (L.toList quotedItems_) - ] - processSendErrs :: User -> ([ChatError], [ChatItem c d]) -> CM () - processSendErrs user = \case - -- no errors - ([], _) -> pure () - -- at least one item is successfully created - (errs, _ci : _) -> toView $ CRChatErrors (Just user) errs - -- single error - ([err], []) -> throwError err - -- multiple errors - (errs@(err : _), []) -> do - toView $ CRChatErrors (Just user) errs - throwError err - getCommandDirectChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (Contact, [CChatItem 'CTDirect]) - getCommandDirectChatItems user ctId itemIds = do - ct <- withFastStore $ \db -> getContact db vr user ctId - (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds)) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure (ct, items) - where - getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect)) - getDirectCI db itemId = runExceptT . withExceptT ChatErrorStore $ getDirectChatItem db user ctId itemId - getCommandGroupChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (GroupInfo, [CChatItem 'CTGroup]) - getCommandGroupChatItems user gId itemIds = do - gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId - (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds)) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure (gInfo, items) - where - getGroupCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup)) - getGroupCI db itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user gId itemId - getCommandLocalChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (NoteFolder, [CChatItem 'CTLocal]) - getCommandLocalChatItems user nfId itemIds = do - nf <- withStore $ \db -> getNoteFolder db user nfId - (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getLocalCI db) (L.toList itemIds)) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure (nf, items) - where - getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal)) - getLocalCI db itemId = runExceptT . withExceptT ChatErrorStore $ getLocalChatItem db user nfId itemId - forwardMsgContent :: ChatItem c d -> CM (Maybe MsgContent) - forwardMsgContent ChatItem {meta = CIMeta {itemDeleted = Just _}} = pure Nothing -- this can be deleted after selection - forwardMsgContent ChatItem {content = CISndMsgContent fmc} = pure $ Just fmc - forwardMsgContent ChatItem {content = CIRcvMsgContent fmc} = pure $ Just fmc - forwardMsgContent _ = throwChatError CEInvalidForward - createNoteFolderContentItems :: User -> NoteFolderId -> NonEmpty ComposeMessageReq -> CM ChatResponse - createNoteFolderContentItems user folderId cmrs = do - assertNoQuotes - nf <- withFastStore $ \db -> getNoteFolder db user folderId - createdAt <- liftIO getCurrentTime - ciFiles_ <- createLocalFiles nf createdAt - let itemsData = prepareLocalItemsData cmrs ciFiles_ - cis <- createLocalChatItems user (CDLocalSnd nf) itemsData createdAt - pure $ CRNewChatItems user (map (AChatItem SCTLocal SMDSnd (LocalChat nf)) cis) - where - assertNoQuotes :: CM () - assertNoQuotes = - when (any (\(ComposedMessage {quotedItemId}, _) -> isJust quotedItemId) cmrs) $ - throwChatError (CECommandError "createNoteFolderContentItems: quotes not supported") - createLocalFiles :: NoteFolder -> UTCTime -> CM (NonEmpty (Maybe (CIFile 'MDSnd))) - createLocalFiles nf createdAt = - forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> - forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do - fsFilePath <- lift $ toFSFilePath filePath - fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs - chunkSize <- asks $ fileChunkSize . config - withFastStore' $ \db -> do - fileId <- createLocalFile CIFSSndStored db user nf createdAt cf fileSize chunkSize - pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndStored, fileProtocol = FPLocal} - prepareLocalItemsData :: - NonEmpty ComposeMessageReq -> - NonEmpty (Maybe (CIFile 'MDSnd)) -> - [(CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom)] - prepareLocalItemsData cmrs' ciFiles_ = - [ (CISndMsgContent mc, f, itemForwarded) - | ((ComposedMessage {msgContent = mc}, itemForwarded), f) <- zip (L.toList cmrs') (L.toList ciFiles_) - ] - getConnQueueInfo user Connection {connId, agentConnId = AgentConnId acId} = do - msgInfo <- withFastStore' (`getLastRcvMsgInfo` connId) - CRQueueInfo user msgInfo <$> withAgent (`getConnectionQueueInfo` acId) - -protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -protocolServers p (operators, smpServers, xftpServers) = case p of - SPSMP -> (operators, smpServers, []) - SPXFTP -> (operators, [], xftpServers) - --- disable preset and replace custom servers (groupByOperator always adds custom) -updatedServers :: forall p. UserProtocol p => SProtocolType p -> [AUserServer p] -> UserOperatorServers -> UpdatedUserOperatorServers -updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers} = case p' of - SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers) - SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers) - where - u = uncurry $ UpdatedUserOperatorServers operator - updateSrvs :: [UserServer p] -> [AUserServer p] - updateSrvs pSrvs = map disableSrv pSrvs <> maybe srvs (const []) operator - disableSrv srv@UserServer {preset} = - AUS SDBStored $ if preset then srv {enabled = False} else srv {deleted = True} - -type ComposeMessageReq = (ComposedMessage, Maybe CIForwardedFrom) - -contactCITimed :: Contact -> CM (Maybe CITimed) -contactCITimed ct = sndContactCITimed False ct Nothing - -sndContactCITimed :: Bool -> Contact -> Maybe Int -> CM (Maybe CITimed) -sndContactCITimed live = sndCITimed_ live . contactTimedTTL - -sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> CM (Maybe CITimed) -sndGroupCITimed live = sndCITimed_ live . groupTimedTTL - -sndCITimed_ :: Bool -> Maybe (Maybe Int) -> Maybe Int -> CM (Maybe CITimed) -sndCITimed_ live chatTTL itemTTL = - forM (chatTTL >>= (itemTTL <|>)) $ \ttl -> - CITimed ttl - <$> if live - then pure Nothing - else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime - -toggleNtf :: User -> GroupMember -> Bool -> CM () -toggleNtf user m ntfOn = - when (memberActive m) $ - forM_ (memberConnId m) $ \connId -> - withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user)) - -data ChangedProfileContact = ChangedProfileContact - { ct :: Contact, - ct' :: Contact, - mergedProfile' :: Profile, - conn :: Connection - } - -prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup)) -prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of - (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) - (Just quotedItemId, Nothing) -> do - CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- - withStore $ \db -> getGroupChatItem db user groupId quotedItemId - (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership - let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId} - qmc = quoteContent mc origQmc file - quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} - pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem) - (Just _, Just _) -> throwChatError CEInvalidQuote - where - quoteData :: ChatItem c d -> GroupMember -> CM (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember) - quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote - quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership') - quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m) - quoteData _ _ = throwChatError CEInvalidQuote - -quoteContent :: forall d. MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent -quoteContent mc qmc ciFile_ - | replaceContent = MCText qTextOrFile - | otherwise = case qmc of - MCImage _ image -> MCImage qTextOrFile image - MCFile _ -> MCFile qTextOrFile - -- consider same for voice messages - -- MCVoice _ voice -> MCVoice qTextOrFile voice - _ -> qmc - where - -- if the message we're quoting with is one of the "large" MsgContents - -- we replace the quote's content with MCText - replaceContent = case mc of - MCText _ -> False - MCFile _ -> False - MCLink {} -> True - MCImage {} -> True - MCVideo {} -> True - MCVoice {} -> False - MCUnknown {} -> True - qText = msgContentText qmc - getFileName :: CIFile d -> String - getFileName CIFile {fileName} = fileName - qFileName = maybe qText (T.pack . getFileName) ciFile_ - qTextOrFile = if T.null qText then qFileName else qText - -assertDirectAllowed :: User -> MsgDirection -> Contact -> CMEventTag e -> CM () -assertDirectAllowed user dir ct event = - unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $ - throwChatError (CEDirectMessagesProhibited dir ct) - where - directMessagesAllowed = any (uncurry $ groupFeatureMemberAllowed' SGFDirectMessages) <$> withStore' (\db -> getContactGroupPreferences db user ct) - allowedChatEvent = case event of - XMsgNew_ -> False - XMsgUpdate_ -> False - XMsgDel_ -> False - XFile_ -> False - XGrpInv_ -> False - XCallInv_ -> False - _ -> True - -prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe f -> Maybe GroupFeature -prohibitedGroupContent gInfo m mc file_ - | isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) = Just GFVoice - | not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles - | prohibitedSimplexLinks gInfo m mc = Just GFSimplexLinks - | otherwise = Nothing - -prohibitedSimplexLinks :: GroupInfo -> GroupMember -> MsgContent -> Bool -prohibitedSimplexLinks gInfo m mc = - not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo) - && maybe False (any ftIsSimplexLink) (parseMaybeMarkdownList $ msgContentText mc) - where - ftIsSimplexLink :: FormattedText -> Bool - ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format - -roundedFDCount :: Int -> Int -roundedFDCount n - | n <= 0 = 4 - | otherwise = max 4 $ fromIntegral $ (2 :: Integer) ^ (ceiling (logBase 2 (fromIntegral n) :: Double) :: Integer) - -startExpireCIThread :: User -> CM' () -startExpireCIThread user@User {userId} = do - expireThreads <- asks expireCIThreads - atomically (TM.lookup userId expireThreads) >>= \case - Nothing -> do - a <- Just <$> async runExpireCIs - atomically $ TM.insert userId a expireThreads - _ -> pure () - where - runExpireCIs = do - delay <- asks (initialCleanupManagerDelay . config) - liftIO $ threadDelay' delay - interval <- asks $ ciExpirationInterval . config - forever $ do - flip catchChatError' (toView' . CRChatError (Just user)) $ do - expireFlags <- asks expireCIFlags - atomically $ TM.lookup userId expireFlags >>= \b -> unless (b == Just True) retry - lift waitChatStartedAndActivated - ttl <- withStore' (`getChatItemTTL` user) - forM_ ttl $ \t -> expireChatItems user t False - liftIO $ threadDelay' interval - -setExpireCIFlag :: User -> Bool -> CM' () -setExpireCIFlag User {userId} b = do - expireFlags <- asks expireCIFlags - atomically $ TM.insert userId b expireFlags - -setAllExpireCIFlags :: Bool -> CM' () -setAllExpireCIFlags b = do - expireFlags <- asks expireCIFlags - atomically $ do - keys <- M.keys <$> readTVar expireFlags - forM_ keys $ \k -> TM.insert k b expireFlags - -cancelFilesInProgress :: User -> [CIFileInfo] -> CM () -cancelFilesInProgress user filesInfo = do - let filesInfo' = filter (not . fileEnded) filesInfo - (sfs, rfs) <- lift $ splitFTTypes <$> withStoreBatch (\db -> map (getFT db) filesInfo') - forM_ rfs $ \RcvFileTransfer {fileId} -> lift (closeFileHandle fileId rcvFiles) `catchChatError` \_ -> pure () - lift . void . withStoreBatch' $ \db -> map (updateSndFileCancelled db) sfs - lift . void . withStoreBatch' $ \db -> map (updateRcvFileCancelled db) rfs - let xsfIds = mapMaybe (\(FileTransferMeta {fileId, xftpSndFile}, _) -> (,fileId) <$> xftpSndFile) sfs - xrfIds = mapMaybe (\RcvFileTransfer {fileId, xftpRcvFile} -> (,fileId) <$> xftpRcvFile) rfs - lift $ agentXFTPDeleteSndFilesRemote user xsfIds - lift $ agentXFTPDeleteRcvFiles xrfIds - let smpSFConnIds = concatMap (\(ft, sfts) -> mapMaybe (smpSndFileConnId ft) sfts) sfs - smpRFConnIds = mapMaybe smpRcvFileConnId rfs - deleteAgentConnectionsAsync user smpSFConnIds - deleteAgentConnectionsAsync user smpRFConnIds - where - fileEnded CIFileInfo {fileStatus} = case fileStatus of - Just (AFS _ status) -> ciFileEnded status - Nothing -> True - getFT :: DB.Connection -> CIFileInfo -> IO (Either ChatError FileTransfer) - getFT db CIFileInfo {fileId} = runExceptT . withExceptT ChatErrorStore $ getFileTransfer db user fileId - updateSndFileCancelled :: DB.Connection -> (FileTransferMeta, [SndFileTransfer]) -> IO () - updateSndFileCancelled db (FileTransferMeta {fileId}, sfts) = do - updateFileCancelled db user fileId CIFSSndCancelled - forM_ sfts updateSndFTCancelled - where - updateSndFTCancelled :: SndFileTransfer -> IO () - updateSndFTCancelled ft = unless (sndFTEnded ft) $ do - updateSndFileStatus db ft FSCancelled - deleteSndFileChunks db ft - updateRcvFileCancelled :: DB.Connection -> RcvFileTransfer -> IO () - updateRcvFileCancelled db ft@RcvFileTransfer {fileId} = do - updateFileCancelled db user fileId CIFSRcvCancelled - updateRcvFileStatus db fileId FSCancelled - deleteRcvFileChunks db ft - splitFTTypes :: [Either ChatError FileTransfer] -> ([(FileTransferMeta, [SndFileTransfer])], [RcvFileTransfer]) - splitFTTypes = foldr addFT ([], []) . rights - where - addFT f (sfs, rfs) = case f of - FTSnd ft@FileTransferMeta {cancelled} sfts | not cancelled -> ((ft, sfts) : sfs, rfs) - FTRcv ft@RcvFileTransfer {cancelled} | not cancelled -> (sfs, ft : rfs) - _ -> (sfs, rfs) - smpSndFileConnId :: FileTransferMeta -> SndFileTransfer -> Maybe ConnId - smpSndFileConnId FileTransferMeta {xftpSndFile} sft@SndFileTransfer {agentConnId = AgentConnId acId, fileInline} - | isNothing xftpSndFile && isNothing fileInline && not (sndFTEnded sft) = Just acId - | otherwise = Nothing - smpRcvFileConnId :: RcvFileTransfer -> Maybe ConnId - smpRcvFileConnId ft@RcvFileTransfer {xftpRcvFile, rcvFileInline} - | isNothing xftpRcvFile && isNothing rcvFileInline = liveRcvFileTransferConnId ft - | otherwise = Nothing - sndFTEnded SndFileTransfer {fileStatus} = fileStatus == FSCancelled || fileStatus == FSComplete - -deleteFilesLocally :: [CIFileInfo] -> CM () -deleteFilesLocally files = - withFilesFolder $ \filesFolder -> - liftIO . forM_ files $ \CIFileInfo {filePath} -> - mapM_ (delete . (filesFolder )) filePath - where - delete :: FilePath -> IO () - delete fPath = - removeFile fPath `catchAll` \_ -> - removePathForcibly fPath `catchAll_` pure () - -- perform an action only if filesFolder is set (i.e. on mobile devices) - withFilesFolder :: (FilePath -> CM ()) -> CM () - withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action - -updateCallItemStatus :: User -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> CM () -updateCallItemStatus user ct@Contact {contactId} Call {chatItemId} receivedStatus msgId_ = do - aciContent_ <- callStatusItemContent user ct chatItemId receivedStatus - forM_ aciContent_ $ \aciContent -> do - timed_ <- callTimed ct aciContent - updateDirectChatItemView user ct chatItemId aciContent False False timed_ msgId_ - forM_ (timed_ >>= timedDeleteAt') $ - startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId) - -callTimed :: Contact -> ACIContent -> CM (Maybe CITimed) -callTimed ct aciContent = - case aciContentCallStatus aciContent of - Just callStatus - | callComplete callStatus -> do - contactCITimed ct - _ -> pure Nothing - where - aciContentCallStatus :: ACIContent -> Maybe CICallStatus - aciContentCallStatus (ACIContent _ (CISndCall st _)) = Just st - aciContentCallStatus (ACIContent _ (CIRcvCall st _)) = Just st - aciContentCallStatus _ = Nothing - -updateDirectChatItemView :: User -> Contact -> ChatItemId -> ACIContent -> Bool -> Bool -> Maybe CITimed -> Maybe MessageId -> CM () -updateDirectChatItemView user ct chatItemId (ACIContent msgDir ciContent) edited live timed_ msgId_ = do - ci' <- withStore $ \db -> updateDirectChatItem db user ct chatItemId ciContent edited live timed_ msgId_ - toView $ CRChatItemUpdated user (AChatItem SCTDirect msgDir (DirectChat ct) ci') - -callStatusItemContent :: User -> Contact -> ChatItemId -> WebRTCCallStatus -> CM (Maybe ACIContent) -callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do - CChatItem msgDir ChatItem {meta = CIMeta {updatedAt}, content} <- - withStore $ \db -> getDirectChatItem db user contactId chatItemId - ts <- liftIO getCurrentTime - let callDuration :: Int = nominalDiffTimeToSeconds (ts `diffUTCTime` updatedAt) `div'` 1 - callStatus = case content of - CISndCall st _ -> Just st - CIRcvCall st _ -> Just st - _ -> Nothing - newState_ = case (callStatus, receivedStatus) of - (Just CISCallProgress, WCSConnected) -> Nothing -- if call in-progress received connected -> no change - (Just CISCallProgress, WCSDisconnected) -> Just (CISCallEnded, callDuration) -- calculate in-progress duration - (Just CISCallProgress, WCSFailed) -> Just (CISCallEnded, callDuration) -- whether call disconnected or failed - (Just CISCallPending, WCSDisconnected) -> Just (CISCallMissed, 0) - (Just CISCallEnded, _) -> Nothing -- if call already ended or failed -> no change - (Just CISCallError, _) -> Nothing - (Just _, WCSConnecting) -> Just (CISCallNegotiated, 0) - (Just _, WCSConnected) -> Just (CISCallProgress, 0) -- if call ended that was never connected, duration = 0 - (Just _, WCSDisconnected) -> Just (CISCallEnded, 0) - (Just _, WCSFailed) -> Just (CISCallError, 0) - (Nothing, _) -> Nothing -- some other content - we should never get here, but no exception is thrown - pure $ aciContent msgDir <$> newState_ - where - aciContent :: forall d. SMsgDirection d -> (CICallStatus, Int) -> ACIContent - aciContent msgDir (callStatus', duration) = case msgDir of - SMDSnd -> ACIContent SMDSnd $ CISndCall callStatus' duration - SMDRcv -> ACIContent SMDRcv $ CIRcvCall callStatus' duration - --- mobile clients use file paths relative to app directory (e.g. for the reason ios app directory changes on updates), --- so we have to differentiate between the file path stored in db and communicated with frontend, and the file path --- used during file transfer for actual operations with file system -toFSFilePath :: FilePath -> CM' FilePath -toFSFilePath f = - maybe f ( f) <$> (chatReadVar' filesFolder) - -setFileToEncrypt :: RcvFileTransfer -> CM RcvFileTransfer -setFileToEncrypt ft@RcvFileTransfer {fileId} = do - cfArgs <- atomically . CF.randomArgs =<< asks random - withStore' $ \db -> setFileCryptoArgs db fileId cfArgs - pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs} - -receiveFile' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatResponse -receiveFile' user ft userApprovedRelays rcvInline_ filePath_ = do - (CRRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchChatError` processError - where - processError = \case - -- TODO AChatItem in Cancelled events - ChatErrorAgent (SMP _ SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft - ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft - e -> throwError e - -acceptFileReceive :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM AChatItem -acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} userApprovedRelays rcvInline_ filePath_ = do - unless (fileStatus == RFSNew) $ case fileStatus of - RFSCancelled _ -> throwChatError $ CEFileCancelled fName - _ -> throwChatError $ CEFileAlreadyReceiving fName - vr <- chatVersionRange - case (xftpRcvFile, fileConnReq) of - -- direct file protocol - (Nothing, Just connReq) -> do - subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XFileAcpt fName - connIds <- joinAgentConnectionAsync user True connReq dm subMode - filePath <- getRcvFilePath fileId filePath_ fName True - withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode - -- XFTP - (Just XFTPRcvFile {userApprovedRelays = approvedBeforeReady}, _) -> do - let userApproved = approvedBeforeReady || userApprovedRelays - filePath <- getRcvFilePath fileId filePath_ fName False - (ci, rfd) <- withStore $ \db -> do - -- marking file as accepted and reading description in the same transaction - -- to prevent race condition with appending description - ci <- xftpAcceptRcvFT db vr user fileId filePath userApproved - rfd <- getRcvFileDescrByRcvFileId db fileId - pure (ci, rfd) - receiveViaCompleteFD user fileId rfd userApproved cryptoArgs - pure ci - -- group & direct file protocol - _ -> do - chatRef <- withStore $ \db -> getChatRefByFileId db user fileId - case (chatRef, grpMemberId) of - (ChatRef CTDirect contactId, Nothing) -> do - ct <- withStore $ \db -> getContact db vr user contactId - acceptFile CFCreateConnFileInvDirect $ \msg -> void $ sendDirectContactMessage user ct msg - (ChatRef CTGroup groupId, Just memId) -> do - GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user groupId memId - case activeConn of - Just conn -> do - acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMemberMessage conn msg groupId - _ -> throwChatError $ CEFileInternal "member connection not active" - _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" - where - acceptFile :: CommandFunction -> (ChatMsgEvent 'Json -> CM ()) -> CM AChatItem - acceptFile cmdFunction send = do - filePath <- getRcvFilePath fileId filePath_ fName True - inline <- receiveInline - vr <- chatVersionRange - if - | inline -> do - -- accepting inline - ci <- withStore $ \db -> acceptRcvInlineFT db vr user fileId filePath - sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId - send $ XFileAcptInv sharedMsgId Nothing fName - pure ci - | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName - | otherwise -> do - -- accepting via a new connection - subMode <- chatReadVar subscriptionMode - connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode - withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnNew filePath subMode - receiveInline :: CM Bool - receiveInline = do - ChatConfig {fileChunkSize, inlineFiles = InlineFilesConfig {receiveChunks, offerChunks}} <- asks config - pure $ - rcvInline_ /= Just False - && fileInline == Just IFMOffer - && ( fileSize <= fileChunkSize * receiveChunks - || (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks) - ) - -receiveViaCompleteFD :: User -> FileTransferId -> RcvFileDescr -> Bool -> Maybe CryptoFileArgs -> CM () -receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} userApprovedRelays cfArgs = - when fileDescrComplete $ do - rd <- parseFileDescription fileDescrText - if userApprovedRelays - then receive' rd True - else do - let srvs = fileServers rd - unknownSrvs <- getUnknownSrvs srvs - let approved = null unknownSrvs - ifM - ((approved ||) <$> ipProtectedForSrvs srvs) - (receive' rd approved) - (relaysNotApproved unknownSrvs) - where - receive' :: ValidFileDescription 'FRecipient -> Bool -> CM () - receive' rd approved = do - aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs approved - startReceivingFile user fileId - withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) - fileServers :: ValidFileDescription 'FRecipient -> [XFTPServer] - fileServers (FD.ValidFileDescription FD.FileDescription {chunks}) = - S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks - getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer] - getUnknownSrvs srvs = do - knownSrvs <- L.map protoServer' <$> getKnownAgentServers SPXFTP user - pure $ filter (`notElem` knownSrvs) srvs - ipProtectedForSrvs :: [XFTPServer] -> CM Bool - ipProtectedForSrvs srvs = do - netCfg <- lift getNetworkConfig - pure $ all (ipAddressProtected netCfg) srvs - relaysNotApproved :: [XFTPServer] -> CM () - relaysNotApproved unknownSrvs = do - aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation - forM_ aci_ $ \aci -> do - cleanupACIFile aci - toView $ CRChatItemUpdated user aci - throwChatError $ CEFileNotApproved fileId unknownSrvs - -getKnownAgentServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> User -> CM (NonEmpty (ServerCfg p)) -getKnownAgentServers p user = do - as <- asks randomAgentServers - withStore $ \db -> do - opDomains <- operatorDomains . serverOperators <$> getServerOperators db - srvs <- liftIO $ getProtocolServers db p user - pure $ useServerCfgs p as opDomains srvs - -protoServer' :: ServerCfg p -> ProtocolServer p -protoServer' ServerCfg {server} = protoServer server - -getNetworkConfig :: CM' NetworkConfig -getNetworkConfig = withAgent' $ liftIO . getFastNetworkConfig - -resetRcvCIFileStatus :: User -> FileTransferId -> CIFileStatus 'MDRcv -> CM (Maybe AChatItem) -resetRcvCIFileStatus user fileId ciFileStatus = do - vr <- chatVersionRange - withStore $ \db -> do - liftIO $ do - updateCIFileStatus db user fileId ciFileStatus - updateRcvFileStatus db fileId FSNew - updateRcvFileAgentId db fileId Nothing - lookupChatItemByFileId db vr user fileId - -receiveViaURI :: User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer -receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile {cryptoArgs} = do - fileId <- withStore $ \db -> createRcvStandaloneFileTransfer db userId cf fileSize chunkSize - -- currently the only use case is user migrating via their configured servers, so we pass approvedRelays = True - aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) description cryptoArgs True - withStore $ \db -> do - liftIO $ do - updateRcvFileStatus db fileId FSConnected - updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 - updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) - getRcvFileTransfer db user fileId - where - FD.ValidFileDescription FD.FileDescription {size = FD.FileSize fileSize, chunkSize = FD.FileSize chunkSize} = description - -startReceivingFile :: User -> FileTransferId -> CM () -startReceivingFile user fileId = do - vr <- chatVersionRange - ci <- withStore $ \db -> do - liftIO $ updateRcvFileStatus db fileId FSConnected - liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 - getChatItemByFileId db vr user fileId - toView $ CRRcvFileStart user ci - -getRcvFilePath :: FileTransferId -> Maybe FilePath -> String -> Bool -> CM FilePath -getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of - Nothing -> - chatReadVar filesFolder >>= \case - Nothing -> do - defaultFolder <- lift getDefaultFilesFolder - fPath <- liftIO $ defaultFolder `uniqueCombine` fn - createEmptyFile fPath $> fPath - Just filesFolder -> do - fPath <- liftIO $ filesFolder `uniqueCombine` fn - createEmptyFile fPath - pure $ takeFileName fPath - Just fPath -> - ifM - (doesDirectoryExist fPath) - (createInPassedDirectory fPath) - $ ifM - (doesFileExist fPath) - (throwChatError $ CEFileAlreadyExists fPath) - (createEmptyFile fPath $> fPath) - where - createInPassedDirectory :: FilePath -> CM FilePath - createInPassedDirectory fPathDir = do - fPath <- liftIO $ fPathDir `uniqueCombine` fn - createEmptyFile fPath $> fPath - createEmptyFile :: FilePath -> CM () - createEmptyFile fPath = emptyFile `catchThrow` (ChatError . CEFileWrite fPath . show) - where - emptyFile :: CM () - emptyFile - | keepHandle = do - h <- getFileHandle fileId fPath rcvFiles AppendMode - liftIO $ B.hPut h "" >> hFlush h - | otherwise = liftIO $ B.writeFile fPath "" - -acceptContactRequest :: User -> UserContactRequest -> IncognitoEnabled -> CM (Contact, Connection, SndQueueSecured) -acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, contactId_, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId, pqSupport} incognito = do - subMode <- chatReadVar subscriptionMode - let pqSup = PQSupportOn - pqSup' = pqSup `CR.pqSupportAnd` pqSupport - vr <- chatVersionRange - let chatV = vr `peerConnChatVersion` cReqChatVRange - (ct, conn, incognitoProfile) <- case contactId_ of - Nothing -> do - incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - connId <- withAgent $ \a -> prepareConnectionToAccept a True invId pqSup' - (ct, conn) <- withStore' $ \db -> createAcceptedContact db user connId chatV cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' False - pure (ct, conn, incognitoProfile) - Just contactId -> do - ct <- withFastStore $ \db -> getContact db vr user contactId - case contactConn ct of - Nothing -> throwChatError $ CECommandError "contact has no connection" - Just conn@Connection {customUserProfileId} -> do - incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId - pure (ct, conn, ExistingIncognito <$> incognitoProfile) - let profileToSend = profileToSendOnAccept user incognitoProfile False - dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend - (ct,conn,) <$> withAgent (\a -> acceptContact a (aConnId conn) True invId dm pqSup' subMode) - -acceptContactRequestAsync :: User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQSupport -> CM Contact -acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqSup = do - subMode <- chatReadVar subscriptionMode - let profileToSend = profileToSendOnAccept user incognitoProfile False - vr <- chatVersionRange - let chatV = vr `peerConnChatVersion` cReqChatVRange - (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode pqSup chatV - withStore' $ \db -> do - (ct, Connection {connId}) <- createAcceptedContact db user acId chatV cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed - deleteContactRequestRec db user cReq - setCommandConnId db user cmdId connId - pure ct - -acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember -acceptGroupJoinRequestAsync - user - gInfo@GroupInfo {groupProfile, membership, businessChat} - ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange} - gLinkMemRole - incognitoProfile = do - gVar <- asks random - (groupMemberId, memberId) <- withStore $ \db -> do - liftIO $ deleteContactRequestRec db user ucr - createAcceptedMember db gVar user gInfo ucr gLinkMemRole - currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo - let Profile {displayName} = profileToSendOnAccept user incognitoProfile True - GroupMember {memberRole = userRole, memberId = userMemberId} = membership - msg = - XGrpLinkInv $ - GroupLinkInvitation - { fromMember = MemberIdRole userMemberId userRole, - fromMemberName = displayName, - invitedMember = MemberIdRole memberId gLinkMemRole, - groupProfile, - business = businessChat, - groupSize = Just currentMemCount - } - subMode <- chatReadVar subscriptionMode - vr <- chatVersionRange - let chatV = vr `peerConnChatVersion` cReqChatVRange - connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV - withStore $ \db -> do - liftIO $ createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode - getGroupMemberById db vr user groupMemberId - -acceptBusinessJoinRequestAsync :: User -> UserContactRequest -> CM GroupInfo -acceptBusinessJoinRequestAsync - user - ucr@UserContactRequest {contactRequestId, agentInvitationId = AgentInvId invId, cReqChatVRange} = do - vr <- chatVersionRange - gVar <- asks random - let userProfile@Profile {displayName, preferences} = profileToSendOnAccept user Nothing True - groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences - (gInfo, clientMember) <- withStore $ \db -> do - liftIO $ deleteContactRequest db user contactRequestId - createBusinessRequestGroup db vr gVar user ucr groupPreferences - let GroupInfo {membership} = gInfo - GroupMember {memberRole = userRole, memberId = userMemberId} = membership - GroupMember {groupMemberId, memberId} = clientMember - msg = - XGrpLinkInv $ - GroupLinkInvitation - { fromMember = MemberIdRole userMemberId userRole, - fromMemberName = displayName, - invitedMember = MemberIdRole memberId GRMember, - groupProfile = businessGroupProfile userProfile groupPreferences, - -- This refers to the "title member" that defines the group name and profile. - -- This coincides with fromMember to be current user when accepting the connecting user, - -- but it will be different when inviting somebody else. - business = Just $ BusinessChatInfo {chatType = BCBusiness, businessId = userMemberId, customerId = memberId}, - groupSize = Just 1 - } - subMode <- chatReadVar subscriptionMode - let chatV = vr `peerConnChatVersion` cReqChatVRange - connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV - withStore' $ \db -> createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode - let cd = CDGroupSnd gInfo - createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing - createGroupFeatureItems user cd CISndGroupFeature gInfo - pure gInfo - where - businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile - businessGroupProfile Profile {displayName, fullName, image} groupPreferences = - GroupProfile {displayName, fullName, description = Nothing, image, groupPreferences = Just groupPreferences} - -profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Bool -> Profile -profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing - where - getIncognitoProfile = \case - NewIncognito p -> p - ExistingIncognito lp -> fromLocalProfile lp - -deleteGroupLink' :: User -> GroupInfo -> CM () -deleteGroupLink' user gInfo = do - vr <- chatVersionRange - conn <- withStore $ \db -> getGroupLinkConnection db vr user gInfo - deleteGroupLink_ user gInfo conn - -deleteGroupLinkIfExists :: User -> GroupInfo -> CM () -deleteGroupLinkIfExists user gInfo = do - vr <- chatVersionRange - conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db vr user gInfo) - mapM_ (deleteGroupLink_ user gInfo) conn_ - -deleteGroupLink_ :: User -> GroupInfo -> Connection -> CM () -deleteGroupLink_ user gInfo conn = do - deleteAgentConnectionAsync user $ aConnId conn - withStore' $ \db -> deleteGroupLink db user gInfo - -agentSubscriber :: CM' () -agentSubscriber = do - q <- asks $ subQ . smpAgent - forever (atomically (readTBQueue q) >>= process) - `E.catchAny` \e -> do - toView' $ CRChatError Nothing $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) Nothing - E.throwIO e - where - process :: (ACorrId, AEntityId, AEvt) -> CM' () - process (corrId, entId, AEvt e msg) = run $ case e of - SAENone -> processAgentMessageNoConn msg - SAEConn -> processAgentMessage corrId entId msg - SAERcvFile -> processAgentMsgRcvFile corrId entId msg - SAESndFile -> processAgentMsgSndFile corrId entId msg - where - run action = action `catchChatError'` (toView' . CRChatError Nothing) - -type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType ())) - -subscribeUserConnections :: VersionRangeChat -> Bool -> AgentBatchSubscribe -> User -> CM () -subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do - -- get user connections - ce <- asks $ subscriptionEvents . config - (conns, cts, ucs, gs, ms, sfts, rfts, pcs) <- - if onlyNeeded - then do - (conns, entities) <- withStore' (`getConnectionsToSubscribe` vr) - let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity (M.empty, M.empty, M.empty, M.empty, M.empty, M.empty) entities - pure (conns, cts, ucs, [], ms, sfts, rfts, pcs) - else do - withStore' unsetConnectionToSubscribe - (ctConns, cts) <- getContactConns - (ucConns, ucs) <- getUserContactLinkConns - (gs, mConns, ms) <- getGroupMemberConns - (sftConns, sfts) <- getSndFileTransferConns - (rftConns, rfts) <- getRcvFileTransferConns - (pcConns, pcs) <- getPendingContactConns - let conns = concat ([ctConns, ucConns, mConns, sftConns, rftConns, pcConns] :: [[ConnId]]) - pure (conns, cts, ucs, gs, ms, sfts, rfts, pcs) - -- subscribe using batched commands - rs <- withAgent $ \a -> agentBatchSubscribe a conns - -- send connection events to view - contactSubsToView rs cts ce - -- TODO possibly, we could either disable these events or replace with less noisy for API - contactLinkSubsToView rs ucs - groupSubsToView rs gs ms ce - sndFileSubsToView rs sfts - rcvFileSubsToView rs rfts - pendingConnSubsToView rs pcs - where - addEntity (cts, ucs, ms, sfts, rfts, pcs) = \case - RcvDirectMsgConnection c (Just ct) -> let cts' = addConn c ct cts in (cts', ucs, ms, sfts, rfts, pcs) - RcvDirectMsgConnection c Nothing -> let pcs' = addConn c (toPCC c) pcs in (cts, ucs, ms, sfts, rfts, pcs') - RcvGroupMsgConnection c _g m -> let ms' = addConn c m ms in (cts, ucs, ms', sfts, rfts, pcs) - SndFileConnection c sft -> let sfts' = addConn c sft sfts in (cts, ucs, ms, sfts', rfts, pcs) - RcvFileConnection c rft -> let rfts' = addConn c rft rfts in (cts, ucs, ms, sfts, rfts', pcs) - UserContactConnection c uc -> let ucs' = addConn c uc ucs in (cts, ucs', ms, sfts, rfts, pcs) - addConn :: Connection -> a -> Map ConnId a -> Map ConnId a - addConn = M.insert . aConnId - toPCC Connection {connId, agentConnId, connStatus, viaUserContactLink, groupLinkId, customUserProfileId, localAlias, createdAt} = - PendingContactConnection - { pccConnId = connId, - pccAgentConnId = agentConnId, - pccConnStatus = connStatus, - viaContactUri = False, - viaUserContactLink, - groupLinkId, - customUserProfileId, - connReqInv = Nothing, - localAlias, - createdAt, - updatedAt = createdAt - } - getContactConns :: CM ([ConnId], Map ConnId Contact) - getContactConns = do - cts <- withStore_ (`getUserContacts` vr) - let cts' = mapMaybe (\ct -> (,ct) <$> contactConnId ct) $ filter contactActive cts - pure (map fst cts', M.fromList cts') - getUserContactLinkConns :: CM ([ConnId], Map ConnId UserContact) - getUserContactLinkConns = do - (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr) - let connIds = map aConnId cs - pure (connIds, M.fromList $ zip connIds ucs) - getGroupMemberConns :: CM ([Group], [ConnId], Map ConnId GroupMember) - getGroupMemberConns = do - gs <- withStore_ (`getUserGroups` vr) - let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs - pure (gs, map fst mPairs, M.fromList mPairs) - getSndFileTransferConns :: CM ([ConnId], Map ConnId SndFileTransfer) - getSndFileTransferConns = do - sfts <- withStore_ getLiveSndFileTransfers - let connIds = map sndFileTransferConnId sfts - pure (connIds, M.fromList $ zip connIds sfts) - getRcvFileTransferConns :: CM ([ConnId], Map ConnId RcvFileTransfer) - getRcvFileTransferConns = do - rfts <- withStore_ getLiveRcvFileTransfers - let rftPairs = mapMaybe (\ft -> (,ft) <$> liveRcvFileTransferConnId ft) rfts - pure (map fst rftPairs, M.fromList rftPairs) - getPendingContactConns :: CM ([ConnId], Map ConnId PendingContactConnection) - getPendingContactConns = do - pcs <- withStore_ getPendingContactConnections - let connIds = map aConnId' pcs - pure (connIds, M.fromList $ zip connIds pcs) - contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> CM () - contactSubsToView rs cts ce = do - chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses) - ifM (asks $ coreApi . config) (notifyAPI statuses) notifyCLI - where - notifyCLI = do - let cRs = resultsFor rs cts - cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs - toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs - when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors - notifyAPI = toView . CRNetworkStatuses (Just user) . map (uncurry ConnNetworkStatus) - statuses = M.foldrWithKey' addStatus [] cts - where - addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)] - addStatus _ Contact {activeConn = Nothing} nss = nss - addStatus connId Contact {activeConn = Just Connection {agentConnId}} nss = - let ns = (agentConnId, netStatus $ resultErr connId rs) - in ns : nss - netStatus :: Maybe ChatError -> NetworkStatus - netStatus = maybe NSConnected $ NSError . errorNetworkStatus - errorNetworkStatus :: ChatError -> String - errorNetworkStatus = \case - ChatErrorAgent (BROKER _ NETWORK) _ -> "network" - ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted" - e -> show e - -- TODO possibly below could be replaced with less noisy events for API - contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM () - contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs - groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> CM () - groupSubsToView rs gs ms ce = do - mapM_ groupSub $ - sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs - toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs - where - mRs = resultsFor rs ms - groupSub :: Group -> CM () - groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do - when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors - toView groupEvent - where - mErrors :: [(GroupMember, ChatError)] - mErrors = - sortOn (\(GroupMember {localDisplayName = n}, _) -> n) - . filterErrors - $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs - groupEvent :: ChatResponse - groupEvent - | memberStatus membership == GSMemInvited = CRGroupInvitation user g - | all (\GroupMember {activeConn} -> isNothing activeConn) members = - if memberActive membership - then CRGroupEmpty user g - else CRGroupRemoved user g - | otherwise = CRGroupSubscribed user g - sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> CM () - sndFileSubsToView rs sfts = do - let sftRs = resultsFor rs sfts - forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do - forM_ err_ $ toView . CRSndFileSubError user ft - void . forkIO $ do - threadDelay 1000000 - when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withChatLock "subscribe sendFileChunk" $ - sendFileChunk user ft - rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> CM () - rcvFileSubsToView rs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . filterErrors . resultsFor rs - pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> CM () - pendingConnSubsToView rs = toView . CRPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs - withStore_ :: (DB.Connection -> User -> IO [a]) -> CM [a] - withStore_ a = withStore' (`a` user) `catchChatError` \e -> toView (CRChatError (Just user) e) $> [] - filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)] - filterErrors = mapMaybe (\(a, e_) -> (a,) <$> e_) - resultsFor :: Map ConnId (Either AgentErrorType ()) -> Map ConnId a -> [(a, Maybe ChatError)] - resultsFor rs = M.foldrWithKey' addResult [] - where - addResult :: ConnId -> a -> [(a, Maybe ChatError)] -> [(a, Maybe ChatError)] - addResult connId = (:) . (,resultErr connId rs) - resultErr :: ConnId -> Map ConnId (Either AgentErrorType ()) -> Maybe ChatError - resultErr connId rs = case M.lookup connId rs of - Just (Left e) -> Just $ ChatErrorAgent e Nothing - Just _ -> Nothing - _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId - -cleanupManager :: CM () -cleanupManager = do - interval <- asks (cleanupManagerInterval . config) - runWithoutInitialDelay interval - initialDelay <- asks (initialCleanupManagerDelay . config) - liftIO $ threadDelay' initialDelay - stepDelay <- asks (cleanupManagerStepDelay . config) - forever $ do - flip catchChatError (toView . CRChatError Nothing) $ do - lift waitChatStartedAndActivated - users <- withStore' getUsers - let (us, us') = partition activeUser users - forM_ us $ cleanupUser interval stepDelay - forM_ us' $ cleanupUser interval stepDelay - cleanupMessages `catchChatError` (toView . CRChatError Nothing) - -- TODO possibly, also cleanup async commands - cleanupProbes `catchChatError` (toView . CRChatError Nothing) - liftIO $ threadDelay' $ diffToMicroseconds interval - where - runWithoutInitialDelay cleanupInterval = flip catchChatError (toView . CRChatError Nothing) $ do - lift waitChatStartedAndActivated - users <- withStore' getUsers - let (us, us') = partition activeUser users - forM_ us $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CRChatError (Just u)) - forM_ us' $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CRChatError (Just u)) - cleanupUser cleanupInterval stepDelay user = do - cleanupTimedItems cleanupInterval user `catchChatError` (toView . CRChatError (Just user)) - liftIO $ threadDelay' stepDelay - cleanupDeletedContacts user `catchChatError` (toView . CRChatError (Just user)) - liftIO $ threadDelay' stepDelay - cleanupTimedItems cleanupInterval user = do - ts <- liftIO getCurrentTime - let startTimedThreadCutoff = addUTCTime cleanupInterval ts - timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff - forM_ timedItems $ \(itemRef, deleteAt) -> startTimedItemThread user itemRef deleteAt `catchChatError` const (pure ()) - cleanupDeletedContacts user = do - vr <- chatVersionRange - contacts <- withStore' $ \db -> getDeletedContacts db vr user - forM_ contacts $ \ct -> - withStore (\db -> deleteContactWithoutGroups db user ct) - `catchChatError` (toView . CRChatError (Just user)) - cleanupMessages = do - ts <- liftIO getCurrentTime - let cutoffTs = addUTCTime (-(30 * nominalDay)) ts - withStore' (`deleteOldMessages` cutoffTs) - cleanupProbes = do - ts <- liftIO getCurrentTime - let cutoffTs = addUTCTime (-(14 * nominalDay)) ts - withStore' (`deleteOldProbes` cutoffTs) - -startProximateTimedItemThread :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM () -startProximateTimedItemThread user itemRef deleteAt = do - interval <- asks (cleanupManagerInterval . config) - ts <- liftIO getCurrentTime - when (diffUTCTime deleteAt ts <= interval) $ - startTimedItemThread user itemRef deleteAt - -startTimedItemThread :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM () -startTimedItemThread user itemRef deleteAt = do - itemThreads <- asks timedItemThreads - threadTVar_ <- atomically $ do - exists <- TM.member itemRef itemThreads - if not exists - then do - threadTVar <- newTVar Nothing - TM.insert itemRef threadTVar itemThreads - pure $ Just threadTVar - else pure Nothing - forM_ threadTVar_ $ \threadTVar -> do - tId <- mkWeakThreadId =<< deleteTimedItem user itemRef deleteAt `forkFinally` const (atomically $ TM.delete itemRef itemThreads) - atomically $ writeTVar threadTVar (Just tId) - -deleteTimedItem :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM () -deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do - ts <- liftIO getCurrentTime - liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts - lift waitChatStartedAndActivated - vr <- chatVersionRange - case cType of - CTDirect -> do - (ct, ci) <- withStore $ \db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId - deleteDirectCIs user ct [ci] True True >>= toView - CTGroup -> do - (gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db vr user chatId <*> getGroupChatItem db user chatId itemId - deletedTs <- liftIO getCurrentTime - deleteGroupCIs user gInfo [ci] True True Nothing deletedTs >>= toView - _ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType" - -startUpdatedTimedItemThread :: User -> ChatRef -> ChatItem c d -> ChatItem c d -> CM () -startUpdatedTimedItemThread user chatRef ci ci' = - case (chatItemTimed ci >>= timedDeleteAt', chatItemTimed ci' >>= timedDeleteAt') of - (Nothing, Just deleteAt') -> - startProximateTimedItemThread user (chatRef, chatItemId' ci') deleteAt' - _ -> pure () - -expireChatItems :: User -> Int64 -> Bool -> CM () -expireChatItems user@User {userId} ttl sync = do - currentTs <- liftIO getCurrentTime - vr <- chatVersionRange - let expirationDate = addUTCTime (-1 * fromIntegral ttl) currentTs - -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts - createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs - lift waitChatStartedAndActivated - contacts <- withStore' $ \db -> getUserContacts db vr user - loop contacts $ processContact expirationDate - lift waitChatStartedAndActivated - groups <- withStore' $ \db -> getUserGroupDetails db vr user Nothing Nothing - loop groups $ processGroup vr expirationDate createdAtCutoff - where - loop :: [a] -> (a -> CM ()) -> CM () - loop [] _ = pure () - loop (a : as) process = continue $ do - process a `catchChatError` (toView . CRChatError (Just user)) - loop as process - continue :: CM () -> CM () - continue a = - if sync - then a - else do - expireFlags <- asks expireCIFlags - expire <- atomically $ TM.lookup userId expireFlags - when (expire == Just True) $ threadDelay 100000 >> a - processContact :: UTCTime -> Contact -> CM () - processContact expirationDate ct = do - lift waitChatStartedAndActivated - filesInfo <- withStore' $ \db -> getContactExpiredFileInfo db user ct expirationDate - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - withStore' $ \db -> deleteContactExpiredCIs db user ct expirationDate - processGroup :: VersionRangeChat -> UTCTime -> UTCTime -> GroupInfo -> CM () - processGroup vr expirationDate createdAtCutoff gInfo = do - lift waitChatStartedAndActivated - filesInfo <- withStore' $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - withStore' $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff - membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db vr user gInfo - forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m - -processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM () -processAgentMessage _ connId (DEL_RCVQ srv qId err_) = - toView $ CRAgentRcvQueueDeleted (AgentConnId connId) srv (AgentQueueId qId) err_ -processAgentMessage _ connId DEL_CONN = - toView $ CRAgentConnDeleted (AgentConnId connId) -processAgentMessage _ "" (ERR e) = - toView $ CRChatError Nothing $ ChatErrorAgent e Nothing -processAgentMessage corrId connId msg = do - lockEntity <- critical (withStore (`getChatLockEntity` AgentConnId connId)) - withEntityLock "processAgentMessage" lockEntity $ do - vr <- chatVersionRange - -- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here - critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case - Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user)) - _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) - --- CRITICAL error will be shown to the user as alert with restart button in Android/desktop apps. --- SEDBBusyError will only be thrown on IO exceptions or SQLError during DB queries, --- e.g. when database is locked or busy for longer than 3s. --- In this case there is no better mitigation than showing alert: --- - without ACK the message delivery will be stuck, --- - with ACK message will be lost, as it failed to be saved. --- Full app restart is likely to resolve database condition and the message will be received and processed again. -critical :: CM a -> CM a -critical a = - a `catchChatError` \case - ChatErrorStore SEDBBusyError {message} -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing - e -> throwError e - -processAgentMessageNoConn :: AEvent 'AENone -> CM () -processAgentMessageNoConn = \case - CONNECT p h -> hostEvent $ CRHostConnected p h - DISCONNECT p h -> hostEvent $ CRHostDisconnected p h - DOWN srv conns -> serverEvent srv conns NSDisconnected CRContactsDisconnected - UP srv conns -> serverEvent srv conns NSConnected CRContactsSubscribed - SUSPENDED -> toView CRChatSuspended - DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId - ERRS cErrs -> errsEvent cErrs - where - hostEvent :: ChatResponse -> CM () - hostEvent = whenM (asks $ hostEvents . config) . toView - serverEvent srv conns nsStatus event = do - chatModifyVar connNetworkStatuses $ \m -> foldl' (\m' cId -> M.insert cId nsStatus m') m connIds - ifM (asks $ coreApi . config) (notifyAPI connIds) notifyCLI - where - connIds = map AgentConnId conns - notifyAPI = toView . CRNetworkStatus nsStatus - notifyCLI = do - cs <- withStore' (`getConnectionsContacts` conns) - toView $ event srv cs - errsEvent :: [(ConnId, AgentErrorType)] -> CM () - errsEvent cErrs = do - vr <- chatVersionRange - errs <- lift $ rights <$> withStoreBatch' (\db -> map (getChatErr vr db) cErrs) - toView $ CRChatErrors Nothing errs - where - getChatErr :: VersionRangeChat -> DB.Connection -> (ConnId, AgentErrorType) -> IO ChatError - getChatErr vr db (connId, err) = - let acId = AgentConnId connId - in ChatErrorAgent err <$> (getUserByAConnId db acId $>>= \user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)) - -processAgentMsgSndFile :: ACorrId -> SndFileId -> AEvent 'AESndFile -> CM () -processAgentMsgSndFile _corrId aFileId msg = do - (cRef_, fileId) <- withStore (`getXFTPSndFileDBIds` AgentSndFileId aFileId) - withEntityLock_ cRef_ . withFileLock "processAgentMsgSndFile" fileId $ - withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case - Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user)) - _ -> do - lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId - where - withEntityLock_ :: Maybe ChatRef -> CM a -> CM a - withEntityLock_ cRef_ = case cRef_ of - Just (ChatRef CTDirect contactId) -> withContactLock "processAgentMsgSndFile" contactId - Just (ChatRef CTGroup groupId) -> withGroupLock "processAgentMsgSndFile" groupId - _ -> id - process :: User -> FileTransferId -> CM () - process user fileId = do - (ft@FileTransferMeta {xftpRedirectFor, cancelled}, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId - vr <- chatVersionRange - unless cancelled $ case msg of - SFPROG sndProgress sndTotal -> do - let status = CIFSSndTransfer {sndProgress, sndTotal} - ci <- withStore $ \db -> do - liftIO $ updateCIFileStatus db user fileId status - lookupChatItemByFileId db vr user fileId - toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal - SFDONE sndDescr rfds -> do - withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr) - ci <- withStore $ \db -> lookupChatItemByFileId db vr user fileId - case ci of - Nothing -> do - lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText rfds) - case rfds of - [] -> sendFileError (FileErrOther "no receiver descriptions") "no receiver descriptions" vr ft - rfd : _ -> case [fd | fd@(FD.ValidFileDescription FD.FileDescription {chunks = [_]}) <- rfds] of - [] -> case xftpRedirectFor of - Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CRSndFileRedirectStartXFTP user ft - Just _ -> sendFileError (FileErrOther "chaining redirects") "Prohibit chaining redirects" vr ft - rfds' -> do - -- we have 1 chunk - use it as URI whether it is redirect or not - ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor - toView $ CRSndStandaloneFileComplete user ft' $ map (decodeLatin1 . strEncode . FD.fileDescriptionURI) rfds' - Just (AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) -> - case (msgId_, itemDeleted) of - (Just sharedMsgId, Nothing) -> do - when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send" - -- TODO either update database status or move to SFPROG - toView $ CRSndFileProgressXFTP user ci ft 1 1 - case (rfds, sfts, d, cInfo) of - (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do - withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) - conn@Connection {connId} <- liftEither $ contactSendConn_ ct - sendFileDescriptions (ConnectionId connId) ((conn, sft, fileDescrText rfd) :| []) sharedMsgId >>= \case - Just rs -> case L.last rs of - Right ([msgDeliveryId], _) -> - withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId - Right (deliveryIds, _) -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError $ "SFDONE, sendFileDescriptions: expected 1 delivery id, got " <> show (length deliveryIds) - Left e -> toView $ CRChatError (Just user) e - Nothing -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError "SFDONE, sendFileDescriptions: expected at least 1 result" - lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do - ms <- withStore' $ \db -> getGroupMembers db vr user g - let rfdsMemberFTs = zipWith (\rfd (conn, sft) -> (conn, sft, fileDescrText rfd)) rfds (memberFTs ms) - extraRFDs = drop (length rfdsMemberFTs) rfds - withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) - forM_ (L.nonEmpty rfdsMemberFTs) $ \rfdsMemberFTs' -> - sendFileDescriptions (GroupId groupId) rfdsMemberFTs' sharedMsgId - ci' <- withStore $ \db -> do - liftIO $ updateCIFileStatus db user fileId CIFSSndComplete - getChatItemByFileId db vr user fileId - lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - toView $ CRSndFileCompleteXFTP user ci' ft - where - memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)] - memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts') - where - mConns' = mapMaybe useMember ms - sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts - -- Should match memberSendAction logic - useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}} - | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) && not (connInactive conn) = - Just (groupMemberId, conn) - | otherwise = Nothing - useMember _ = Nothing - _ -> pure () - _ -> pure () -- TODO error? - SFWARN e -> do - let err = tshow e - logWarn $ "Sent file warning: " <> err - ci <- withStore $ \db -> do - liftIO $ updateCIFileStatus db user fileId (CIFSSndWarning $ agentFileError e) - lookupChatItemByFileId db vr user fileId - toView $ CRSndFileWarning user ci ft err - SFERR e -> - sendFileError (agentFileError e) (tshow e) vr ft - where - fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text - fileDescrText = safeDecodeUtf8 . strEncode - sendFileDescriptions :: ConnOrGroupId -> NonEmpty (Connection, SndFileTransfer, RcvFileDescrText) -> SharedMsgId -> CM (Maybe (NonEmpty (Either ChatError ([Int64], PQEncryption)))) - sendFileDescriptions connOrGroupId connsTransfersDescrs sharedMsgId = do - lift . void . withStoreBatch' $ \db -> L.map (\(_, sft, rfdText) -> updateSndFTDescrXFTP db user sft rfdText) connsTransfersDescrs - partSize <- asks $ xftpDescrPartSize . config - let connsIdsEvts = connDescrEvents partSize - sndMsgs_ <- lift $ createSndMessages $ L.map snd connsIdsEvts - let (errs, msgReqs) = partitionEithers . L.toList $ L.zipWith (fmap . toMsgReq) connsIdsEvts sndMsgs_ - delivered <- mapM deliverMessages (L.nonEmpty msgReqs) - let errs' = errs <> maybe [] (lefts . L.toList) delivered - unless (null errs') $ toView $ CRChatErrors (Just user) errs' - pure delivered - where - connDescrEvents :: Int -> NonEmpty (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) - connDescrEvents partSize = L.fromList $ concatMap splitText (L.toList connsTransfersDescrs) - where - splitText :: (Connection, SndFileTransfer, RcvFileDescrText) -> [(Connection, (ConnOrGroupId, ChatMsgEvent 'Json))] - splitText (conn, _, rfdText) = - map (\fileDescr -> (conn, (connOrGroupId, XMsgFileDescr {msgId = sharedMsgId, fileDescr}))) (L.toList $ splitFileDescr partSize rfdText) - toMsgReq :: (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) -> SndMessage -> ChatMsgReq - toMsgReq (conn, _) SndMessage {msgId, msgBody} = - (conn, MsgFlags {notification = hasNotification XMsgFileDescr_}, msgBody, [msgId]) - sendFileError :: FileError -> Text -> VersionRangeChat -> FileTransferMeta -> CM () - sendFileError ferr err vr ft = do - logError $ "Sent file error: " <> err - ci <- withStore $ \db -> do - liftIO $ updateFileCancelled db user fileId (CIFSSndError ferr) - lookupChatItemByFileId db vr user fileId - lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - toView $ CRSndFileError user ci ft err - -agentFileError :: AgentErrorType -> FileError -agentFileError = \case - XFTP _ XFTP.AUTH -> FileErrAuth - FILE NO_FILE -> FileErrNoFile - BROKER _ e -> brokerError FileErrRelay e - e -> FileErrOther $ tshow e - where - brokerError srvErr = \case - HOST -> srvErr SrvErrHost - SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion - e -> srvErr . SrvErrOther $ tshow e - -splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr -splitFileDescr partSize rfdText = splitParts 1 rfdText - where - splitParts partNo remText = - let (part, rest) = T.splitAt partSize remText - complete = T.null rest - fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete} - in if complete - then fileDescr :| [] - else fileDescr <| splitParts (partNo + 1) rest - -processAgentMsgRcvFile :: ACorrId -> RcvFileId -> AEvent 'AERcvFile -> CM () -processAgentMsgRcvFile _corrId aFileId msg = do - (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId) - withEntityLock_ cRef_ . withFileLock "processAgentMsgRcvFile" fileId $ - withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case - Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user)) - _ -> do - lift $ withAgent' (`xftpDeleteRcvFile` aFileId) - throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId - where - withEntityLock_ :: Maybe ChatRef -> CM a -> CM a - withEntityLock_ cRef_ = case cRef_ of - Just (ChatRef CTDirect contactId) -> withContactLock "processAgentMsgRcvFile" contactId - Just (ChatRef CTGroup groupId) -> withGroupLock "processAgentMsgRcvFile" groupId - _ -> id - process :: User -> FileTransferId -> CM () - process user fileId = do - ft <- withStore $ \db -> getRcvFileTransfer db user fileId - vr <- chatVersionRange - unless (rcvFileCompleteOrCancelled ft) $ case msg of - RFPROG rcvProgress rcvTotal -> do - let status = CIFSRcvTransfer {rcvProgress, rcvTotal} - ci <- withStore $ \db -> do - liftIO $ updateCIFileStatus db user fileId status - lookupChatItemByFileId db vr user fileId - toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal ft - RFDONE xftpPath -> - case liveRcvFileTransferPath ft of - Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file" - Just targetPath -> do - fsTargetPath <- lift $ toFSFilePath targetPath - renameFile xftpPath fsTargetPath - ci_ <- withStore $ \db -> do - liftIO $ do - updateRcvFileStatus db fileId FSComplete - updateCIFileStatus db user fileId CIFSRcvComplete - lookupChatItemByFileId db vr user fileId - agentXFTPDeleteRcvFile aFileId fileId - toView $ maybe (CRRcvStandaloneFileComplete user fsTargetPath ft) (CRRcvFileComplete user) ci_ - RFWARN e -> do - ci <- withStore $ \db -> do - liftIO $ updateCIFileStatus db user fileId (CIFSRcvWarning $ agentFileError e) - lookupChatItemByFileId db vr user fileId - toView $ CRRcvFileWarning user ci e ft - RFERR e - | e == FILE NOT_APPROVED -> do - aci_ <- resetRcvCIFileStatus user fileId CIFSRcvAborted - forM_ aci_ cleanupACIFile - agentXFTPDeleteRcvFile aFileId fileId - forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci - | otherwise -> do - aci_ <- withStore $ \db -> do - liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ agentFileError e) - lookupChatItemByFileId db vr user fileId - forM_ aci_ cleanupACIFile - agentXFTPDeleteRcvFile aFileId fileId - toView $ CRRcvFileError user aci_ e ft - -cleanupACIFile :: AChatItem -> CM () -cleanupACIFile (AChatItem _ _ _ ChatItem {file = Just CIFile {fileSource = Just CryptoFile {filePath}}}) = do - fsFilePath <- lift $ toFSFilePath filePath - removeFile fsFilePath `catchChatError` \_ -> pure () -cleanupACIFile _ = pure () - -processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM () -processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do - -- Missing connection/entity errors here will be sent to the view but not shown as CRITICAL alert, - -- as in this case no need to ACK message - we can't process messages for this connection anyway. - -- SEDBException will be re-trown as CRITICAL as it is likely to indicate a temporary database condition - -- that will be resolved with app restart. - entity <- critical $ withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus - case agentMessage of - END -> case entity of - RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct - _ -> toView $ CRSubscriptionEnd user entity - MSGNTF msgId msgTs_ -> toView $ CRNtfMessage user entity $ ntfMsgAckInfo msgId msgTs_ - _ -> case entity of - RcvDirectMsgConnection conn contact_ -> - processDirectMessage agentMessage entity conn contact_ - RcvGroupMsgConnection conn gInfo m -> - processGroupMessage agentMessage entity conn gInfo m - RcvFileConnection conn ft -> - processRcvFileConn agentMessage entity conn ft - SndFileConnection conn ft -> - processSndFileConn agentMessage entity conn ft - UserContactConnection conn uc -> - processUserContactRequest agentMessage entity conn uc - where - updateConnStatus :: ConnectionEntity -> CM ConnectionEntity - updateConnStatus acEntity = case agentMsgConnStatus agentMessage of - Just connStatus -> do - let conn = (entityConnection acEntity) {connStatus} - withStore' $ \db -> updateConnectionStatus db conn connStatus - pure $ updateEntityConnStatus acEntity connStatus - Nothing -> pure acEntity - - agentMsgConnStatus :: AEvent e -> Maybe ConnStatus - agentMsgConnStatus = \case - JOINED True -> Just ConnSndReady - CONF {} -> Just ConnRequested - INFO {} -> Just ConnSndReady - CON _ -> Just ConnReady - _ -> Nothing - - processCONFpqSupport :: Connection -> PQSupport -> CM Connection - processCONFpqSupport conn@Connection {connId, pqSupport = pq} pq' - | pq == PQSupportOn && pq' == PQSupportOff = do - let pqEnc' = CR.pqSupportToEnc pq' - withStore' $ \db -> updateConnSupportPQ db connId pq' pqEnc' - pure (conn {pqSupport = pq', pqEncryption = pqEnc'} :: Connection) - | pq /= pq' = do - messageWarning "processCONFpqSupport: unexpected pqSupport change" - pure conn - | otherwise = pure conn - - processINFOpqSupport :: Connection -> PQSupport -> CM () - processINFOpqSupport Connection {pqSupport = pq} pq' = - when (pq /= pq') $ messageWarning "processINFOpqSupport: unexpected pqSupport change" - - processDirectMessage :: AEvent e -> ConnectionEntity -> Connection -> Maybe Contact -> CM () - processDirectMessage agentMsg connEntity conn@Connection {connId, connChatVersion, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case - Nothing -> case agentMsg of - CONF confId pqSupport _ connInfo -> do - conn' <- processCONFpqSupport conn pqSupport - -- [incognito] send saved profile - (conn'', inGroup) <- saveConnInfo conn' connInfo - incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing inGroup - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend - INFO pqSupport connInfo -> do - processINFOpqSupport conn pqSupport - void $ saveConnInfo conn connInfo - MSG meta _msgFlags _msgBody -> - -- We are not saving message (saveDirectRcvMSG) as contact hasn't been created yet, - -- chat item is also not created here - withAckMessage' "new contact msg" agentConnId meta $ pure () - SENT msgId _proxy -> do - void $ continueSending connEntity conn - sentMsgDeliveryEvent conn msgId - OK -> - -- [async agent commands] continuation on receiving OK - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - JOINED _ -> - -- [async agent commands] continuation on receiving JOINED - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - QCONT -> - void $ continueSending connEntity conn - MWARN _ err -> - processConnMWARN connEntity conn err - MERR _ err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - processConnMERR connEntity conn err - MERRS _ err -> do - -- error cannot be AUTH error here - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - -- TODO add debugging output - _ -> pure () - Just ct@Contact {contactId} -> case agentMsg of - INV (ACR _ cReq) -> - -- [async agent commands] XGrpMemIntro continuation on receiving INV - withCompletedCommand conn agentMsg $ \_ -> - case cReq of - directConnReq@(CRInvitationUri _ _) -> do - contData <- withStore' $ \db -> do - setConnConnReqInv db user connId cReq - getXGrpMemIntroContDirect db user ct - forM_ contData $ \(hostConnId, xGrpMemIntroCont) -> - sendXGrpMemInv hostConnId (Just directConnReq) xGrpMemIntroCont - CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" - MSG msgMeta _msgFlags msgBody -> do - tags <- newTVarIO [] - withAckMessage "contact msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do - let MsgMeta {pqEncryption} = msgMeta - (ct', conn') <- updateContactPQRcv user ct conn pqEncryption - checkIntegrityCreateItem (CDDirectRcv ct') msgMeta `catchChatError` \_ -> pure () - forM_ aChatMsgs $ \case - Right (ACMsg _ chatMsg) -> - processEvent ct' conn' tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e - Left e -> do - atomically $ modifyTVar' tags ("error" :) - logInfo $ "contact msg=error " <> eInfo <> " " <> tshow e - toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) - checkSendRcpt ct' $ rights aChatMsgs -- not crucial to use ct'' from processEvent - where - aChatMsgs = parseChatMessages msgBody - processEvent :: Contact -> Connection -> TVar [Text] -> Text -> MsgEncodingI e => ChatMessage e -> CM () - processEvent ct' conn' tags eInfo chatMsg@ChatMessage {chatMsgEvent} = do - let tag = toCMEventTag chatMsgEvent - atomically $ modifyTVar' tags (tshow tag :) - logInfo $ "contact msg=" <> tshow tag <> " " <> eInfo - (conn'', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn' msgMeta msgBody chatMsg - let ct'' = ct' {activeConn = Just conn''} :: Contact - case event of - XMsgNew mc -> newContentMessage ct'' mc msg msgMeta - XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr - XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct'' sharedMsgId mContent msg msgMeta ttl live - XMsgDel sharedMsgId _ -> messageDelete ct'' sharedMsgId msg msgMeta - XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct'' sharedMsgId reaction add msg msgMeta - -- TODO discontinue XFile - XFile fInv -> processFileInvitation' ct'' fInv msg msgMeta - XFileCancel sharedMsgId -> xFileCancel ct'' sharedMsgId - XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct'' sharedMsgId fileConnReq_ fName - XInfo p -> xInfo ct'' p - XDirectDel -> xDirectDel ct'' msg msgMeta - XGrpInv gInv -> processGroupInvitation ct'' gInv msg msgMeta - XInfoProbe probe -> xInfoProbe (COMContact ct'') probe - XInfoProbeCheck probeHash -> xInfoProbeCheck (COMContact ct'') probeHash - XInfoProbeOk probe -> xInfoProbeOk (COMContact ct'') probe - XCallInv callId invitation -> xCallInv ct'' callId invitation msg msgMeta - XCallOffer callId offer -> xCallOffer ct'' callId offer msg - XCallAnswer callId answer -> xCallAnswer ct'' callId answer msg - XCallExtra callId extraInfo -> xCallExtra ct'' callId extraInfo msg - XCallEnd callId -> xCallEnd ct'' callId msg - BFileChunk sharedMsgId chunk -> bFileChunk ct'' sharedMsgId chunk msgMeta - _ -> messageError $ "unsupported message: " <> T.pack (show event) - checkSendRcpt :: Contact -> [AChatMessage] -> CM Bool - checkSendRcpt ct' aMsgs = do - let Contact {chatSettings = ChatSettings {sendRcpts}} = ct' - pure $ fromMaybe (sendRcptsContacts user) sendRcpts && any aChatMsgHasReceipt aMsgs - where - aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) = - hasDeliveryReceipt (toCMEventTag chatMsgEvent) - RCVD msgMeta msgRcpt -> - withAckMessage' "contact rcvd" agentConnId msgMeta $ - directMsgReceived ct conn msgMeta msgRcpt - CONF confId pqSupport _ connInfo -> do - conn' <- processCONFpqSupport conn pqSupport - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn' connInfo - conn'' <- updatePeerChatVRange conn' chatVRange - case chatMsgEvent of - -- confirming direct connection with a member - XGrpMemInfo _memId _memProfile -> do - -- TODO check member ID - -- TODO update member profile - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn'' confId XOk - XInfo profile -> do - ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct) - -- [incognito] send incognito profile - incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId - let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False - allowAgentConnectionAsync user conn'' confId $ XInfo p - void $ withStore' $ \db -> resetMemberContactFields db ct' - XGrpLinkInv glInv -> do - -- XGrpLinkInv here means we are connecting via business contact card, so we replace contact with group - (gInfo, host) <- withStore $ \db -> do - liftIO $ deleteContactCardKeepConn db connId ct - createGroupInvitedViaLink db vr user conn'' glInv - -- [incognito] send saved profile - incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) - let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing True - allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend - toView $ CRBusinessLinkConnecting user gInfo host ct - _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" - INFO pqSupport connInfo -> do - processINFOpqSupport conn pqSupport - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - _conn' <- updatePeerChatVRange conn chatVRange - case chatMsgEvent of - XGrpMemInfo _memId _memProfile -> do - -- TODO check member ID - -- TODO update member profile - pure () - XInfo profile -> - void $ processContactProfileUpdate ct profile False - XOk -> pure () - _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" - CON pqEnc -> - withStore' (\db -> getViaGroupMember db vr user ct) >>= \case - Nothing -> do - when (pqEnc == PQEncOn) $ withStore' $ \db -> updateConnPQEnabledCON db connId pqEnc - let conn' = conn {pqSndEnabled = Just pqEnc, pqRcvEnabled = Just pqEnc} :: Connection - ct' = ct {activeConn = Just conn'} :: Contact - -- [incognito] print incognito profile used for this contact - incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - lift $ setContactNetworkStatus ct' NSConnected - toView $ CRContactConnected user ct' (fmap fromLocalProfile incognitoProfile) - when (directOrUsed ct') $ do - unless (contactUsed ct') $ withFastStore' $ \db -> updateContactUsed db user ct' - createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EInfo pqEnc) Nothing - createFeatureEnabledItems ct' - when (contactConnInitiated conn') $ do - let Connection {groupLinkId} = conn' - doProbeContacts = isJust groupLinkId - probeMatchingContactsAndMembers ct' (contactConnIncognito ct') doProbeContacts - withStore' $ \db -> resetContactConnInitiated db user conn' - forM_ viaUserContactLink $ \userContactLinkId -> do - ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId - let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl - when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept - forM_ groupId_ $ \groupId -> do - groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId - subMode <- chatReadVar subscriptionMode - groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode - gVar <- asks random - withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode - Just (gInfo, m@GroupMember {activeConn}) -> - when (maybe False ((== ConnReady) . connStatus) activeConn) $ do - notifyMemberConnected gInfo m $ Just ct - let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo - when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True - SENT msgId proxy -> do - void $ continueSending connEntity conn - sentMsgDeliveryEvent conn msgId - checkSndInlineFTComplete conn msgId - cis <- withStore $ \db -> do - cis <- updateDirectItemsStatus' db ct conn msgId (CISSndSent SSPComplete) - liftIO $ forM cis $ \ci -> setDirectSndChatItemViaProxy db user ct ci (isJust proxy) - let acis = map ctItem cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis - where - ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) - SWITCH qd phase cStats -> do - toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats) - when (phase == SPStarted || phase == SPCompleted) $ case qd of - QDRcv -> createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCESwitchQueue phase Nothing) Nothing - QDSnd -> createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing - RSYNC rss cryptoErr_ cStats -> - case (rss, connectionCode, cryptoErr_) of - (RSRequired, _, Just cryptoErr) -> processErr cryptoErr - (RSAllowed, _, Just cryptoErr) -> processErr cryptoErr - (RSAgreed, Just _, _) -> do - withStore' $ \db -> setConnectionVerified db user connId Nothing - let ct' = ct {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} :: Contact - ratchetSyncEventItem ct' - securityCodeChanged ct' - _ -> ratchetSyncEventItem ct - where - processErr cryptoErr = do - let e@(mde, n) = agentMsgDecryptError cryptoErr - ci_ <- withStore $ \db -> - getDirectChatItemLast db user contactId - >>= liftIO - . mapM (\(ci, content') -> updateDirectChatItem' db user contactId ci content' False False Nothing Nothing) - . mdeUpdatedCI e - case ci_ of - Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) - _ -> do - toView $ CRContactRatchetSync user ct (RatchetSyncProgress rss cStats) - createInternalChatItem user (CDDirectRcv ct) (CIRcvDecryptionError mde n) Nothing - ratchetSyncEventItem ct' = do - toView $ CRContactRatchetSync user ct' (RatchetSyncProgress rss cStats) - createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent $ RCERatchetSync rss) Nothing - OK -> - -- [async agent commands] continuation on receiving OK - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - JOINED sqSecured -> - -- [async agent commands] continuation on receiving JOINED - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> - when (directOrUsed ct && sqSecured) $ do - lift $ setContactNetworkStatus ct NSConnected - toView $ CRContactSndReady user ct - forM_ viaUserContactLink $ \userContactLinkId -> do - ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId - let (UserContactLink {autoAccept}, _, _) = ucl - when (connChatVersion >= batchSend2Version) $ sendAutoReply ct autoAccept - QCONT -> - void $ continueSending connEntity conn - MWARN msgId err -> do - updateDirectItemStatus ct conn msgId (CISSndWarning $ agentSndError err) - processConnMWARN connEntity conn err - MERR msgId err -> do - updateDirectItemStatus ct conn msgId (CISSndError $ agentSndError err) - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - processConnMERR connEntity conn err - MERRS msgIds err -> do - -- error cannot be AUTH error here - updateDirectItemsStatusMsgs ct conn (L.toList msgIds) (CISSndError $ agentSndError err) - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - -- TODO add debugging output - _ -> pure () - where - sendAutoReply ct = \case - Just AutoAccept {autoReply = Just mc} -> do - (msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) - ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] - _ -> pure () - - processGroupMessage :: AEvent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM () - processGroupMessage agentMsg connEntity conn@Connection {connId, connChatVersion, connectionCode} gInfo@GroupInfo {groupId, groupProfile, membership, chatSettings} m = case agentMsg of - INV (ACR _ cReq) -> - withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> - case cReq of - groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of - -- [async agent commands] XGrpMemIntro continuation on receiving INV - CFCreateConnGrpMemInv - | maxVersion (peerChatVRange conn) >= groupDirectInvVersion -> sendWithoutDirectCReq - | otherwise -> sendWithDirectCReq - where - sendWithoutDirectCReq = do - let GroupMember {groupMemberId, memberId} = m - hostConnId <- withStore $ \db -> do - liftIO $ setConnConnReqInv db user connId cReq - getHostConnId db user groupId - sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} - sendWithDirectCReq = do - let GroupMember {groupMemberId, memberId} = m - contData <- withStore' $ \db -> do - setConnConnReqInv db user connId cReq - getXGrpMemIntroContGroup db user m - forM_ contData $ \(hostConnId, directConnReq) -> - sendXGrpMemInv hostConnId (Just directConnReq) XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} - -- [async agent commands] group link auto-accept continuation on receiving INV - CFCreateConnGrpInv -> do - ct <- withStore $ \db -> getContactViaMember db vr user m - withStore' $ \db -> setNewContactMemberConnRequest db user m cReq - groupLinkId <- withStore' $ \db -> getGroupLinkId db user gInfo - sendGrpInvitation ct m groupLinkId - toView $ CRSentGroupInvitation user gInfo ct m - where - sendGrpInvitation :: Contact -> GroupMember -> Maybe GroupLinkId -> CM () - sendGrpInvitation ct GroupMember {memberId, memberRole = memRole} groupLinkId = do - currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo - let GroupMember {memberRole = userRole, memberId = userMemberId} = membership - groupInv = - GroupInvitation - { fromMember = MemberIdRole userMemberId userRole, - invitedMember = MemberIdRole memberId memRole, - connRequest = cReq, - groupProfile, - business = Nothing, - groupLinkId = groupLinkId, - groupSize = Just currentMemCount - } - (_msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv - -- we could link chat item with sent group invitation message (_msg) - createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing - _ -> throwChatError $ CECommandError "unexpected cmdFunction" - CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" - CONF confId _pqSupport _ connInfo -> do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - conn' <- updatePeerChatVRange conn chatVRange - case memberCategory m of - GCInviteeMember -> - case chatMsgEvent of - XGrpAcpt memId - | sameMemberId memId m -> do - withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId XOk - | otherwise -> messageError "x.grp.acpt: memberId is different from expected" - _ -> messageError "CONF from invited member must have x.grp.acpt" - _ -> - case chatMsgEvent of - XGrpMemInfo memId _memProfile - | sameMemberId memId m -> do - let GroupMember {memberId = membershipMemId} = membership - membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership - -- TODO update member profile - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile - | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" - _ -> messageError "CONF from member must have x.grp.mem.info" - INFO _pqSupport connInfo -> do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - _conn' <- updatePeerChatVRange conn chatVRange - case chatMsgEvent of - XGrpMemInfo memId _memProfile - | sameMemberId memId m -> do - -- TODO update member profile - pure () - | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" - XInfo _ -> pure () -- sent when connecting via group link - XOk -> pure () - _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok" - pure () - CON _pqEnc -> do - withStore' $ \db -> do - updateGroupMemberStatus db userId m GSMemConnected - unless (memberActive membership) $ - updateGroupMemberStatus db userId membership GSMemConnected - -- possible improvement: check for each pending message, requires keeping track of connection state - unless (connDisabled conn) $ sendPendingGroupMessages user m conn - withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings - case memberCategory m of - GCHostMember -> do - toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} - let cd = CDGroupRcv gInfo m - createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing - createGroupFeatureItems user cd CIRcvGroupFeature gInfo - let GroupInfo {groupProfile = GroupProfile {description}} = gInfo - memberConnectedChatItem gInfo m - unless expectHistory $ forM_ description $ groupDescriptionChatItem gInfo m - where - expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion - GCInviteeMember -> do - memberConnectedChatItem gInfo m - toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} - let Connection {viaUserContactLink} = conn - when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem - members <- withStore' $ \db -> getGroupMembers db vr user gInfo - void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m - sendIntroductions members - when (groupFeatureAllowed SGFHistory gInfo) sendHistory - when (connChatVersion < batchSend2Version) sendGroupAutoReply - where - sendXGrpLinkMem = do - let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - profileToSend = profileToSendOnAccept user profileMode True - void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId - sendIntroductions members = do - intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m - shuffledIntros <- liftIO $ shuffleIntros intros - if m `supportsVersion` batchSendVersion - then do - let events = map (memberIntro . reMember) shuffledIntros - forM_ (L.nonEmpty events) $ \events' -> - sendGroupMemberMessages user conn events' groupId - else forM_ shuffledIntros $ \intro -> - processIntro intro `catchChatError` (toView . CRChatError (Just user)) - memberIntro :: GroupMember -> ChatMsgEvent 'Json - memberIntro reMember = - let mInfo = memberInfo reMember - mRestrictions = memberRestrictions reMember - in XGrpMemIntro mInfo mRestrictions - shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro] - shuffleIntros intros = do - let (admins, others) = partition isAdmin intros - (admPics, admNoPics) = partition hasPicture admins - (othPics, othNoPics) = partition hasPicture others - mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics] - where - isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin - hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image - processIntro intro@GroupMemberIntro {introId} = do - void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId - withStore' $ \db -> updateIntroStatus db introId GMIntroSent - sendHistory = - when (m `supportsVersion` batchSendVersion) $ do - (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100) - (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items - let errors = map ChatErrorStore errs <> errs' - unless (null errors) $ toView $ CRChatErrors (Just user) errors - let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_ - forM_ (L.nonEmpty events') $ \events'' -> - sendGroupMemberMessages user conn events'' groupId - descrEvent_ :: Maybe (ChatMsgEvent 'Json) - descrEvent_ - | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do - let GroupInfo {groupProfile = GroupProfile {description}} = gInfo - fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description - | otherwise = Nothing - itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json] - itemForwardEvents cci = case cci of - (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file}) - | not (blockedByAdmin sender) -> do - fInvDescr_ <- join <$> forM file getRcvFileInvDescr - processContentItem sender ci mc fInvDescr_ - (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do - fInvDescr_ <- join <$> forM file getSndFileInvDescr - processContentItem membership ci mc fInvDescr_ - _ -> pure [] - where - getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText)) - getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do - expired <- fileExpired - if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired - then pure Nothing - else do - rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId - pure $ invCompleteDescr ciFile rfd - getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText)) - getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do - expired <- fileExpired - if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired - then pure Nothing - else do - -- can also lookup in extra_xftp_file_descriptions, though it can be empty; - -- would be best if snd file had a single rcv description for all members saved in files table - rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId - pure $ invCompleteDescr ciFile rfd - fileExpired :: CM Bool - fileExpired = do - ttl <- asks $ rcvFilesTTL . agentConfig . config - cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime - pure $ chatItemTs cci < cutoffTs - invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText) - invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete} - | fileDescrComplete = - let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} - fInv = xftpFileInvitation fileName fileSize fInvDescr - in Just (fInv, fileDescrText) - | otherwise = Nothing - processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json] - processContentItem sender ChatItem {meta, quotedItem} mc fInvDescr_ = - if isNothing fInvDescr_ && not (msgContentHasText mc) - then pure [] - else do - let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta - quotedItemId_ = quoteItemId =<< quotedItem - fInv_ = fst <$> fInvDescr_ - (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ Nothing fInv_ itemTimed False - let senderVRange = memberChatVRange' sender - xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer} - fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of - (Just fileDescrText, Just msgId) -> do - partSize <- asks $ xftpDescrPartSize . config - let parts = splitFileDescr partSize fileDescrText - pure . L.toList $ L.map (XMsgFileDescr msgId) parts - _ -> pure [] - let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents - GroupMember {memberId} = sender - msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs) - pure msgForwardEvents - _ -> do - let memCategory = memberCategory m - withStore' (\db -> getViaGroupContact db vr user m) >>= \case - Nothing -> do - notifyMemberConnected gInfo m Nothing - let connectedIncognito = memberIncognito membership - when (memCategory == GCPreMember) $ probeMatchingMemberContact m connectedIncognito - Just ct@Contact {activeConn} -> - forM_ activeConn $ \Connection {connStatus} -> - when (connStatus == ConnReady) $ do - notifyMemberConnected gInfo m $ Just ct - let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo - when (memCategory == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True - sendXGrpMemCon memCategory - where - GroupMember {memberId} = m - sendXGrpMemCon = \case - GCPreMember -> - forM_ (invitedByGroupMemberId membership) $ \hostId -> do - host <- withStore $ \db -> getGroupMember db vr user groupId hostId - forM_ (memberConn host) $ \hostConn -> - void $ sendDirectMemberMessage hostConn (XGrpMemCon memberId) groupId - GCPostMember -> - forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do - im <- withStore $ \db -> getGroupMember db vr user groupId invitingMemberId - forM_ (memberConn im) $ \imConn -> - void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId - _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected" - MSG msgMeta _msgFlags msgBody -> do - tags <- newTVarIO [] - withAckMessage "group msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do - checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure () - forM_ aChatMsgs $ \case - Right (ACMsg _ chatMsg) -> - processEvent tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e - Left e -> do - atomically $ modifyTVar' tags ("error" :) - logInfo $ "group msg=error " <> eInfo <> " " <> tshow e - toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) - forwardMsgs (rights aChatMsgs) `catchChatError` (toView . CRChatError (Just user)) - checkSendRcpt $ rights aChatMsgs - where - aChatMsgs = parseChatMessages msgBody - brokerTs = metaBrokerTs msgMeta - processEvent :: TVar [Text] -> Text -> MsgEncodingI e => ChatMessage e -> CM () - processEvent tags eInfo chatMsg@ChatMessage {chatMsgEvent} = do - let tag = toCMEventTag chatMsgEvent - atomically $ modifyTVar' tags (tshow tag :) - logInfo $ "group msg=" <> tshow tag <> " " <> eInfo - (m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta msgBody chatMsg - case event of - XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False - XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr - XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg brokerTs ttl live - XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg brokerTs - XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg brokerTs - -- TODO discontinue XFile - XFile fInv -> processGroupFileInvitation' gInfo m' fInv msg brokerTs - XFileCancel sharedMsgId -> xFileCancelGroup gInfo m' sharedMsgId - XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName - XInfo p -> xInfoMember gInfo m' p brokerTs - XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p - XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg brokerTs - XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo m' memInfo memRestrictions_ - XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv - XGrpMemFwd memInfo introInv -> xGrpMemFwd gInfo m' memInfo introInv - XGrpMemRole memId memRole -> xGrpMemRole gInfo m' memId memRole msg brokerTs - XGrpMemRestrict memId memRestrictions -> xGrpMemRestrict gInfo m' memId memRestrictions msg brokerTs - XGrpMemCon memId -> xGrpMemCon gInfo m' memId - XGrpMemDel memId -> xGrpMemDel gInfo m' memId msg brokerTs - XGrpLeave -> xGrpLeave gInfo m' msg brokerTs - XGrpDel -> xGrpDel gInfo m' msg brokerTs - XGrpInfo p' -> xGrpInfo gInfo m' p' msg brokerTs - XGrpPrefs ps' -> xGrpPrefs gInfo m' ps' - XGrpDirectInv connReq mContent_ -> memberCanSend m' $ xGrpDirectInv gInfo m' conn' connReq mContent_ msg brokerTs - XGrpMsgForward memberId msg' msgTs -> xGrpMsgForward gInfo m' memberId msg' msgTs - XInfoProbe probe -> xInfoProbe (COMGroupMember m') probe - XInfoProbeCheck probeHash -> xInfoProbeCheck (COMGroupMember m') probeHash - XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe - BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta - _ -> messageError $ "unsupported message: " <> tshow event - checkSendRcpt :: [AChatMessage] -> CM Bool - checkSendRcpt aMsgs = do - currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo - let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo - pure $ - fromMaybe (sendRcptsSmallGroups user) sendRcpts - && any aChatMsgHasReceipt aMsgs - && currentMemCount <= smallGroupsRcptsMemLimit - where - aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) = - hasDeliveryReceipt (toCMEventTag chatMsgEvent) - forwardMsgs :: [AChatMessage] -> CM () - forwardMsgs aMsgs = do - let GroupMember {memberRole = membershipMemRole} = membership - when (membershipMemRole >= GRAdmin && not (blockedByAdmin m)) $ do - let forwardedMsgs = mapMaybe (\(ACMsg _ chatMsg) -> forwardedGroupMsg chatMsg) aMsgs - forM_ (L.nonEmpty forwardedMsgs) $ \forwardedMsgs' -> do - ChatConfig {highlyAvailable} <- asks config - -- members introduced to this invited member - introducedMembers <- - if memberCategory m == GCInviteeMember - then withStore' $ \db -> getForwardIntroducedMembers db vr user m highlyAvailable - else pure [] - -- invited members to which this member was introduced - invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db vr user m highlyAvailable - let GroupMember {memberId} = m - ms = forwardedToGroupMembers (introducedMembers <> invitedMembers) forwardedMsgs' - events = L.map (\cm -> XGrpMsgForward memberId cm brokerTs) forwardedMsgs' - unless (null ms) $ void $ sendGroupMessages user gInfo ms events - RCVD msgMeta msgRcpt -> - withAckMessage' "group rcvd" agentConnId msgMeta $ - groupMsgReceived gInfo m conn msgMeta msgRcpt - SENT msgId proxy -> do - continued <- continueSending connEntity conn - sentMsgDeliveryEvent conn msgId - checkSndInlineFTComplete conn msgId - updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy) - when continued $ sendPendingGroupMessages user m conn - SWITCH qd phase cStats -> do - toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) - when (phase == SPStarted || phase == SPCompleted) $ case qd of - QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing - QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing - RSYNC rss cryptoErr_ cStats -> - case (rss, connectionCode, cryptoErr_) of - (RSRequired, _, Just cryptoErr) -> processErr cryptoErr - (RSAllowed, _, Just cryptoErr) -> processErr cryptoErr - (RSAgreed, Just _, _) -> do - withStore' $ \db -> setConnectionVerified db user connId Nothing - let m' = m {activeConn = Just (conn {connectionCode = Nothing} :: Connection)} :: GroupMember - ratchetSyncEventItem m' - toView $ CRGroupMemberVerificationReset user gInfo m' - createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent RCEVerificationCodeReset) Nothing - _ -> ratchetSyncEventItem m - where - processErr cryptoErr = do - let e@(mde, n) = agentMsgDecryptError cryptoErr - ci_ <- withStore $ \db -> - getGroupMemberChatItemLast db user groupId (groupMemberId' m) - >>= liftIO - . mapM (\(ci, content') -> updateGroupChatItem db user groupId ci content' False False Nothing) - . mdeUpdatedCI e - case ci_ of - Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) - _ -> do - toView $ CRGroupMemberRatchetSync user gInfo m (RatchetSyncProgress rss cStats) - createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvDecryptionError mde n) Nothing - ratchetSyncEventItem m' = do - toView $ CRGroupMemberRatchetSync user gInfo m' (RatchetSyncProgress rss cStats) - createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent $ RCERatchetSync rss) Nothing - OK -> - -- [async agent commands] continuation on receiving OK - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - JOINED sqSecured -> - -- [async agent commands] continuation on receiving JOINED - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> - when (sqSecured && connChatVersion >= batchSend2Version) sendGroupAutoReply - QCONT -> do - continued <- continueSending connEntity conn - when continued $ sendPendingGroupMessages user m conn - MWARN msgId err -> do - withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSWarning $ agentSndError err) - processConnMWARN connEntity conn err - MERR msgId err -> do - withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSError $ agentSndError err) - -- group errors are silenced to reduce load on UI event log - -- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - processConnMERR connEntity conn err - MERRS msgIds err -> do - let newStatus = GSSError $ agentSndError err - -- error cannot be AUTH error here - withStore' $ \db -> forM_ msgIds $ \msgId -> - updateGroupItemsErrorStatus db msgId (groupMemberId' m) newStatus `catchAll_` pure () - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - -- TODO add debugging output - _ -> pure () - where - updateGroupItemsErrorStatus :: DB.Connection -> AgentMsgId -> GroupMemberId -> GroupSndStatus -> IO () - updateGroupItemsErrorStatus db msgId groupMemberId newStatus = do - itemIds <- getChatItemIdsByAgentMsgId db connId msgId - forM_ itemIds $ \itemId -> updateGroupMemSndStatus' db itemId groupMemberId newStatus - sendGroupAutoReply = autoReplyMC >>= mapM_ send - where - autoReplyMC = do - let GroupInfo {businessChat} = gInfo - GroupMember {memberId = joiningMemberId} = m - case businessChat of - Just BusinessChatInfo {customerId, chatType = BCCustomer} - | joiningMemberId == customerId -> useReply <$> withStore (`getUserAddress` user) - where - useReply UserContactLink {autoAccept} = case autoAccept of - Just AutoAccept {businessAddress, autoReply} | businessAddress -> autoReply - _ -> Nothing - _ -> pure Nothing - send mc = do - msg <- sendGroupMessage' user gInfo [m] (XMsgNew $ MCSimple (extMsgContent mc Nothing)) - ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc) - withStore' $ \db -> createGroupSndStatus db (chatItemId' ci) (groupMemberId' m) GSSNew - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] - - agentMsgDecryptError :: AgentCryptoError -> (MsgDecryptError, Word32) - agentMsgDecryptError = \case - DECRYPT_AES -> (MDEOther, 1) - DECRYPT_CB -> (MDEOther, 1) - RATCHET_HEADER -> (MDERatchetHeader, 1) - RATCHET_EARLIER _ -> (MDERatchetEarlier, 1) - RATCHET_SKIPPED n -> (MDETooManySkipped, n) - RATCHET_SYNC -> (MDERatchetSync, 0) - - mdeUpdatedCI :: (MsgDecryptError, Word32) -> CChatItem c -> Maybe (ChatItem c 'MDRcv, CIContent 'MDRcv) - mdeUpdatedCI (mde', n') (CChatItem _ ci@ChatItem {content = CIRcvDecryptionError mde n}) - | mde == mde' = case mde of - MDERatchetHeader -> r (n + n') - MDETooManySkipped -> r n' -- the numbers are not added as sequential MDETooManySkipped will have it incremented by 1 - MDERatchetEarlier -> r (n + n') - MDEOther -> r (n + n') - MDERatchetSync -> r 0 - | otherwise = Nothing - where - r n'' = Just (ci, CIRcvDecryptionError mde n'') - mdeUpdatedCI _ _ = Nothing - - processSndFileConn :: AEvent e -> ConnectionEntity -> Connection -> SndFileTransfer -> CM () - processSndFileConn agentMsg connEntity conn ft@SndFileTransfer {fileId, fileName, fileStatus} = - case agentMsg of - -- SMP CONF for SndFileConnection happens for direct file protocol - -- when recipient of the file "joins" connection created by the sender - CONF confId _pqSupport _ connInfo -> do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - conn' <- updatePeerChatVRange conn chatVRange - case chatMsgEvent of - -- TODO save XFileAcpt message - XFileAcpt name - | name == fileName -> do - withStore' $ \db -> updateSndFileStatus db ft FSAccepted - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId XOk - | otherwise -> messageError "x.file.acpt: fileName is different from expected" - _ -> messageError "CONF from file connection must have x.file.acpt" - CON _ -> do - ci <- withStore $ \db -> do - liftIO $ updateSndFileStatus db ft FSConnected - updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 - toView $ CRSndFileStart user ci ft - sendFileChunk user ft - SENT msgId _proxy -> do - withStore' $ \db -> updateSndFileChunkSent db ft msgId - unless (fileStatus == FSCancelled) $ sendFileChunk user ft - MERR _ err -> do - cancelSndFileTransfer user ft True >>= mapM_ (deleteAgentConnectionAsync user) - case err of - SMP _ SMP.AUTH -> unless (fileStatus == FSCancelled) $ do - ci <- withStore $ \db -> do - liftIO (lookupChatRefByFileId db user fileId) >>= \case - Just (ChatRef CTDirect _) -> liftIO $ updateFileCancelled db user fileId CIFSSndCancelled - _ -> pure () - lookupChatItemByFileId db vr user fileId - toView $ CRSndFileRcvCancelled user ci ft - _ -> throwChatError $ CEFileSend fileId err - MSG meta _ _ -> - withAckMessage' "file msg" agentConnId meta $ pure () - OK -> - -- [async agent commands] continuation on receiving OK - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - JOINED _ -> - -- [async agent commands] continuation on receiving JOINED - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - -- TODO add debugging output - _ -> pure () - - processRcvFileConn :: AEvent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> CM () - processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} = - case agentMsg of - INV (ACR _ cReq) -> - withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> - case cReq of - fileInvConnReq@(CRInvitationUri _ _) -> case cmdFunction of - -- [async agent commands] direct XFileAcptInv continuation on receiving INV - CFCreateConnFileInvDirect -> do - ct <- withStore $ \db -> getContactByFileId db vr user fileId - sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId - void $ sendDirectContactMessage user ct (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) - -- [async agent commands] group XFileAcptInv continuation on receiving INV - CFCreateConnFileInvGroup -> case grpMemberId of - Just gMemberId -> do - GroupMember {groupId, activeConn} <- withStore $ \db -> getGroupMemberById db vr user gMemberId - case activeConn of - Just gMemberConn -> do - sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId - void $ sendDirectMemberMessage gMemberConn (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) groupId - _ -> throwChatError $ CECommandError "no GroupMember activeConn" - _ -> throwChatError $ CECommandError "no grpMemberId" - _ -> throwChatError $ CECommandError "unexpected cmdFunction" - CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" - -- SMP CONF for RcvFileConnection happens for group file protocol - -- when sender of the file "joins" connection created by the recipient - -- (sender doesn't create connections for all group members) - CONF confId _pqSupport _ connInfo -> do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - conn' <- updatePeerChatVRange conn chatVRange - case chatMsgEvent of - XOk -> allowAgentConnectionAsync user conn' confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability - _ -> pure () - CON _ -> startReceivingFile user fileId - MSG meta _ msgBody -> do - -- XXX: not all branches do ACK - parseFileChunk msgBody >>= receiveFileChunk ft (Just conn) meta - OK -> - -- [async agent commands] continuation on receiving OK - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - JOINED _ -> - -- [async agent commands] continuation on receiving JOINED - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - MERR _ err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - processConnMERR connEntity conn err - ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - -- TODO add debugging output - _ -> pure () - - receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> CM () - receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case - FileChunkCancel -> - unless (rcvFileCompleteOrCancelled ft) $ do - cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db vr user fileId - toView $ CRRcvFileSndCancelled user ci ft - FileChunk {chunkNo, chunkBytes = chunk} -> do - case integrity of - MsgOk -> pure () - MsgError MsgDuplicate -> pure () -- TODO remove once agent removes duplicates - MsgError e -> - badRcvFileChunk ft $ "invalid file chunk number " <> show chunkNo <> ": " <> show e - withStore' (\db -> createRcvFileChunk db ft chunkNo msgId) >>= \case - RcvChunkOk -> - if B.length chunk /= fromInteger chunkSize - then badRcvFileChunk ft "incorrect chunk size" - else withAckMessage' "file msg" agentConnId meta $ appendFileChunk ft chunkNo chunk False - RcvChunkFinal -> - if B.length chunk > fromInteger chunkSize - then badRcvFileChunk ft "incorrect chunk size" - else do - appendFileChunk ft chunkNo chunk True - ci <- withStore $ \db -> do - liftIO $ do - updateRcvFileStatus db fileId FSComplete - updateCIFileStatus db user fileId CIFSRcvComplete - deleteRcvFileChunks db ft - getChatItemByFileId db vr user fileId - toView $ CRRcvFileComplete user ci - forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn) - RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure () - RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo - - processUserContactRequest :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM () - processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of - REQ invId pqSupport _ connInfo -> do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - case chatMsgEvent of - XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ pqSupport - XInfo p -> profileContactRequest invId chatVRange p Nothing pqSupport - -- TODO show/log error, other events in contact request - _ -> pure () - MERR _ err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - processConnMERR connEntity conn err - ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) - when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () - -- TODO add debugging output - _ -> pure () - where - profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> CM () - profileContactRequest invId chatVRange p xContactId_ reqPQSup = do - withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case - CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact - CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo - CORRequest cReq -> do - ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId - let (UserContactLink {connReqContact, autoAccept}, groupId_, gLinkMemRole) = ucl - isSimplexTeam = sameConnReqContact connReqContact adminContactReq - v = maxVersion chatVRange - case autoAccept of - Just AutoAccept {acceptIncognito, businessAddress} - | businessAddress -> - if v < groupFastLinkJoinVersion || (isSimplexTeam && v < businessChatsVersion) - then do - ct <- acceptContactRequestAsync user cReq Nothing True reqPQSup - toView $ CRAcceptingContactRequest user ct - else do - gInfo <- acceptBusinessJoinRequestAsync user cReq - toView $ CRAcceptingBusinessRequest user gInfo - | otherwise -> case groupId_ of - Nothing -> do - -- [incognito] generate profile to send, create connection with incognito profile - incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - ct <- acceptContactRequestAsync user cReq incognitoProfile True reqPQSup - toView $ CRAcceptingContactRequest user ct - Just groupId -> do - gInfo <- withStore $ \db -> getGroupInfo db vr user groupId - let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - if v >= groupFastLinkJoinVersion - then do - mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode - createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing - toView $ CRAcceptingGroupJoinRequestMember user gInfo mem - else do - -- TODO v5.7 remove old API (or v6.0?) - ct <- acceptContactRequestAsync user cReq profileMode False PQSupportOff - toView $ CRAcceptingGroupJoinRequest user gInfo ct - _ -> toView $ CRReceivedContactRequest user cReq - - memberCanSend :: GroupMember -> CM () -> CM () - memberCanSend GroupMember {memberRole} a - | memberRole <= GRObserver = messageError "member is not allowed to send messages" - | otherwise = a - - processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM () - processConnMERR connEntity conn err = do - case err of - SMP _ SMP.AUTH -> do - authErrCounter' <- withStore' $ \db -> incAuthErrCounter db user conn - when (authErrCounter' >= authErrDisableCount) $ case connEntity of - RcvDirectMsgConnection ctConn (Just ct) -> do - toView $ CRContactDisabled user ct {activeConn = Just ctConn {authErrCounter = authErrCounter'}} - _ -> toView $ CRConnectionDisabled connEntity - SMP _ SMP.QUOTA -> - unless (connInactive conn) $ do - withStore' $ \db -> setQuotaErrCounter db user conn quotaErrSetOnMERR - toView $ CRConnectionInactive connEntity True - _ -> pure () - - processConnMWARN :: ConnectionEntity -> Connection -> AgentErrorType -> CM () - processConnMWARN connEntity conn err = do - case err of - SMP _ SMP.QUOTA -> - unless (connInactive conn) $ do - quotaErrCounter' <- withStore' $ \db -> incQuotaErrCounter db user conn - when (quotaErrCounter' >= quotaErrInactiveCount) $ - toView $ - CRConnectionInactive connEntity True - _ -> pure () - - continueSending :: ConnectionEntity -> Connection -> CM Bool - continueSending connEntity conn = - if connInactive conn - then do - withStore' $ \db -> setQuotaErrCounter db user conn 0 - toView $ CRConnectionInactive connEntity False - pure True - else pure False - - -- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections? - -- we could save command records only for agent APIs we process continuations for (INV) - withCompletedCommand :: forall e. AEntityI e => Connection -> AEvent e -> (CommandData -> CM ()) -> CM () - withCompletedCommand Connection {connId} agentMsg action = do - let agentMsgTag = AEvtTag (sAEntity @e) $ aEventTag agentMsg - cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId - case cmdData_ of - Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction} - | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == AEvtTag SAEConn ERR_) -> do - withStore' $ \db -> deleteCommand db user cmdId - action cmdData - | otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId - Just CommandData {cmdId, cmdConnId = Nothing} -> err cmdId $ "no command connection id, corrId = " <> show corrId - Nothing -> throwChatError . CEAgentCommandError $ "command not found, corrId = " <> show corrId - where - err cmdId msg = do - withStore' $ \db -> updateCommandStatus db user cmdId CSError - throwChatError . CEAgentCommandError $ msg - - withAckMessage' :: Text -> ConnId -> MsgMeta -> CM () -> CM () - withAckMessage' label cId msgMeta action = do - withAckMessage label cId msgMeta False Nothing $ \_ -> action $> False - - withAckMessage :: Text -> ConnId -> MsgMeta -> Bool -> Maybe (TVar [Text]) -> (Text -> CM Bool) -> CM () - withAckMessage label cId msgMeta showCritical tags action = do - -- [async agent commands] command should be asynchronous - -- TODO catching error and sending ACK after an error, particularly if it is a database error, will result in the message not processed (and no notification to the user). - -- Possible solutions are: - -- 1) retry processing several times - -- 2) stabilize database - -- 3) show screen of death to the user asking to restart - eInfo <- eventInfo - logInfo $ label <> ": " <> eInfo - tryChatError (action eInfo) >>= \case - Right withRcpt -> - withLog (eInfo <> " ok") $ ackMsg msgMeta $ if withRcpt then Just "" else Nothing - -- If showCritical is True, then these errors don't result in ACK and show user visible alert - -- This prevents losing the message that failed to be processed. - Left (ChatErrorStore SEDBBusyError {message}) | showCritical -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing - Left e -> do - withLog (eInfo <> " error: " <> tshow e) $ ackMsg msgMeta Nothing - throwError e - where - eventInfo = do - v <- asks eventSeq - eId <- atomically $ stateTVar v $ \i -> (i + 1, i + 1) - pure $ "conn_id=" <> tshow cId <> " event_id=" <> tshow eId - withLog eInfo' ack = do - ts <- showTags - logInfo $ T.unwords [label, "ack:", ts, eInfo'] - ack - logInfo $ T.unwords [label, "ack=success:", ts, eInfo'] - showTags = do - ts <- maybe (pure []) readTVarIO tags - pure $ case ts of - [] -> "no_chat_messages" - [t] -> "chat_message=" <> t - _ -> "chat_message_batch=" <> T.intercalate "," (reverse ts) - ackMsg :: MsgMeta -> Maybe MsgReceiptInfo -> CM () - ackMsg MsgMeta {recipient = (msgId, _)} rcpt = withAgent $ \a -> ackMessageAsync a "" cId msgId rcpt - - sentMsgDeliveryEvent :: Connection -> AgentMsgId -> CM () - sentMsgDeliveryEvent Connection {connId} msgId = - withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent - - agentSndError :: AgentErrorType -> SndError - agentSndError = \case - SMP _ AUTH -> SndErrAuth - SMP _ QUOTA -> SndErrQuota - BROKER _ e -> brokerError SndErrRelay e - SMP proxySrv (SMP.PROXY (SMP.BROKER e)) -> brokerError (SndErrProxy proxySrv) e - AP.PROXY proxySrv _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> brokerError (SndErrProxyRelay proxySrv) e - e -> SndErrOther $ tshow e - where - brokerError srvErr = \case - NETWORK -> SndErrExpired - TIMEOUT -> SndErrExpired - HOST -> srvErr SrvErrHost - SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion - e -> srvErr . SrvErrOther $ tshow e - - badRcvFileChunk :: RcvFileTransfer -> String -> CM () - badRcvFileChunk ft err = - unless (rcvFileCompleteOrCancelled ft) $ do - cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - throwChatError $ CEFileRcvChunk err - - memberConnectedChatItem :: GroupInfo -> GroupMember -> CM () - memberConnectedChatItem gInfo m = - -- ts should be broker ts but we don't have it for CON - createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEMemberConnected) Nothing - - groupDescriptionChatItem :: GroupInfo -> GroupMember -> Text -> CM () - groupDescriptionChatItem gInfo m descr = - createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvMsgContent $ MCText descr) Nothing - - notifyMemberConnected :: GroupInfo -> GroupMember -> Maybe Contact -> CM () - notifyMemberConnected gInfo m ct_ = do - memberConnectedChatItem gInfo m - lift $ mapM_ (`setContactNetworkStatus` NSConnected) ct_ - toView $ CRConnectedToGroupMember user gInfo m ct_ - - probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> CM () - probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do - gVar <- asks random - contactMerge <- readTVarIO =<< asks contactMergeEnabled - if contactMerge && not connectedIncognito - then do - (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId (COMContact ct) - -- ! when making changes to probe-and-merge mechanism, - -- ! test scenario in which recipient receives probe after probe hashes (not covered in tests): - -- sendProbe -> sendProbeHashes (currently) - -- sendProbeHashes -> sendProbe (reversed - change order in code, may add delay) - sendProbe probe - cs <- - if doProbeContacts - then map COMContact <$> withStore' (\db -> getMatchingContacts db vr user ct) - else pure [] - ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db vr user ct) - sendProbeHashes (cs <> ms) probe probeId - else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) - where - sendProbe :: Probe -> CM () - sendProbe probe = void . sendDirectContactMessage user ct $ XInfoProbe probe - - probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> CM () - probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure () - probeMatchingMemberContact m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do - gVar <- asks random - contactMerge <- readTVarIO =<< asks contactMergeEnabled - if contactMerge && not connectedIncognito - then do - (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ COMGroupMember m - sendProbe probe - cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db vr user m) - sendProbeHashes cs probe probeId - else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) - where - sendProbe :: Probe -> CM () - sendProbe probe = void $ sendDirectMemberMessage conn (XInfoProbe probe) groupId - - sendProbeHashes :: [ContactOrMember] -> Probe -> Int64 -> CM () - sendProbeHashes cgms probe probeId = - forM_ cgms $ \cgm -> sendProbeHash cgm `catchChatError` \_ -> pure () - where - probeHash = ProbeHash $ C.sha256Hash (unProbe probe) - sendProbeHash :: ContactOrMember -> CM () - sendProbeHash cgm@(COMContact c) = do - void . sendDirectContactMessage user c $ XInfoProbeCheck probeHash - withStore' $ \db -> createSentProbeHash db userId probeId cgm - sendProbeHash (COMGroupMember GroupMember {activeConn = Nothing}) = pure () - sendProbeHash cgm@(COMGroupMember m@GroupMember {groupId, activeConn = Just conn}) = - when (memberCurrent m) $ do - void $ sendDirectMemberMessage conn (XInfoProbeCheck probeHash) groupId - withStore' $ \db -> createSentProbeHash db userId probeId cgm - - messageWarning :: Text -> CM () - messageWarning = toView . CRMessageError user "warning" - - messageError :: Text -> CM () - messageError = toView . CRMessageError user "error" - - newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM () - newContentMessage ct@Contact {contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do - unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct - let ExtMsgContent content fInv_ _ _ = mcExtMsgContent mc - -- Uncomment to test stuck delivery on errors - see test testDirectMessageDelete - -- case content of - -- MCText "hello 111" -> - -- UE.throwIO $ userError "#####################" - -- -- throwChatError $ CECommandError "#####################" - -- _ -> pure () - if isVoice content && not (featureAllowed SCFVoice forContact ct) - then do - void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False - else do - let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc - timed_ = rcvContactCITimed ct itemTTL - live = fromMaybe False live_ - file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct - newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live - autoAcceptFile file_ - where - brokerTs = metaBrokerTs msgMeta - newChatItem ciContent ciFile_ timed_ live = do - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live - reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}] - - autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> CM () - autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do - -- ! autoAcceptFileSize is only used in tests - ChatConfig {autoAcceptFileSize = sz} <- asks config - when (sz > fileSize) $ receiveFile' user ft False Nothing Nothing >>= toView - - messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> CM () - messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr = do - fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId - processFDMessage (CDDirectRcv ct) sharedMsgId fileId fileDescr - - groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> CM () - groupMessageFileDescription g@GroupInfo {groupId} m sharedMsgId fileDescr = do - fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId - processFDMessage (CDGroupRcv g m) sharedMsgId fileId fileDescr - - processFDMessage :: ChatTypeQuotable c => ChatDirection c 'MDRcv -> SharedMsgId -> FileTransferId -> FileDescr -> CM () - processFDMessage cd sharedMsgId fileId fileDescr = do - ft <- withStore $ \db -> getRcvFileTransfer db user fileId - unless (rcvFileCompleteOrCancelled ft) $ do - (rfd@RcvFileDescr {fileDescrComplete}, ft'@RcvFileTransfer {fileStatus, xftpRcvFile, cryptoArgs}) <- withStore $ \db -> do - rfd <- appendRcvFD db userId fileId fileDescr - -- reading second time in the same transaction as appending description - -- to prevent race condition with accept - ft' <- getRcvFileTransfer db user fileId - pure (rfd, ft') - when fileDescrComplete $ do - ci <- withStore $ \db -> getAChatItemBySharedMsgId db user cd sharedMsgId - toView $ CRRcvFileDescrReady user ci ft' rfd - case (fileStatus, xftpRcvFile) of - (RFSAccepted _, Just XFTPRcvFile {userApprovedRelays}) -> receiveViaCompleteFD user fileId rfd userApprovedRelays cryptoArgs - _ -> pure () - - processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> CM (Maybe (RcvFileTransfer, CIFile 'MDRcv)) - processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv' -> do - ChatConfig {fileChunkSize} <- asks config - let fInv@FileInvitation {fileName, fileSize} = mkValidFileInvitation fInv' - inline <- receiveInlineMode fInv (Just mc) fileChunkSize - ft@RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize - let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP - (filePath, fileStatus, ft') <- case inline of - Just IFMSent -> do - encrypt <- chatReadVar encryptLocalFiles - ft' <- (if encrypt then setFileToEncrypt else pure) ft - fPath <- getRcvFilePath fileId Nothing fileName True - withStore' $ \db -> startRcvInlineFT db user ft' fPath inline - pure (Just fPath, CIFSRcvAccepted, ft') - _ -> pure (Nothing, CIFSRcvInvitation, ft) - let RcvFileTransfer {cryptoArgs} = ft' - fileSource = (`CryptoFile` cryptoArgs) <$> filePath - pure (ft', CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}) - - mkValidFileInvitation :: FileInvitation -> FileInvitation - mkValidFileInvitation fInv@FileInvitation {fileName} = fInv {fileName = FP.makeValid $ FP.takeFileName fileName} - - messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> CM () - messageUpdate ct@Contact {contactId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do - updateRcvChatItem `catchCINotFound` \_ -> do - -- This patches initial sharedMsgId into chat item when locally deleted chat item - -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). - -- Chat item and update message which created it will have different sharedMsgId in this case... - let timed_ = rcvContactCITimed ct ttl - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs content Nothing timed_ live - ci' <- withStore' $ \db -> do - createChatItemVersion db (chatItemId' ci) brokerTs mc - updateDirectChatItem' db user contactId ci content True live Nothing Nothing - toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') - where - brokerTs = metaBrokerTs msgMeta - content = CIRcvMsgContent mc - live = fromMaybe False live_ - updateRcvChatItem = do - cci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId - case cci of - CChatItem SMDRcv ci@ChatItem {meta = CIMeta {itemForwarded, itemLive}, content = CIRcvMsgContent oldMC} - | isNothing itemForwarded -> do - let changed = mc /= oldMC - if changed || fromMaybe False itemLive - then do - ci' <- withStore' $ \db -> do - when changed $ - addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) - reactions <- getDirectCIReactions db ct sharedMsgId - let edited = itemLive /= Just True - updateDirectChatItem' db user contactId ci {reactions} content edited live Nothing $ Just msgId - toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') - startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' - else toView $ CRChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) - _ -> messageError "x.msg.update: contact attempted invalid message update" - - messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> CM () - messageDelete ct@Contact {contactId} sharedMsgId _rcvMessage msgMeta = do - deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct) - where - brokerTs = metaBrokerTs msgMeta - deleteRcvChatItem = do - cci@(CChatItem msgDir ci) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId - case msgDir of - SMDRcv - | rcvItemDeletable ci brokerTs -> - if featureAllowed SCFFullDelete forContact ct - then deleteDirectCIs user ct [cci] False False >>= toView - else markDirectCIsDeleted user ct [cci] False brokerTs >>= toView - | otherwise -> messageError "x.msg.del: contact attempted invalid message delete" - SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete" - - rcvItemDeletable :: ChatItem c d -> UTCTime -> Bool - rcvItemDeletable ChatItem {meta = CIMeta {itemTs, itemDeleted}} brokerTs = - -- 78 hours margin to account for possible sending delay - diffUTCTime brokerTs itemTs < (78 * 3600) && isNothing itemDeleted - - directMsgReaction :: Contact -> SharedMsgId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> CM () - directMsgReaction ct sharedMsgId reaction add RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do - when (featureAllowed SCFReactions forContact ct) $ do - rs <- withStore' $ \db -> getDirectReactions db ct sharedMsgId False - when (reactionAllowed add reaction rs) $ do - updateChatItemReaction `catchCINotFound` \_ -> - withStore' $ \db -> setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs - where - updateChatItemReaction = do - cr_ <- withStore $ \db -> do - CChatItem md ci <- getDirectChatItemBySharedMsgId db user (contactId' ct) sharedMsgId - if ciReactionAllowed ci - then liftIO $ do - setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs - reactions <- getDirectCIReactions db ct sharedMsgId - let ci' = CChatItem md ci {reactions} - r = ACIReaction SCTDirect SMDRcv (DirectChat ct) $ CIReaction CIDirectRcv ci' brokerTs reaction - pure $ Just $ CRChatItemReaction user add r - else pure Nothing - mapM_ toView cr_ - - groupMsgReaction :: GroupInfo -> GroupMember -> SharedMsgId -> MemberId -> MsgReaction -> Bool -> RcvMessage -> UTCTime -> CM () - groupMsgReaction g@GroupInfo {groupId} m sharedMsgId itemMemberId reaction add RcvMessage {msgId} brokerTs = do - when (groupFeatureAllowed SGFReactions g) $ do - rs <- withStore' $ \db -> getGroupReactions db g m itemMemberId sharedMsgId False - when (reactionAllowed add reaction rs) $ do - updateChatItemReaction `catchCINotFound` \_ -> - withStore' $ \db -> setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs - where - updateChatItemReaction = do - cr_ <- withStore $ \db -> do - CChatItem md ci <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId - if ciReactionAllowed ci - then liftIO $ do - setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs - reactions <- getGroupCIReactions db g itemMemberId sharedMsgId - let ci' = CChatItem md ci {reactions} - r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m) ci' brokerTs reaction - pure $ Just $ CRChatItemReaction user add r - else pure Nothing - mapM_ toView cr_ - - reactionAllowed :: Bool -> MsgReaction -> [MsgReaction] -> Bool - reactionAllowed add reaction rs = (reaction `elem` rs) /= add && not (add && length rs >= maxMsgReactions) - - catchCINotFound :: CM a -> (SharedMsgId -> CM a) -> CM a - catchCINotFound f handle = - f `catchChatError` \case - ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId - e -> throwError e - - newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> CM () - newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded - | blockedByAdmin m = createBlockedByAdmin - | otherwise = case prohibitedGroupContent gInfo m content fInv_ of - Just f -> rejected f - Nothing -> - withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case - Just ciModeration -> do - applyModeration ciModeration - withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_ - Nothing -> createContentItem - where - rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False - timed' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo itemTTL - live' = fromMaybe False live_ - ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc - createBlockedByAdmin - | groupFeatureAllowed SGFFullDelete gInfo = do - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvBlocked Nothing timed' False - ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs - groupMsgToView gInfo ci' - | otherwise = do - file_ <- processFileInv - ci <- createNonLive file_ - ci' <- withStore' $ \db -> markGroupCIBlockedByAdmin db user gInfo ci - groupMsgToView gInfo ci' - applyModeration CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, moderatedAt} - | moderatorRole < GRAdmin || moderatorRole < memberRole = - createContentItem - | groupFeatureAllowed SGFFullDelete gInfo = do - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed' False - ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt - groupMsgToView gInfo ci' - | otherwise = do - file_ <- processFileInv - ci <- createNonLive file_ - toView =<< markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] False (Just moderator) moderatedAt - createNonLive file_ = - saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed' False - createContentItem = do - file_ <- processFileInv - newChatItem (CIRcvMsgContent content) (snd <$> file_) timed' live' - when (showMessages $ memberSettings m) $ autoAcceptFile file_ - processFileInv = - processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m - newChatItem ciContent ciFile_ timed_ live = do - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live - ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci - reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ - groupMsgToView gInfo ci' {reactions} - - groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> UTCTime -> Maybe Int -> Maybe Bool -> CM () - groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} brokerTs ttl_ live_ - | prohibitedSimplexLinks gInfo m mc = - messageWarning $ "x.msg.update ignored: feature not allowed " <> groupFeatureNameText GFSimplexLinks - | otherwise = do - updateRcvChatItem `catchCINotFound` \_ -> do - -- This patches initial sharedMsgId into chat item when locally deleted chat item - -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). - -- Chat item and update message which created it will have different sharedMsgId in this case... - let timed_ = rcvGroupCITimed gInfo ttl_ - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs content Nothing timed_ live - ci' <- withStore' $ \db -> do - createChatItemVersion db (chatItemId' ci) brokerTs mc - ci' <- updateGroupChatItem db user groupId ci content True live Nothing - blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci' - toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') - where - content = CIRcvMsgContent mc - live = fromMaybe False live_ - updateRcvChatItem = do - cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId - case cci of - CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} -> - if sameMemberId memberId m' - then do - let changed = mc /= oldMC - if changed || fromMaybe False itemLive - then do - ci' <- withStore' $ \db -> do - when changed $ - addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) - reactions <- getGroupCIReactions db gInfo memberId sharedMsgId - let edited = itemLive /= Just True - updateGroupChatItem db user groupId ci {reactions} content edited live $ Just msgId - toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') - startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' - else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) - else messageError "x.msg.update: group member attempted to update a message of another member" - _ -> messageError "x.msg.update: group member attempted invalid message update" - - groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> UTCTime -> CM () - groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} brokerTs = do - let msgMemberId = fromMaybe memberId sndMemberId_ - withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case - Right cci@(CChatItem _ ci@ChatItem {chatDir}) -> case chatDir of - CIGroupRcv mem -> case sndMemberId_ of - -- regular deletion - Nothing - | sameMemberId memberId mem && msgMemberId == memberId && rcvItemDeletable ci brokerTs -> - delete cci Nothing >>= toView - | otherwise -> - messageError "x.msg.del: member attempted invalid message delete" - -- moderation (not limited by time) - Just _ - | sameMemberId memberId mem && msgMemberId == memberId -> - delete cci (Just m) >>= toView - | otherwise -> - moderate mem cci - CIGroupSnd -> moderate membership cci - Left e - | msgMemberId == memberId -> messageError $ "x.msg.del: message not found, " <> tshow e - | senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e - | otherwise -> withStore' $ \db -> createCIModeration db gInfo m msgMemberId sharedMsgId msgId brokerTs - where - moderate :: GroupMember -> CChatItem 'CTGroup -> CM () - moderate mem cci = case sndMemberId_ of - Just sndMemberId - | sameMemberId sndMemberId mem -> checkRole mem $ delete cci (Just m) >>= toView - | otherwise -> messageError "x.msg.del: message of another member with incorrect memberId" - _ -> messageError "x.msg.del: message of another member without memberId" - checkRole GroupMember {memberRole} a - | senderRole < GRAdmin || senderRole < memberRole = - messageError "x.msg.del: message of another member with insufficient member permissions" - | otherwise = a - delete :: CChatItem 'CTGroup -> Maybe GroupMember -> CM ChatResponse - delete cci byGroupMember - | groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs - | otherwise = markGroupCIsDeleted user gInfo [cci] False byGroupMember brokerTs - - -- TODO remove once XFile is discontinued - processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> CM () - processFileInvitation' ct fInv' msg@RcvMessage {sharedMsgId_} msgMeta = do - ChatConfig {fileChunkSize} <- asks config - let fInv@FileInvitation {fileName, fileSize} = mkValidFileInvitation fInv' - inline <- receiveInlineMode fInv Nothing fileChunkSize - RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize - let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP - ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] - where - brokerTs = metaBrokerTs msgMeta - - -- TODO remove once XFile is discontinued - processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> UTCTime -> CM () - processGroupFileInvitation' gInfo m fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} brokerTs = do - ChatConfig {fileChunkSize} <- asks config - inline <- receiveInlineMode fInv Nothing fileChunkSize - RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize - let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP - ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False - ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci - groupMsgToView gInfo ci' - - blockedMember :: Monad m' => GroupMember -> ChatItem c d -> m' (ChatItem c d) -> m' (ChatItem c d) - blockedMember m ci blockedCI - | showMessages (memberSettings m) = pure ci - | otherwise = blockedCI - - receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> CM (Maybe InlineFileMode) - receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of - (Just mode, Nothing) -> do - InlineFilesConfig {receiveChunks, receiveInstant} <- asks $ inlineFiles . config - pure $ if fileSize <= receiveChunks * chSize then inline' receiveInstant else Nothing - where - inline' receiveInstant = if mode == IFMOffer || (receiveInstant && maybe False isVoice mc_) then fileInline else Nothing - _ -> pure Nothing - - xFileCancel :: Contact -> SharedMsgId -> CM () - xFileCancel Contact {contactId} sharedMsgId = do - fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId - ft <- withStore (\db -> getRcvFileTransfer db user fileId) - unless (rcvFileCompleteOrCancelled ft) $ do - cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db vr user fileId - toView $ CRRcvFileSndCancelled user ci ft - - xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM () - xFileAcptInv ct sharedMsgId fileConnReq_ fName = do - fileId <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId - (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId - assertSMPAcceptNotProhibited ci - ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId) - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - if fName == fileName - then unless cancelled $ case fileConnReq_ of - -- receiving via a separate connection - Just fileConnReq -> do - subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo XOk - connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode - withStore' $ \db -> createSndDirectFTConnection db vr user fileId connIds subMode - -- receiving inline - _ -> do - event <- withStore $ \db -> do - ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 - sft <- createSndDirectInlineFT db ct ft - pure $ CRSndFileStart user ci' sft - toView event - ifM - (allowSendInline fileSize fileInline) - (sendDirectFileInline user ct ft sharedMsgId) - (messageError "x.file.acpt.inv: fileSize is bigger than allowed to send inline") - else messageError "x.file.acpt.inv: fileName is different from expected" - - assertSMPAcceptNotProhibited :: ChatItem c d -> CM () - assertSMPAcceptNotProhibited ChatItem {file = Just CIFile {fileId, fileProtocol}, content} - | fileProtocol == FPXFTP && not (imageOrVoice content) = throwChatError $ CEFallbackToSMPProhibited fileId - | otherwise = pure () - where - imageOrVoice :: CIContent d -> Bool - imageOrVoice (CISndMsgContent (MCImage _ _)) = True - imageOrVoice (CISndMsgContent (MCVoice _ _)) = True - imageOrVoice _ = False - assertSMPAcceptNotProhibited _ = pure () - - checkSndInlineFTComplete :: Connection -> AgentMsgId -> CM () - checkSndInlineFTComplete conn agentMsgId = do - sft_ <- withStore' $ \db -> getSndFTViaMsgDelivery db user conn agentMsgId - forM_ sft_ $ \sft@SndFileTransfer {fileId} -> do - ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> do - liftIO $ updateSndFileStatus db sft FSComplete - liftIO $ deleteSndFileChunks db sft - updateDirectCIFileStatus db vr user fileId CIFSSndComplete - case file of - Just CIFile {fileProtocol = FPXFTP} -> do - ft <- withStore $ \db -> getFileTransferMeta db user fileId - toView $ CRSndFileCompleteXFTP user ci ft - _ -> toView $ CRSndFileComplete user ci sft - - allowSendInline :: Integer -> Maybe InlineFileMode -> CM Bool - allowSendInline fileSize = \case - Just IFMOffer -> do - ChatConfig {fileChunkSize, inlineFiles} <- asks config - pure $ fileSize <= fileChunkSize * offerChunks inlineFiles - _ -> pure False - - bFileChunk :: Contact -> SharedMsgId -> FileChunk -> MsgMeta -> CM () - bFileChunk ct sharedMsgId chunk meta = do - ft <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId >>= getRcvFileTransfer db user - receiveInlineChunk ft chunk meta - - bFileChunkGroup :: GroupInfo -> SharedMsgId -> FileChunk -> MsgMeta -> CM () - bFileChunkGroup GroupInfo {groupId} sharedMsgId chunk meta = do - ft <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId >>= getRcvFileTransfer db user - receiveInlineChunk ft chunk meta - - receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> CM () - receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _ - | chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId - | otherwise = pure () - receiveInlineChunk ft@RcvFileTransfer {fileId} chunk meta = do - case chunk of - FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId - _ -> pure () - receiveFileChunk ft Nothing meta chunk - - xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> CM () - xFileCancelGroup GroupInfo {groupId} GroupMember {groupMemberId, memberId} sharedMsgId = do - fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId - CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId - case (msgDir, chatDir) of - (SMDRcv, CIGroupRcv m) -> do - if sameMemberId memberId m - then do - ft <- withStore (\db -> getRcvFileTransfer db user fileId) - unless (rcvFileCompleteOrCancelled ft) $ do - cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db vr user fileId - toView $ CRRcvFileSndCancelled user ci ft - else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id - (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" - - xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM () - xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do - fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId - (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId - assertSMPAcceptNotProhibited ci - -- TODO check that it's not already accepted - ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId) - if fName == fileName - then unless cancelled $ case (fileConnReq_, activeConn) of - (Just fileConnReq, _) -> do - subMode <- chatReadVar subscriptionMode - -- receiving via a separate connection - -- [async agent commands] no continuation needed, but command should be asynchronous for stability - dm <- encodeConnInfo XOk - connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode - withStore' $ \db -> createSndGroupFileTransferConnection db vr user fileId connIds m subMode - (_, Just conn) -> do - -- receiving inline - event <- withStore $ \db -> do - ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 - sft <- liftIO $ createSndGroupInlineFT db m conn ft - pure $ CRSndFileStart user ci' sft - toView event - ifM - (allowSendInline fileSize fileInline) - (sendMemberFileInline m conn ft sharedMsgId) - (messageError "x.file.acpt.inv: fileSize is bigger than allowed to send inline") - _ -> messageError "x.file.acpt.inv: member connection is not active" - else messageError "x.file.acpt.inv: fileName is different from expected" - - groupMsgToView :: forall d. MsgDirectionI d => GroupInfo -> ChatItem 'CTGroup d -> CM () - groupMsgToView gInfo ci = - toView $ CRNewChatItems user [AChatItem SCTGroup (msgDirection @d) (GroupChat gInfo) ci] - - processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> CM () - processGroupInvitation ct inv msg msgMeta = do - let Contact {localDisplayName = c, activeConn} = ct - GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv - forM_ activeConn $ \Connection {connId, connChatVersion, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do - when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) - when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId - -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile - (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, hostId) <- withStore $ \db -> createGroupInvitation db vr user ct inv customUserProfileId - let GroupMember {groupMemberId, memberId = membershipMemId} = membership - if sameGroupLinkId groupLinkId groupLinkId' - then do - subMode <- chatReadVar subscriptionMode - dm <- encodeConnInfo $ XGrpAcpt membershipMemId - connIds <- joinAgentConnectionAsync user True connRequest dm subMode - withStore' $ \db -> do - setViaGroupLinkHash db groupId connId - createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode - updateGroupMemberStatusById db userId hostId GSMemAccepted - updateGroupMemberStatus db userId membership GSMemAccepted - toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) - else do - let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole - ci <- saveRcvChatItem user (CDDirectRcv ct) msg brokerTs content - withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] - toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} - where - brokerTs = metaBrokerTs msgMeta - sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool - sameGroupLinkId (Just gli) (Just gli') = gli == gli' - sameGroupLinkId _ _ = False - - checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> CM () - checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of - MsgOk -> pure () - MsgError e -> createInternalChatItem user cd (CIRcvIntegrityError e) (Just brokerTs) - - xInfo :: Contact -> Profile -> CM () - xInfo c p' = void $ processContactProfileUpdate c p' True - - xDirectDel :: Contact -> RcvMessage -> MsgMeta -> CM () - xDirectDel c msg msgMeta = - if directOrUsed c - then do - ct' <- withStore' $ \db -> updateContactStatus db user c CSDeleted - contactConns <- withStore' $ \db -> getContactConnections db vr userId ct' - deleteAgentConnectionsAsync user $ map aConnId contactConns - forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted - activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted} - let ct'' = ct' {activeConn = activeConn'} :: Contact - ci <- saveRcvChatItem user (CDDirectRcv ct'') msg brokerTs (CIRcvDirectEvent RDEContactDeleted) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct'') ci] - toView $ CRContactDeletedByContact user ct'' - else do - contactConns <- withStore' $ \db -> getContactConnections db vr userId c - deleteAgentConnectionsAsync user $ map aConnId contactConns - withStore $ \db -> deleteContact db user c - where - brokerTs = metaBrokerTs msgMeta - - processContactProfileUpdate :: Contact -> Profile -> Bool -> CM Contact - processContactProfileUpdate c@Contact {profile = lp} p' createItems - | p /= p' = do - c' <- withStore $ \db -> - if userTTL == rcvTTL - then updateContactProfile db user c p' - else do - c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' - updateContactProfile db user c' p' - when (directOrUsed c' && createItems) $ do - createProfileUpdatedItem c' - lift $ createRcvFeatureItems user c c' - toView $ CRContactUpdated user c c' - pure c' - | otherwise = - pure c - where - p = fromLocalProfile lp - Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c - userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs - Profile {preferences = rcvPrefs_} = p' - rcvTTL = prefParam $ getPreference SCFTimedMessages rcvPrefs_ - ctUserPrefs' = - let userDefault = getPreference SCFTimedMessages (fullPreferences user) - userDefaultTTL = prefParam userDefault - ctUserTMPref' = case ctUserTMPref of - Just userTM -> Just (userTM :: TimedMessagesPreference) {ttl = rcvTTL} - _ - | rcvTTL /= userDefaultTTL -> Just (userDefault :: TimedMessagesPreference) {ttl = rcvTTL} - | otherwise -> Nothing - in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs - createProfileUpdatedItem c' = - when visibleProfileUpdated $ do - let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p' - createInternalChatItem user (CDDirectRcv c') ciContent Nothing - where - visibleProfileUpdated = - n' /= n || fn' /= fn || i' /= i || cl' /= cl - Profile {displayName = n, fullName = fn, image = i, contactLink = cl} = p - Profile {displayName = n', fullName = fn', image = i', contactLink = cl'} = p' - - xInfoMember :: GroupInfo -> GroupMember -> Profile -> UTCTime -> CM () - xInfoMember gInfo m p' brokerTs = void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs) - - xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM () - xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do - xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId - if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived - then do - m' <- processMemberProfileUpdate gInfo m p' False Nothing - withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True - let connectedIncognito = memberIncognito membership - probeMatchingMemberContact m' connectedIncognito - else messageError "x.grp.link.mem error: invalid group link host profile update" - - processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember - processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_ - | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do - updateBusinessChatProfile gInfo - case memberContactId of - Nothing -> do - m' <- withStore $ \db -> updateMemberProfile db user m p' - createProfileUpdatedItem m' - toView $ CRGroupMemberUpdated user gInfo m m' - pure m' - Just mContactId -> do - mCt <- withStore $ \db -> getContact db vr user mContactId - if canUpdateProfile mCt - then do - (m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p' - createProfileUpdatedItem m' - toView $ CRGroupMemberUpdated user gInfo m m' - toView $ CRContactUpdated user mCt ct' - pure m' - else pure m - where - canUpdateProfile ct - | not (contactActive ct) = True - | otherwise = case contactConn ct of - Nothing -> True - Just conn -> not (connReady conn) || (authErrCounter conn >= 1) - | otherwise = - pure m - where - updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of - Just bc | isMainBusinessMember bc m -> do - g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' - toView $ CRGroupUpdated user g g' (Just m) - _ -> pure () - isMainBusinessMember BusinessChatInfo {chatType, businessId, customerId} GroupMember {memberId} = case chatType of - BCBusiness -> businessId == memberId - BCCustomer -> customerId == memberId - createProfileUpdatedItem m' = - when createItems $ do - let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p' - createInternalChatItem user (CDGroupRcv gInfo m') ciContent itemTs_ - - createFeatureEnabledItems :: Contact -> CM () - createFeatureEnabledItems ct@Contact {mergedPreferences} = - forM_ allChatFeatures $ \(ACF f) -> do - let state = featureState $ getContactUserPreference f mergedPreferences - createInternalChatItem user (CDDirectRcv ct) (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing - - xInfoProbe :: ContactOrMember -> Probe -> CM () - xInfoProbe cgm2 probe = do - contactMerge <- readTVarIO =<< asks contactMergeEnabled - -- [incognito] unless connected incognito - when (contactMerge && not (contactOrMemberIncognito cgm2)) $ do - cgm1s <- withStore' $ \db -> matchReceivedProbe db vr user cgm2 probe - let cgm1s' = filter (not . contactOrMemberIncognito) cgm1s - probeMatches cgm1s' cgm2 - where - probeMatches :: [ContactOrMember] -> ContactOrMember -> CM () - probeMatches [] _ = pure () - probeMatches (cgm1' : cgm1s') cgm2' = do - cgm2''_ <- probeMatch cgm1' cgm2' probe `catchChatError` \_ -> pure (Just cgm2') - let cgm2'' = fromMaybe cgm2' cgm2''_ - probeMatches cgm1s' cgm2'' - - xInfoProbeCheck :: ContactOrMember -> ProbeHash -> CM () - xInfoProbeCheck cgm1 probeHash = do - contactMerge <- readTVarIO =<< asks contactMergeEnabled - -- [incognito] unless connected incognito - when (contactMerge && not (contactOrMemberIncognito cgm1)) $ do - cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db vr user cgm1 probeHash - forM_ cgm2Probe_ $ \(cgm2, probe) -> - unless (contactOrMemberIncognito cgm2) . void $ - probeMatch cgm1 cgm2 probe - - probeMatch :: ContactOrMember -> ContactOrMember -> Probe -> CM (Maybe ContactOrMember) - probeMatch cgm1 cgm2 probe = - case cgm1 of - COMContact c1@Contact {contactId = cId1, profile = p1} -> - case cgm2 of - COMContact c2@Contact {contactId = cId2, profile = p2} - | cId1 /= cId2 && profilesMatch p1 p2 -> do - void . sendDirectContactMessage user c1 $ XInfoProbeOk probe - COMContact <$$> mergeContacts c1 c2 - | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing - COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId} - | isNothing memberContactId && profilesMatch p1 p2 -> do - void . sendDirectContactMessage user c1 $ XInfoProbeOk probe - COMContact <$$> associateMemberAndContact c1 m2 - | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing - COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing - COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} -> - case cgm2 of - COMContact c2@Contact {profile = p2} - | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do - void $ sendDirectMemberMessage conn (XInfoProbeOk probe) groupId - COMContact <$$> associateMemberAndContact c2 m1 - | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing - COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing - - xInfoProbeOk :: ContactOrMember -> Probe -> CM () - xInfoProbeOk cgm1 probe = do - cgm2 <- withStore' $ \db -> matchSentProbe db vr user cgm1 probe - case cgm1 of - COMContact c1@Contact {contactId = cId1} -> - case cgm2 of - Just (COMContact c2@Contact {contactId = cId2}) - | cId1 /= cId2 -> void $ mergeContacts c1 c2 - | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id" - Just (COMGroupMember m2@GroupMember {memberContactId}) - | isNothing memberContactId -> void $ associateMemberAndContact c1 m2 - | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact" - _ -> pure () - COMGroupMember m1@GroupMember {memberContactId} -> - case cgm2 of - Just (COMContact c2) - | isNothing memberContactId -> void $ associateMemberAndContact c2 m1 - | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact" - Just (COMGroupMember _) -> messageWarning "xInfoProbeOk ignored: members are not matched with members" - _ -> pure () - - -- to party accepting call - xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> CM () - xCallInv ct@Contact {contactId} callId CallInvitation {callType, callDhPubKey} msg@RcvMessage {sharedMsgId_} msgMeta = do - if featureAllowed SCFCalls forContact ct - then do - g <- asks random - dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing - ci <- saveCallItem CISCallPending - callUUID <- UUID.toText <$> liftIO V4.nextRandom - let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair)) - callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey} - call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci} - calls <- asks currentCalls - -- theoretically, the new call invitation for the current contact can mark the in-progress call as ended - -- (and replace it in ChatController) - -- practically, this should not happen - withStore' $ \db -> createCall db user call' $ chatItemTs' ci - call_ <- atomically (TM.lookupInsert contactId call' calls) - forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing - toView $ CRCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callUUID, callTs = chatItemTs' ci} - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] - else featureRejected CFCalls - where - brokerTs = metaBrokerTs msgMeta - saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0) - featureRejected f = do - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvChatFeatureRejected f) Nothing Nothing False - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] - - -- to party initiating call - xCallOffer :: Contact -> CallId -> CallOffer -> RcvMessage -> CM () - xCallOffer ct callId CallOffer {callType, rtcSession, callDhPubKey} msg = do - msgCurrentCall ct callId "x.call.offer" msg $ - \call -> case callState call of - CallInvitationSent {localCallType, localDhPrivKey} -> do - let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> localDhPrivKey) - callState' = CallOfferReceived {localCallType, peerCallType = callType, peerCallSession = rtcSession, sharedKey} - askConfirmation = encryptedCall localCallType && not (encryptedCall callType) - toView CRCallOffer {user, contact = ct, callType, offer = rtcSession, sharedKey, askConfirmation} - pure (Just call {callState = callState'}, Just . ACIContent SMDSnd $ CISndCall CISCallAccepted 0) - _ -> do - msgCallStateError "x.call.offer" call - pure (Just call, Nothing) - - -- to party accepting call - xCallAnswer :: Contact -> CallId -> CallAnswer -> RcvMessage -> CM () - xCallAnswer ct callId CallAnswer {rtcSession} msg = do - msgCurrentCall ct callId "x.call.answer" msg $ - \call -> case callState call of - CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} -> do - let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession = rtcSession, sharedKey} - toView $ CRCallAnswer user ct rtcSession - pure (Just call {callState = callState'}, Just . ACIContent SMDRcv $ CIRcvCall CISCallNegotiated 0) - _ -> do - msgCallStateError "x.call.answer" call - pure (Just call, Nothing) - - -- to any call party - xCallExtra :: Contact -> CallId -> CallExtraInfo -> RcvMessage -> CM () - xCallExtra ct callId CallExtraInfo {rtcExtraInfo} msg = do - msgCurrentCall ct callId "x.call.extra" msg $ - \call -> case callState call of - CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} -> do - -- TODO update the list of ice servers in peerCallSession - let callState' = CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} - toView $ CRCallExtraInfo user ct rtcExtraInfo - pure (Just call {callState = callState'}, Nothing) - CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} -> do - -- TODO update the list of ice servers in peerCallSession - let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} - toView $ CRCallExtraInfo user ct rtcExtraInfo - pure (Just call {callState = callState'}, Nothing) - _ -> do - msgCallStateError "x.call.extra" call - pure (Just call, Nothing) - - -- to any call party - xCallEnd :: Contact -> CallId -> RcvMessage -> CM () - xCallEnd ct callId msg = - msgCurrentCall ct callId "x.call.end" msg $ \Call {chatItemId} -> do - toView $ CRCallEnded user ct - (Nothing,) <$> callStatusItemContent user ct chatItemId WCSDisconnected - - msgCurrentCall :: Contact -> CallId -> Text -> RcvMessage -> (Call -> CM (Maybe Call, Maybe ACIContent)) -> CM () - msgCurrentCall ct@Contact {contactId = ctId'} callId' eventName RcvMessage {msgId} action = do - calls <- asks currentCalls - atomically (TM.lookup ctId' calls) >>= \case - Nothing -> messageError $ eventName <> ": no current call" - Just call@Call {contactId, callId, chatItemId} - | contactId /= ctId' || callId /= callId' -> messageError $ eventName <> ": wrong contact or callId" - | otherwise -> do - (call_, aciContent_) <- action call - case call_ of - Just call' -> do - unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId' - atomically $ TM.insert ctId' call' calls - _ -> do - withStore' $ \db -> deleteCalls db user ctId' - atomically $ TM.delete ctId' calls - forM_ aciContent_ $ \aciContent -> do - timed_ <- callTimed ct aciContent - updateDirectChatItemView user ct chatItemId aciContent False False timed_ $ Just msgId - forM_ (timed_ >>= timedDeleteAt') $ - startProximateTimedItemThread user (ChatRef CTDirect ctId', chatItemId) - - msgCallStateError :: Text -> Call -> CM () - msgCallStateError eventName Call {callState} = - messageError $ eventName <> ": wrong call state " <> T.pack (show $ callStateTag callState) - - mergeContacts :: Contact -> Contact -> CM (Maybe Contact) - mergeContacts c1 c2 = do - let Contact {localDisplayName = cLDN1, profile = LocalProfile {displayName}} = c1 - Contact {localDisplayName = cLDN2} = c2 - case (suffixOrd displayName cLDN1, suffixOrd displayName cLDN2) of - (Just cOrd1, Just cOrd2) - | cOrd1 < cOrd2 -> merge c1 c2 - | cOrd2 < cOrd1 -> merge c2 c1 - | otherwise -> pure Nothing - _ -> pure Nothing - where - merge c1' c2' = do - c2'' <- withStore $ \db -> mergeContactRecords db vr user c1' c2' - toView $ CRContactsMerged user c1' c2' c2'' - when (directOrUsed c2'') $ showSecurityCodeChanged c2'' - pure $ Just c2'' - where - showSecurityCodeChanged mergedCt = do - let sc1_ = contactSecurityCode c1' - sc2_ = contactSecurityCode c2' - scMerged_ = contactSecurityCode mergedCt - case (sc1_, sc2_) of - (Just sc1, Nothing) - | scMerged_ /= Just sc1 -> securityCodeChanged mergedCt - | otherwise -> pure () - (Nothing, Just sc2) - | scMerged_ /= Just sc2 -> securityCodeChanged mergedCt - | otherwise -> pure () - _ -> pure () - - associateMemberAndContact :: Contact -> GroupMember -> CM (Maybe Contact) - associateMemberAndContact c m = do - let Contact {localDisplayName = cLDN, profile = LocalProfile {displayName}} = c - GroupMember {localDisplayName = mLDN} = m - case (suffixOrd displayName cLDN, suffixOrd displayName mLDN) of - (Just cOrd, Just mOrd) - | cOrd < mOrd -> Just <$> associateMemberWithContact c m - | mOrd < cOrd -> Just <$> associateContactWithMember m c - | otherwise -> pure Nothing - _ -> pure Nothing - - suffixOrd :: ContactName -> ContactName -> Maybe Int - suffixOrd displayName localDisplayName - | localDisplayName == displayName = Just 0 - | otherwise = case T.stripPrefix (displayName <> "_") localDisplayName of - Just suffix -> readMaybe $ T.unpack suffix - Nothing -> Nothing - - associateMemberWithContact :: Contact -> GroupMember -> CM Contact - associateMemberWithContact c1 m2@GroupMember {groupId} = do - withStore' $ \db -> associateMemberWithContactRecord db user c1 m2 - g <- withStore $ \db -> getGroupInfo db vr user groupId - toView $ CRContactAndMemberAssociated user c1 g m2 c1 - pure c1 - - associateContactWithMember :: GroupMember -> Contact -> CM Contact - associateContactWithMember m1@GroupMember {groupId} c2 = do - c2' <- withStore $ \db -> associateContactWithMemberRecord db vr user m1 c2 - g <- withStore $ \db -> getGroupInfo db vr user groupId - toView $ CRContactAndMemberAssociated user c2 g m1 c2' - pure c2' - - saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Bool) - saveConnInfo activeConn connInfo = do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo - conn' <- updatePeerChatVRange activeConn chatVRange - case chatMsgEvent of - XInfo p -> do - let contactUsed = connDirect activeConn - ct <- withStore $ \db -> createDirectContact db user conn' p contactUsed - toView $ CRContactConnecting user ct - pure (conn', False) - XGrpLinkInv glInv -> do - (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv - toView $ CRGroupLinkConnecting user gInfo host - pure (conn', True) - -- TODO show/log error, other events in SMP confirmation - _ -> pure (conn', False) - - xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> UTCTime -> CM () - xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _) msg brokerTs = do - checkHostRole m memRole - unless (sameMemberId memId $ membership gInfo) $ - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Right unknownMember@GroupMember {memberStatus = GSMemUnknown} -> do - updatedMember <- withStore $ \db -> updateUnknownMemberAnnounced db vr user m unknownMember memInfo - toView $ CRUnknownMemberAnnounced user gInfo m unknownMember updatedMember - memberAnnouncedToView updatedMember - Right _ -> messageError "x.grp.mem.new error: member already exists" - Left _ -> do - newMember <- withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced - memberAnnouncedToView newMember - where - memberAnnouncedToView announcedMember@GroupMember {groupMemberId, memberProfile} = do - let event = RGEMemberAdded groupMemberId (fromLocalProfile memberProfile) - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent event) - groupMsgToView gInfo ci - toView $ CRJoinedGroupMemberConnecting user gInfo m announcedMember - - xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM () - xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do - case memberCategory m of - GCHostMember -> - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Right _ -> messageError "x.grp.mem.intro ignored: member already exists" - Left _ -> do - when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) - subMode <- chatReadVar subscriptionMode - -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second - groupConnIds <- createConn subMode - directConnIds <- case memChatVRange of - Nothing -> Just <$> createConn subMode - Just (ChatVersionRange mcvr) - | maxVersion mcvr >= groupDirectInvVersion -> pure Nothing - | otherwise -> Just <$> createConn subMode - let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo - chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange - void $ withStore $ \db -> createIntroReMember db user gInfo m chatV memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode - _ -> messageError "x.grp.mem.intro can be only sent by host member" - where - createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode - - sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> CM () - sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do - hostConn <- withStore $ \db -> getConnectionById db vr user hostConnId - let msg = XGrpMemInv memberId IntroInvitation {groupConnReq, directConnReq} - void $ sendDirectMemberMessage hostConn msg groupId - withStore' $ \db -> updateGroupMemberStatusById db userId groupMemberId GSMemIntroInvited - - xGrpMemInv :: GroupInfo -> GroupMember -> MemberId -> IntroInvitation -> CM () - xGrpMemInv gInfo m memId introInv = do - case memberCategory m of - GCInviteeMember -> - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Left _ -> messageError "x.grp.mem.inv error: referenced member does not exist" - Right reMember -> do - GroupMemberIntro {introId} <- withStore $ \db -> saveIntroInvitation db reMember m introInv - sendGroupMemberMessage user gInfo reMember (XGrpMemFwd (memberInfo m) introInv) (Just introId) $ - withStore' $ - \db -> updateIntroStatus db introId GMIntroInvForwarded - _ -> messageError "x.grp.mem.inv can be only sent by invitee member" - - xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> CM () - xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do - let GroupMember {memberId = membershipMemId} = membership - checkHostRole m memRole - toMember <- - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent - -- the situation when member does not exist is an error - -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that. - -- For now, this branch compensates for the lack of delayed message delivery. - Left _ -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced - Right m' -> pure m' - withStore' $ \db -> saveMemberInvitation db toMember introInv - subMode <- chatReadVar subscriptionMode - -- [incognito] send membership incognito profile, create direct connection as incognito - let membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership - dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile - -- [async agent commands] no continuation needed, but commands should be asynchronous for stability - groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode - directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode - let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo - mcvr = maybe chatInitialVRange fromChatVRange memChatVRange - chatV = vr `peerConnChatVersion` mcvr - withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode - - xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> CM () - xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs - | membershipMemId == memId = - let gInfo' = gInfo {membership = membership {memberRole = memRole}} - in changeMemberRole gInfo' membership $ RGEUserRole memRole - | otherwise = - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole - Left _ -> messageError "x.grp.mem.role with unknown member ID" - where - GroupMember {memberId = membershipMemId} = membership - changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent - | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" - | otherwise = do - withStore' $ \db -> updateGroupMemberRole db user member memRole - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) - groupMsgToView gInfo ci - toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} - - checkHostRole :: GroupMember -> GroupMemberRole -> CM () - checkHostRole GroupMember {memberRole, localDisplayName} memRole = - when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName) - - xGrpMemRestrict :: GroupInfo -> GroupMember -> MemberId -> MemberRestrictions -> RcvMessage -> UTCTime -> CM () - xGrpMemRestrict - gInfo@GroupInfo {groupId, membership = GroupMember {memberId = membershipMemId}} - m@GroupMember {memberRole = senderRole} - memId - MemberRestrictions {restriction} - msg - brokerTs - | membershipMemId == memId = - -- member shouldn't receive this message about themselves - messageError "x.grp.mem.restrict: admin blocks you" - | otherwise = - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Right bm@GroupMember {groupMemberId = bmId, memberRole, memberProfile = bmp} - | senderRole < GRAdmin || senderRole < memberRole -> messageError "x.grp.mem.restrict with insufficient member permissions" - | otherwise -> do - bm' <- setMemberBlocked bmId - toggleNtf user bm' (not blocked) - let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs ciContent - groupMsgToView gInfo ci - toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked} - Left (SEGroupMemberNotFoundByMemberId _) -> do - bm <- createUnknownMember gInfo memId - bm' <- setMemberBlocked $ groupMemberId' bm - toView $ CRUnknownMemberBlocked user gInfo m bm' - Left e -> throwError $ ChatErrorStore e - where - setMemberBlocked bmId = - withStore $ \db -> do - liftIO $ updateGroupMemberBlocked db user groupId bmId restriction - getGroupMember db vr user groupId bmId - blocked = mrsBlocked restriction - - xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> CM () - xGrpMemCon gInfo sendingMember memId = do - refMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo memId - case (memberCategory sendingMember, memberCategory refMember) of - (GCInviteeMember, GCInviteeMember) -> - withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case - Right intro -> inviteeXGrpMemCon intro - Left _ -> - withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case - Right intro -> forwardMemberXGrpMemCon intro - Left _ -> messageWarning "x.grp.mem.con: no introduction" - (GCInviteeMember, _) -> - withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case - Right intro -> inviteeXGrpMemCon intro - Left _ -> messageWarning "x.grp.mem.con: no introduction" - (_, GCInviteeMember) -> - withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case - Right intro -> forwardMemberXGrpMemCon intro - Left _ -> messageWarning "x.grp.mem.con: no introductiosupportn" - -- Note: we can allow XGrpMemCon to all member categories if we decide to support broader group forwarding, - -- deduplication (see saveGroupRcvMsg, saveGroupFwdRcvMsg) already supports sending XGrpMemCon - -- to any forwarding member, not only host/inviting member; - -- database would track all members connections then - -- (currently it's done via group_member_intros for introduced connections only) - _ -> - messageWarning "x.grp.mem.con: neither member is invitee" - where - inviteeXGrpMemCon :: GroupMemberIntro -> CM () - inviteeXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of - GMIntroReConnected -> updateStatus introId GMIntroConnected - GMIntroToConnected -> pure () - GMIntroConnected -> pure () - _ -> updateStatus introId GMIntroToConnected - forwardMemberXGrpMemCon :: GroupMemberIntro -> CM () - forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of - GMIntroToConnected -> updateStatus introId GMIntroConnected - GMIntroReConnected -> pure () - GMIntroConnected -> pure () - _ -> updateStatus introId GMIntroReConnected - updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status - - xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> CM () - xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do - let GroupMember {memberId = membershipMemId} = membership - if membershipMemId == memId - then checkRole membership $ do - deleteGroupLinkIfExists user gInfo - -- member records are not deleted to keep history - members <- withStore' $ \db -> getGroupMembers db vr user gInfo - deleteMembersConnections user members - withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved - deleteMemberItem RGEUserDeleted - toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m - else - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Left _ -> messageError "x.grp.mem.del with unknown member ID" - Right member@GroupMember {groupMemberId, memberProfile} -> - checkRole member $ do - -- ? prohibit deleting member if it's the sender - sender should use x.grp.leave - deleteMemberConnection user member - -- undeleted "member connected" chat item will prevent deletion of member record - deleteOrUpdateMemberRecord user member - deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile) - toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved} - where - checkRole GroupMember {memberRole} a - | senderRole < GRAdmin || senderRole < memberRole = - messageError "x.grp.mem.del with insufficient member permissions" - | otherwise = a - deleteMemberItem gEvent = do - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) - groupMsgToView gInfo ci - - xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () - xGrpLeave gInfo m msg brokerTs = do - deleteMemberConnection user m - -- member record is not deleted to allow creation of "member left" chat item - withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEMemberLeft) - groupMsgToView gInfo ci - toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft} - - xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () - xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg brokerTs = do - when (memberRole /= GROwner) $ throwChatError $ CEGroupUserRole gInfo GROwner - ms <- withStore' $ \db -> do - members <- getGroupMembers db vr user gInfo - updateGroupMemberStatus db userId membership GSMemGroupDeleted - pure members - -- member records are not deleted to keep history - deleteMembersConnections user ms - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEGroupDeleted) - groupMsgToView gInfo ci - toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m - - xGrpInfo :: GroupInfo -> GroupMember -> GroupProfile -> RcvMessage -> UTCTime -> CM () - xGrpInfo g@GroupInfo {groupProfile = p, businessChat} m@GroupMember {memberRole} p' msg brokerTs - | memberRole < GROwner = messageError "x.grp.info with insufficient member permissions" - | otherwise = case businessChat of - Nothing -> unless (p == p') $ do - g' <- withStore $ \db -> updateGroupProfile db user g p' - toView $ CRGroupUpdated user g g' (Just m) - let cd = CDGroupRcv g' m - unless (sameGroupProfileInfo p p') $ do - ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') - groupMsgToView g' ci - createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' - Just _ -> updateGroupPrefs_ g m $ fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' - - xGrpPrefs :: GroupInfo -> GroupMember -> GroupPreferences -> CM () - xGrpPrefs g m@GroupMember {memberRole} ps' - | memberRole < GROwner = messageError "x.grp.prefs with insufficient member permissions" - | otherwise = updateGroupPrefs_ g m ps' - - updateGroupPrefs_ :: GroupInfo -> GroupMember -> GroupPreferences -> CM () - updateGroupPrefs_ g@GroupInfo {groupProfile = p} m ps' = - unless (groupPreferences p == Just ps') $ do - g' <- withStore' $ \db -> updateGroupPreferences db user g ps' - toView $ CRGroupUpdated user g g' (Just m) - let cd = CDGroupRcv g' m - createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' - - xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> CM () - xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do - unless (groupFeatureMemberAllowed SGFDirectMessages m g) $ messageError "x.grp.direct.inv: direct messages not allowed" - let GroupMember {memberContactId} = m - subMode <- chatReadVar subscriptionMode - case memberContactId of - Nothing -> createNewContact subMode - Just mContactId -> do - mCt <- withStore $ \db -> getContact db vr user mContactId - let Contact {activeConn, contactGrpInvSent} = mCt - forM_ activeConn $ \Connection {connId} -> - if contactGrpInvSent - then do - ownConnReq <- withStore $ \db -> getConnReqInv db connId - -- in case both members sent x.grp.direct.inv before receiving other's for processing, - -- only the one who received greater connReq joins, the other creates items and waits for confirmation - if strEncode connReq > strEncode ownConnReq - then joinExistingContact subMode mCt - else createItems mCt m - else joinExistingContact subMode mCt - where - joinExistingContact subMode mCt = do - connIds <- joinConn subMode - mCt' <- withStore $ \db -> updateMemberContactInvited db user connIds g mConn mCt subMode - createItems mCt' m - securityCodeChanged mCt' - createNewContact subMode = do - connIds <- joinConn subMode - -- [incognito] reuse membership incognito profile - (mCt', m') <- withStore' $ \db -> createMemberContactInvited db user connIds g m mConn subMode - createItems mCt' m' - joinConn subMode = do - -- [incognito] send membership incognito profile - let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing False - -- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ) - dm <- encodeConnInfo $ XInfo p - joinAgentConnectionAsync user True connReq dm subMode - createItems mCt' m' = do - createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing - toView $ CRNewMemberContactReceivedInv user mCt' g m' - forM_ mContent_ $ \mc -> do - ci <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat mCt') ci] - - securityCodeChanged :: Contact -> CM () - securityCodeChanged ct = do - toView $ CRContactVerificationReset user ct - createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing - - xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> CM () - xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId msg msgTs = do - when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName) - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case - Right author -> processForwardedMsg author msg - Left (SEGroupMemberNotFoundByMemberId _) -> do - unknownAuthor <- createUnknownMember gInfo memberId - toView $ CRUnknownMemberCreated user gInfo m unknownAuthor - processForwardedMsg unknownAuthor msg - Left e -> throwError $ ChatErrorStore e - where - -- Note: forwarded group events (see forwardedGroupMsg) should include msgId to be deduplicated - processForwardedMsg :: GroupMember -> ChatMessage 'Json -> CM () - processForwardedMsg author chatMsg = do - let body = LB.toStrict $ J.encode msg - rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} <- saveGroupFwdRcvMsg user groupId m author body chatMsg - case event of - XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True - XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr - XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent rcvMsg msgTs ttl live - XMsgDel sharedMsgId memId -> groupMessageDelete gInfo author sharedMsgId memId rcvMsg msgTs - XMsgReact sharedMsgId (Just memId) reaction add -> groupMsgReaction gInfo author sharedMsgId memId reaction add rcvMsg msgTs - XFileCancel sharedMsgId -> xFileCancelGroup gInfo author sharedMsgId - XInfo p -> xInfoMember gInfo author p msgTs - XGrpMemNew memInfo -> xGrpMemNew gInfo author memInfo rcvMsg msgTs - XGrpMemRole memId memRole -> xGrpMemRole gInfo author memId memRole rcvMsg msgTs - XGrpMemDel memId -> xGrpMemDel gInfo author memId rcvMsg msgTs - XGrpLeave -> xGrpLeave gInfo author rcvMsg msgTs - XGrpDel -> xGrpDel gInfo author rcvMsg msgTs - XGrpInfo p' -> xGrpInfo gInfo author p' rcvMsg msgTs - XGrpPrefs ps' -> xGrpPrefs gInfo author ps' - _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event) - - createUnknownMember :: GroupInfo -> MemberId -> CM GroupMember - createUnknownMember gInfo memberId = do - let name = T.take 7 . safeDecodeUtf8 . B64.encode . unMemberId $ memberId - withStore $ \db -> createNewUnknownGroupMember db vr user gInfo memberId name - - directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM () - directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do - checkIntegrityCreateItem (CDDirectRcv ct) msgMeta `catchChatError` \_ -> pure () - forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do - withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus - updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete - - groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM () - groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do - checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure () - forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do - withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus - updateGroupItemsStatus gInfo m conn agentMsgId (GSSRcvd msgRcptStatus) Nothing - - -- Searches chat items for many agent message IDs and updates their status - updateDirectItemsStatusMsgs :: Contact -> Connection -> [AgentMsgId] -> CIStatus 'MDSnd -> CM () - updateDirectItemsStatusMsgs ct conn msgIds newStatus = do - cis <- withStore' $ \db -> forM msgIds $ \msgId -> runExceptT $ updateDirectItemsStatus' db ct conn msgId newStatus - let acis = map ctItem $ concat $ rights cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis - where - ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) - - updateDirectItemStatus :: Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> CM () - updateDirectItemStatus ct conn msgId newStatus = do - cis <- withStore $ \db -> updateDirectItemsStatus' db ct conn msgId newStatus - let acis = map ctItem cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis - where - ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) - - updateDirectItemsStatus' :: DB.Connection -> Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> ExceptT StoreError IO [ChatItem 'CTDirect 'MDSnd] - updateDirectItemsStatus' db ct@Contact {contactId} Connection {connId} msgId newStatus = do - items <- liftIO $ getDirectChatItemsByAgentMsgId db user contactId connId msgId - catMaybes <$> mapM updateItem items - where - updateItem :: CChatItem 'CTDirect -> ExceptT StoreError IO (Maybe (ChatItem 'CTDirect 'MDSnd)) - updateItem = \case - (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _ _}}) -> pure Nothing - (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) - | itemStatus == newStatus -> pure Nothing - | otherwise -> Just <$> updateDirectChatItemStatus db user ct itemId newStatus - _ -> pure Nothing - - updateGroupMemSndStatus' :: DB.Connection -> ChatItemId -> GroupMemberId -> GroupSndStatus -> IO Bool - updateGroupMemSndStatus' db itemId groupMemberId newStatus = - runExceptT (getGroupSndStatus db itemId groupMemberId) >>= \case - Right (GSSRcvd _) -> pure False - Right memStatus - | memStatus == newStatus -> pure False - | otherwise -> updateGroupSndStatus db itemId groupMemberId newStatus $> True - _ -> pure False - - updateGroupItemsStatus :: GroupInfo -> GroupMember -> Connection -> AgentMsgId -> GroupSndStatus -> Maybe Bool -> CM () - updateGroupItemsStatus gInfo@GroupInfo {groupId} GroupMember {groupMemberId} Connection {connId} msgId newMemStatus viaProxy_ = do - items <- withStore' (\db -> getGroupChatItemsByAgentMsgId db user groupId connId msgId) - cis <- catMaybes <$> withStore (\db -> mapM (updateItem db) items) - let acis = map gItem cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis - where - gItem = AChatItem SCTGroup SMDSnd (GroupChat gInfo) - updateItem :: DB.Connection -> CChatItem 'CTGroup -> ExceptT StoreError IO (Maybe (ChatItem 'CTGroup 'MDSnd)) - updateItem db = \case - (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _ SSPComplete}}) -> pure Nothing - (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) -> do - forM_ viaProxy_ $ \viaProxy -> liftIO $ setGroupSndViaProxy db itemId groupMemberId viaProxy - memStatusChanged <- liftIO $ updateGroupMemSndStatus' db itemId groupMemberId newMemStatus - if memStatusChanged - then do - memStatusCounts <- liftIO $ getGroupSndStatusCounts db itemId - let newStatus = membersGroupItemStatus memStatusCounts - if newStatus /= itemStatus - then Just <$> updateGroupChatItemStatus db user gInfo itemId newStatus - else pure Nothing - else pure Nothing - _ -> pure Nothing - -createContactPQSndItem :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection) -createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' = - flip catchChatError (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of - (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled') - (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (E2EInfo pqSndEnabled') - _ -> pure (ct, conn) - where - createPQItem ciContent = do - let conn' = conn {pqSndEnabled = Just pqSndEnabled'} :: Connection - ct' = ct {activeConn = Just conn'} :: Contact - when (contactPQEnabled ct /= contactPQEnabled ct') $ do - createInternalChatItem user (CDDirectSnd ct') ciContent Nothing - toView $ CRContactPQEnabled user ct' pqSndEnabled' - pure (ct', conn') - -updateContactPQRcv :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection) -updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' = - flip catchChatError (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of - (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled') - (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (E2EInfo pqRcvEnabled') - _ -> pure (ct, conn) - where - updatePQ ciContent = do - withStore' $ \db -> updateConnPQRcvEnabled db connId pqRcvEnabled' - let conn' = conn {pqRcvEnabled = Just pqRcvEnabled'} :: Connection - ct' = ct {activeConn = Just conn'} :: Contact - when (contactPQEnabled ct /= contactPQEnabled ct') $ do - createInternalChatItem user (CDDirectRcv ct') ciContent Nothing - toView $ CRContactPQEnabled user ct' pqRcvEnabled' - pure (ct', conn') - -metaBrokerTs :: MsgMeta -> UTCTime -metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs - -sameMemberId :: MemberId -> GroupMember -> Bool -sameMemberId memId GroupMember {memberId} = memId == memberId - -updatePeerChatVRange :: Connection -> VersionRangeChat -> CM Connection -updatePeerChatVRange conn@Connection {connId, connChatVersion = v, peerChatVRange, connType, pqSupport, pqEncryption} msgVRange = do - v' <- lift $ upgradedConnVersion v msgVRange - conn' <- - if msgVRange /= peerChatVRange || v' /= v - then do - withStore' $ \db -> setPeerChatVRange db connId v' msgVRange - pure conn {connChatVersion = v', peerChatVRange = msgVRange} - else pure conn - -- TODO v6.0 remove/review: for contacts only version upgrade should trigger enabling PQ support/encryption - if connType == ConnContact && v' >= pqEncryptionCompressionVersion && (pqSupport /= PQSupportOn || pqEncryption /= PQEncOn) - then do - withStore' $ \db -> updateConnSupportPQ db connId PQSupportOn PQEncOn - pure conn' {pqSupport = PQSupportOn, pqEncryption = PQEncOn} - else pure conn' - -updateMemberChatVRange :: GroupMember -> Connection -> VersionRangeChat -> CM (GroupMember, Connection) -updateMemberChatVRange mem@GroupMember {groupMemberId} conn@Connection {connId, connChatVersion = v, peerChatVRange} msgVRange = do - v' <- lift $ upgradedConnVersion v msgVRange - if msgVRange /= peerChatVRange || v' /= v - then do - withStore' $ \db -> do - setPeerChatVRange db connId v' msgVRange - setMemberChatVRange db groupMemberId msgVRange - let conn' = conn {connChatVersion = v', peerChatVRange = msgVRange} - pure (mem {memberChatVRange = msgVRange, activeConn = Just conn'}, conn') - else pure (mem, conn) - -upgradedConnVersion :: VersionChat -> VersionRangeChat -> CM' VersionChat -upgradedConnVersion v peerVR = do - vr <- chatVersionRange' - -- don't allow reducing agreed connection version - pure $ maybe v (\(Compatible v') -> max v v') $ vr `compatibleVersion` peerVR - -parseFileDescription :: FilePartyI p => Text -> CM (ValidFileDescription p) -parseFileDescription = - liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8) - -sendDirectFileInline :: User -> Contact -> FileTransferMeta -> SharedMsgId -> CM () -sendDirectFileInline user ct ft sharedMsgId = do - msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage user ct - withStore $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId - -sendMemberFileInline :: GroupMember -> Connection -> FileTransferMeta -> SharedMsgId -> CM () -sendMemberFileInline m@GroupMember {groupId} conn ft sharedMsgId = do - msgDeliveryId <- sendFileInline_ ft sharedMsgId $ \msg -> do - (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg groupId - pure (sndMsg, msgDeliveryId) - withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId - -sendFileInline_ :: FileTransferMeta -> SharedMsgId -> (ChatMsgEvent 'Binary -> CM (SndMessage, Int64)) -> CM Int64 -sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg = - sendChunks 1 =<< liftIO . B.readFile =<< lift (toFSFilePath filePath) - where - sendChunks chunkNo bytes = do - let (chunk, rest) = B.splitAt chSize bytes - (_, msgDeliveryId) <- sendMsg $ BFileChunk sharedMsgId $ FileChunk chunkNo chunk - if B.null rest - then pure msgDeliveryId - else sendChunks (chunkNo + 1) rest - chSize = fromIntegral chunkSize - -parseChatMessage :: Connection -> ByteString -> CM (ChatMessage 'Json) -parseChatMessage conn s = do - case parseChatMessages s of - [msg] -> liftEither . first (ChatError . errType) $ (\(ACMsg _ m) -> checkEncoding m) =<< msg - _ -> throwChatError $ CEException "parseChatMessage: single message is expected" - where - errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s) -{-# INLINE parseChatMessage #-} - -sendFileChunk :: User -> SndFileTransfer -> CM () -sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} = - unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ do - vr <- chatVersionRange - withStore' (`createSndFileChunk` ft) >>= \case - Just chunkNo -> sendFileChunkNo ft chunkNo - Nothing -> do - ci <- withStore $ \db -> do - liftIO $ updateSndFileStatus db ft FSComplete - liftIO $ deleteSndFileChunks db ft - updateDirectCIFileStatus db vr user fileId CIFSSndComplete - toView $ CRSndFileComplete user ci ft - lift $ closeFileHandle fileId sndFiles - deleteAgentConnectionAsync user acId - -sendFileChunkNo :: SndFileTransfer -> Integer -> CM () -sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do - chunkBytes <- readFileChunk ft chunkNo - (msgId, _) <- withAgent $ \a -> sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} - withStore' $ \db -> updateSndFileChunkMsg db ft chunkNo msgId - -readFileChunk :: SndFileTransfer -> Integer -> CM ByteString -readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo = do - fsFilePath <- lift $ toFSFilePath filePath - read_ fsFilePath `catchThrow` (ChatError . CEFileRead filePath . show) - where - read_ fsFilePath = do - h <- getFileHandle fileId fsFilePath sndFiles ReadMode - pos <- hTell h - let pos' = (chunkNo - 1) * chunkSize - when (pos /= pos') $ hSeek h AbsoluteSeek pos' - liftIO . B.hGet h $ fromInteger chunkSize - -parseFileChunk :: ByteString -> CM FileChunk -parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode - -appendFileChunk :: RcvFileTransfer -> Integer -> ByteString -> Bool -> CM () -appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs, fileInvitation = FileInvitation {fileName}} chunkNo chunk final = - case fileStatus of - RFSConnected RcvFileInfo {filePath} -> append_ filePath - -- sometimes update of file transfer status to FSConnected - -- doesn't complete in time before MSG with first file chunk - RFSAccepted RcvFileInfo {filePath} -> append_ filePath - RFSCancelled _ -> pure () - _ -> throwChatError $ CEFileInternal "receiving file transfer not in progress" - where - append_ :: FilePath -> CM () - append_ filePath = do - fsFilePath <- lift $ toFSFilePath filePath - h <- getFileHandle fileId fsFilePath rcvFiles AppendMode - liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (fileErr . show) - withStore' $ \db -> updatedRcvFileChunkStored db ft chunkNo - when final $ do - lift $ closeFileHandle fileId rcvFiles - forM_ cryptoArgs $ \cfArgs -> do - tmpFile <- lift getChatTempDirectory >>= liftIO . (`uniqueCombine` fileName) - tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case - Right () -> do - removeFile fsFilePath `catchChatError` \_ -> pure () - renameFile tmpFile fsFilePath - Left e -> do - toView $ CRChatError Nothing e - removeFile tmpFile `catchChatError` \_ -> pure () - withStore' (`removeFileCryptoArgs` fileId) - where - encryptErr e = fileErr $ e <> ", received file not encrypted" - fileErr = ChatError . CEFileWrite filePath - -getFileHandle :: Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> CM Handle -getFileHandle fileId filePath files ioMode = do - fs <- asks files - h_ <- M.lookup fileId <$> readTVarIO fs - maybe (newHandle fs) pure h_ - where - newHandle fs = do - h <- openFile filePath ioMode `catchThrow` (ChatError . CEFileInternal . show) - atomically . modifyTVar fs $ M.insert fileId h - pure h - -isFileActive :: Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> CM Bool -isFileActive fileId files = do - fs <- asks files - isJust . M.lookup fileId <$> readTVarIO fs - -cancelRcvFileTransfer :: User -> RcvFileTransfer -> CM (Maybe ConnId) -cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} = - cancel' `catchChatError` (\e -> toView (CRChatError (Just user) e) $> fileConnId) - where - cancel' = do - lift $ closeFileHandle fileId rcvFiles - withStore' $ \db -> do - updateFileCancelled db user fileId CIFSRcvCancelled - updateRcvFileStatus db fileId FSCancelled - deleteRcvFileChunks db ft - case xftpRcvFile of - Just XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId), agentRcvFileDeleted} -> - unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile aFileId fileId - _ -> pure () - pure fileConnId - fileConnId = if isNothing xftpRcvFile && isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing - -cancelSndFile :: User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> CM [ConnId] -cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do - withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled) - `catchChatError` (toView . CRChatError (Just user)) - case xftpSndFile of - Nothing -> - catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel) - Just xsf -> do - forM_ fts (\ft -> cancelSndFileTransfer user ft False) - lift (agentXFTPDeleteSndFileRemote user xsf fileId) `catchChatError` (toView . CRChatError (Just user)) - pure [] - --- TODO v6.0 remove -cancelSndFileTransfer :: User -> SndFileTransfer -> Bool -> CM (Maybe ConnId) -cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel = - if fileStatus == FSCancelled || fileStatus == FSComplete - then pure Nothing - else cancel' `catchChatError` (\e -> toView (CRChatError (Just user) e) $> fileConnId) - where - cancel' = do - withStore' $ \db -> do - updateSndFileStatus db ft FSCancelled - deleteSndFileChunks db ft - when sendCancel $ case fileInline of - Just _ -> do - vr <- chatVersionRange - (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db vr user connId - void $ sendDirectMessage_ conn (BFileChunk sharedMsgId FileChunkCancel) (ConnectionId connId) - _ -> withAgent $ \a -> void . sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunkCancel - pure fileConnId - fileConnId = if isNothing fileInline then Just acId else Nothing - -closeFileHandle :: Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> CM' () -closeFileHandle fileId files = do - fs <- asks files - h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m) - liftIO $ mapM_ hClose h_ `catchAll_` pure () - -deleteMembersConnections :: User -> [GroupMember] -> CM () -deleteMembersConnections user members = deleteMembersConnections' user members False - -deleteMembersConnections' :: User -> [GroupMember] -> Bool -> CM () -deleteMembersConnections' user members waitDelivery = do - let memberConns = - filter (\Connection {connStatus} -> connStatus /= ConnDeleted) $ - mapMaybe (\GroupMember {activeConn} -> activeConn) members - deleteAgentConnectionsAsync' user (map aConnId memberConns) waitDelivery - lift . void . withStoreBatch' $ \db -> map (\conn -> updateConnectionStatus db conn ConnDeleted) memberConns - -deleteMemberConnection :: User -> GroupMember -> CM () -deleteMemberConnection user mem = deleteMemberConnection' user mem False - -deleteMemberConnection' :: User -> GroupMember -> Bool -> CM () -deleteMemberConnection' user GroupMember {activeConn} waitDelivery = do - forM_ activeConn $ \conn -> do - deleteAgentConnectionAsync' user (aConnId conn) waitDelivery - withStore' $ \db -> updateConnectionStatus db conn ConnDeleted - -deleteOrUpdateMemberRecord :: User -> GroupMember -> CM () -deleteOrUpdateMemberRecord user@User {userId} member = - withStore' $ \db -> - checkGroupMemberHasItems db user member >>= \case - Just _ -> updateGroupMemberStatus db userId member GSMemRemoved - Nothing -> deleteGroupMember db user member - -sendDirectContactMessages :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage] -sendDirectContactMessages user ct events = do - Connection {connChatVersion = v} <- liftEither $ contactSendConn_ ct - if v >= batchSend2Version - then sendDirectContactMessages' user ct events - else forM (L.toList events) $ \evt -> - (Right . fst <$> sendDirectContactMessage user ct evt) `catchChatError` \e -> pure (Left e) - -sendDirectContactMessages' :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage] -sendDirectContactMessages' user ct events = do - conn@Connection {connId} <- liftEither $ contactSendConn_ ct - let idsEvts = L.map (ConnectionId connId,) events - msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} - sndMsgs_ <- lift $ createSndMessages idsEvts - (sndMsgs', pqEnc_) <- batchSendConnMessagesB user conn msgFlags sndMsgs_ - forM_ pqEnc_ $ \pqEnc' -> void $ createContactPQSndItem user ct conn pqEnc' - pure sndMsgs' - -sendDirectContactMessage :: MsgEncodingI e => User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64) -sendDirectContactMessage user ct chatMsgEvent = do - conn@Connection {connId} <- liftEither $ contactSendConn_ ct - r <- sendDirectMessage_ conn chatMsgEvent (ConnectionId connId) - let (sndMessage, msgDeliveryId, pqEnc') = r - void $ createContactPQSndItem user ct conn pqEnc' - pure (sndMessage, msgDeliveryId) - -contactSendConn_ :: Contact -> Either ChatError Connection -contactSendConn_ ct@Contact {activeConn} = case activeConn of - Nothing -> err $ CEContactNotReady ct - Just conn - | not (connReady conn) -> err $ CEContactNotReady ct - | not (contactActive ct) -> err $ CEContactNotActive ct - | connDisabled conn -> err $ CEContactDisabled ct - | otherwise -> Right conn - where - err = Left . ChatError - --- unlike sendGroupMemberMessage, this function will not store message as pending --- TODO v5.8 we could remove pending messages once all clients support forwarding -sendDirectMemberMessage :: MsgEncodingI e => Connection -> ChatMsgEvent e -> GroupId -> CM (SndMessage, Int64, PQEncryption) -sendDirectMemberMessage conn chatMsgEvent groupId = sendDirectMessage_ conn chatMsgEvent (GroupId groupId) - -sendDirectMessage_ :: MsgEncodingI e => Connection -> ChatMsgEvent e -> ConnOrGroupId -> CM (SndMessage, Int64, PQEncryption) -sendDirectMessage_ conn chatMsgEvent connOrGroupId = do - when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId - -- TODO move compressed body to SndMessage and compress in createSndMessage - (msgDeliveryId, pqEnc') <- deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId - pure (msg, msgDeliveryId, pqEnc') - -createSndMessage :: MsgEncodingI e => ChatMsgEvent e -> ConnOrGroupId -> CM SndMessage -createSndMessage chatMsgEvent connOrGroupId = - liftEither . runIdentity =<< lift (createSndMessages $ Identity (connOrGroupId, chatMsgEvent)) - -createSndMessages :: forall e t. (MsgEncodingI e, Traversable t) => t (ConnOrGroupId, ChatMsgEvent e) -> CM' (t (Either ChatError SndMessage)) -createSndMessages idsEvents = do - g <- asks random - vr <- chatVersionRange' - withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents - where - createMsg :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, ChatMsgEvent e) -> IO (Either ChatError SndMessage) - createMsg db g vr (connOrGroupId, evnt) = runExceptT $ do - withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage - where - encodeMessage sharedMsgId = - encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt} - -sendGroupMemberMessages :: forall e. MsgEncodingI e => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> CM () -sendGroupMemberMessages user conn events groupId = do - when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - let idsEvts = L.map (GroupId groupId,) events - (errs, msgs) <- lift $ partitionEithers . L.toList <$> createSndMessages idsEvts - unless (null errs) $ toView $ CRChatErrors (Just user) errs - forM_ (L.nonEmpty msgs) $ \msgs' -> - batchSendConnMessages user conn MsgFlags {notification = True} msgs' - -batchSendConnMessages :: User -> Connection -> MsgFlags -> NonEmpty SndMessage -> CM ([Either ChatError SndMessage], Maybe PQEncryption) -batchSendConnMessages user conn msgFlags msgs = - batchSendConnMessagesB user conn msgFlags $ L.map Right msgs - -batchSendConnMessagesB :: User -> Connection -> MsgFlags -> NonEmpty (Either ChatError SndMessage) -> CM ([Either ChatError SndMessage], Maybe PQEncryption) -batchSendConnMessagesB _user conn msgFlags msgs_ = do - let batched_ = batchSndMessagesJSON msgs_ - case L.nonEmpty batched_ of - Just batched' -> do - let msgReqs = L.map (fmap (msgBatchReq conn msgFlags)) batched' - delivered <- deliverMessagesB msgReqs - let msgs' = concat $ L.zipWith flattenMsgs batched' delivered - pqEnc = findLastPQEnc delivered - when (length msgs' /= length msgs_) $ logError "batchSendConnMessagesB: msgs_ and msgs' length mismatch" - pure (msgs', pqEnc) - Nothing -> pure ([], Nothing) - where - flattenMsgs :: Either ChatError MsgBatch -> Either ChatError ([Int64], PQEncryption) -> [Either ChatError SndMessage] - flattenMsgs (Right (MsgBatch _ sndMsgs)) (Right _) = map Right sndMsgs - flattenMsgs (Right (MsgBatch _ sndMsgs)) (Left ce) = replicate (length sndMsgs) (Left ce) - flattenMsgs (Left ce) _ = [Left ce] -- restore original ChatError - findLastPQEnc :: NonEmpty (Either ChatError ([Int64], PQEncryption)) -> Maybe PQEncryption - findLastPQEnc = foldr' (\x acc -> case x of Right (_, pqEnc) -> Just pqEnc; Left _ -> acc) Nothing - -batchSndMessagesJSON :: NonEmpty (Either ChatError SndMessage) -> [Either ChatError MsgBatch] -batchSndMessagesJSON = batchMessages maxEncodedMsgLength . L.toList - -msgBatchReq :: Connection -> MsgFlags -> MsgBatch -> ChatMsgReq -msgBatchReq conn msgFlags (MsgBatch batchBody sndMsgs) = (conn, msgFlags, batchBody, map (\SndMessage {msgId} -> msgId) sndMsgs) - -encodeConnInfo :: MsgEncodingI e => ChatMsgEvent e -> CM ByteString -encodeConnInfo chatMsgEvent = do - vr <- chatVersionRange - encodeConnInfoPQ PQSupportOff (maxVersion vr) chatMsgEvent - -encodeConnInfoPQ :: MsgEncodingI e => PQSupport -> VersionChat -> ChatMsgEvent e -> CM ByteString -encodeConnInfoPQ pqSup v chatMsgEvent = do - vr <- chatVersionRange - let info = ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent} - case encodeChatMessage maxEncodedInfoLength info of - ECMEncoded connInfo -> case pqSup of - PQSupportOn | v >= pqEncryptionCompressionVersion && B.length connInfo > maxCompressedInfoLength -> do - let connInfo' = compressedBatchMsgBody_ connInfo - when (B.length connInfo' > maxCompressedInfoLength) $ throwChatError $ CEException "large compressed info" - pure connInfo' - _ -> pure connInfo - ECMLarge -> throwChatError $ CEException "large info" - -deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption) -deliverMessage conn cmEventTag msgBody msgId = do - let msgFlags = MsgFlags {notification = hasNotification cmEventTag} - deliverMessage' conn msgFlags msgBody msgId - -deliverMessage' :: Connection -> MsgFlags -> MsgBody -> MessageId -> CM (Int64, PQEncryption) -deliverMessage' conn msgFlags msgBody msgId = - deliverMessages ((conn, msgFlags, msgBody, [msgId]) :| []) >>= \case - r :| [] -> case r of - Right ([deliveryId], pqEnc) -> pure (deliveryId, pqEnc) - Right (deliveryIds, _) -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 delivery id, got " <> show (length deliveryIds) - Left e -> throwError e - rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs) - --- [MessageId] - SndMessage ids inside MsgBatch, or single message id -type ChatMsgReq = (Connection, MsgFlags, MsgBody, [MessageId]) - -deliverMessages :: NonEmpty ChatMsgReq -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption))) -deliverMessages msgs = deliverMessagesB $ L.map Right msgs - -deliverMessagesB :: NonEmpty (Either ChatError ChatMsgReq) -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption))) -deliverMessagesB msgReqs = do - msgReqs' <- liftIO compressBodies - sent <- L.zipWith prepareBatch msgReqs' <$> withAgent (`sendMessagesB` snd (mapAccumL toAgent Nothing msgReqs')) - lift . void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent) - lift . withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent - where - compressBodies = - forME msgReqs $ \mr@(conn@Connection {pqSupport, connChatVersion = v}, msgFlags, msgBody, msgIds) -> - runExceptT $ case pqSupport of - -- we only compress messages when: - -- 1) PQ support is enabled - -- 2) version is compatible with compression - -- 3) message is longer than max compressed size (as this function is not used for batched messages anyway) - PQSupportOn | v >= pqEncryptionCompressionVersion && B.length msgBody > maxCompressedMsgLength -> do - let msgBody' = compressedBatchMsgBody_ msgBody - when (B.length msgBody' > maxCompressedMsgLength) $ throwError $ ChatError $ CEException "large compressed message" - pure (conn, msgFlags, msgBody', msgIds) - _ -> pure mr - toAgent prev = \case - Right (conn@Connection {connId, pqEncryption}, msgFlags, msgBody, _msgIds) -> - let cId = case prev of - Just prevId | prevId == connId -> "" - _ -> aConnId conn - in (Just connId, Right (cId, pqEncryption, msgFlags, msgBody)) - Left _ce -> (prev, Left (AP.INTERNAL "ChatError, skip")) -- as long as it is Left, the agent batchers should just step over it - prepareBatch (Right req) (Right ar) = Right (req, ar) - prepareBatch (Left ce) _ = Left ce -- restore original ChatError - prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae Nothing - createDelivery :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO (Either ChatError ([Int64], PQEncryption)) - createDelivery db ((Connection {connId}, _, _, msgIds), (agentMsgId, pqEnc')) = do - Right . (,pqEnc') <$> mapM (createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId})) msgIds - updatePQSndEnabled :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO () - updatePQSndEnabled db ((Connection {connId, pqSndEnabled}, _, _, _), (_, pqSndEnabled')) = - case (pqSndEnabled, pqSndEnabled') of - (Just b, b') | b' /= b -> updatePQ - (Nothing, PQEncOn) -> updatePQ - _ -> pure () - where - updatePQ = updateConnPQSndEnabled db connId pqSndEnabled' - -sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage -sendGroupMessage user gInfo members chatMsgEvent = do - sendGroupMessages user gInfo members (chatMsgEvent :| []) >>= \case - ((Right msg) :| [], _) -> pure msg - _ -> throwChatError $ CEInternalError "sendGroupMessage: expected 1 message" - -sendGroupMessage' :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage -sendGroupMessage' user gInfo members chatMsgEvent = - sendGroupMessages_ user gInfo members (chatMsgEvent :| []) >>= \case - ((Right msg) :| [], _) -> pure msg - _ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message" - -sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupMessages user gInfo members events = do - when shouldSendProfileUpdate $ - sendProfileUpdate `catchChatError` (toView . CRChatError (Just user)) - sendGroupMessages_ user gInfo members events - where - User {profile = p, userMemberProfileUpdatedAt} = user - GroupInfo {userMemberProfileSentAt} = gInfo - shouldSendProfileUpdate - | incognitoMembership gInfo = False - | otherwise = - case (userMemberProfileSentAt, userMemberProfileUpdatedAt) of - (Just lastSentTs, Just lastUpdateTs) -> lastSentTs < lastUpdateTs - (Nothing, Just _) -> True - _ -> False - sendProfileUpdate = do - let members' = filter (`supportsVersion` memberProfileUpdateVersion) members - profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p - void $ sendGroupMessage' user gInfo members' profileUpdateEvent - currentTs <- liftIO getCurrentTime - withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs - -data GroupSndResult = GroupSndResult - { sentTo :: [(GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption))], - pending :: [(GroupMemberId, Either ChatError MessageId, Either ChatError ())], - forwarded :: [GroupMember] - } - -sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupMessages_ _user gInfo@GroupInfo {groupId} members events = do - let idsEvts = L.map (GroupId groupId,) events - sndMsgs_ <- lift $ createSndMessages idsEvts - recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) - let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} - (toSendSeparate, toSendBatched, toPending, forwarded, _, dups) = - foldr' addMember ([], [], [], [], S.empty, 0 :: Int) recipientMembers - when (dups /= 0) $ logError $ "sendGroupMessages_: " <> tshow dups <> " duplicate members" - -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here - -- Deliver to toSend members - let (sendToMemIds, msgReqs) = prepareMsgReqs msgFlags sndMsgs_ toSendSeparate toSendBatched - delivered <- maybe (pure []) (fmap L.toList . deliverMessagesB) $ L.nonEmpty msgReqs - when (length delivered /= length sendToMemIds) $ logError "sendGroupMessages_: sendToMemIds and delivered length mismatch" - -- Save as pending for toPending members - let (pendingMemIds, pendingReqs) = preparePending sndMsgs_ toPending - stored <- lift $ withStoreBatch (\db -> map (bindRight $ createPendingMsg db) pendingReqs) - when (length stored /= length pendingMemIds) $ logError "sendGroupMessages_: pendingMemIds and stored length mismatch" - -- Zip for easier access to results - let sentTo = zipWith3 (\mId mReq r -> (mId, fmap (\(_, _, _, msgIds) -> msgIds) mReq, r)) sendToMemIds msgReqs delivered - pending = zipWith3 (\mId pReq r -> (mId, fmap snd pReq, r)) pendingMemIds pendingReqs stored - pure (sndMsgs_, GroupSndResult {sentTo, pending, forwarded}) - where - shuffleMembers :: [GroupMember] -> IO [GroupMember] - shuffleMembers ms = do - let (adminMs, otherMs) = partition isAdmin ms - liftM2 (<>) (shuffle adminMs) (shuffle otherMs) - where - isAdmin GroupMember {memberRole} = memberRole >= GRAdmin - addMember m acc@(toSendSeparate, toSendBatched, pending, forwarded, !mIds, !dups) = - case memberSendAction gInfo events members m of - Just a - | mId `S.member` mIds -> (toSendSeparate, toSendBatched, pending, forwarded, mIds, dups + 1) - | otherwise -> case a of - MSASend conn -> ((m, conn) : toSendSeparate, toSendBatched, pending, forwarded, mIds', dups) - MSASendBatched conn -> (toSendSeparate, (m, conn) : toSendBatched, pending, forwarded, mIds', dups) - MSAPending -> (toSendSeparate, toSendBatched, m : pending, forwarded, mIds', dups) - MSAForwarded -> (toSendSeparate, toSendBatched, pending, m : forwarded, mIds', dups) - Nothing -> acc - where - mId = groupMemberId' m - mIds' = S.insert mId mIds - prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> [(GroupMember, Connection)] -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq]) - prepareMsgReqs msgFlags msgs_ toSendSeparate toSendBatched = do - let batched_ = batchSndMessagesJSON msgs_ - case L.nonEmpty batched_ of - Just batched' -> do - let (memsSep, mreqsSep) = foldr' foldMsgs ([], []) toSendSeparate - (memsBtch, mreqsBtch) = foldr' (foldBatches batched') ([], []) toSendBatched - (memsSep <> memsBtch, mreqsSep <> mreqsBtch) - Nothing -> ([], []) - where - foldMsgs :: (GroupMember, Connection) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) - foldMsgs (GroupMember {groupMemberId}, conn) memIdsReqs = - foldr' (\msg_ (memIds, reqs) -> (groupMemberId : memIds, fmap sndMessageReq msg_ : reqs)) memIdsReqs msgs_ - where - sndMessageReq :: SndMessage -> ChatMsgReq - sndMessageReq SndMessage {msgId, msgBody} = (conn, msgFlags, msgBody, [msgId]) - foldBatches :: NonEmpty (Either ChatError MsgBatch) -> (GroupMember, Connection) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) - foldBatches batched' (GroupMember {groupMemberId}, conn) memIdsReqs = - foldr' (\batch_ (memIds, reqs) -> (groupMemberId : memIds, fmap (msgBatchReq conn msgFlags) batch_ : reqs)) memIdsReqs batched' - preparePending :: NonEmpty (Either ChatError SndMessage) -> [GroupMember] -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) - preparePending msgs_ = - foldr' foldMsgs ([], []) - where - foldMsgs :: GroupMember -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) - foldMsgs GroupMember {groupMemberId} memIdsReqs = - foldr' (\msg_ (memIds, reqs) -> (groupMemberId : memIds, fmap pendingReq msg_ : reqs)) memIdsReqs msgs_ - where - pendingReq :: SndMessage -> (GroupMemberId, MessageId) - pendingReq SndMessage {msgId} = (groupMemberId, msgId) - createPendingMsg :: DB.Connection -> (GroupMemberId, MessageId) -> IO (Either ChatError ()) - createPendingMsg db (groupMemberId, msgId) = - createPendingGroupMessage db groupMemberId msgId Nothing $> Right () - -data MemberSendAction = MSASend Connection | MSASendBatched Connection | MSAPending | MSAForwarded - -memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction -memberSendAction gInfo events members m@GroupMember {memberRole} = case memberConn m of - Nothing -> pendingOrForwarded - Just conn@Connection {connStatus} - | connDisabled conn || connStatus == ConnDeleted -> Nothing - | connInactive conn -> Just MSAPending - | connStatus == ConnSndReady || connStatus == ConnReady -> sendBatchedOrSeparate conn - | otherwise -> pendingOrForwarded - where - sendBatchedOrSeparate conn - -- admin doesn't support batch forwarding - send messages separately so that admin can forward one by one - | memberRole >= GRAdmin && not (m `supportsVersion` batchSend2Version) = Just (MSASend conn) - -- either member is not admin, or admin supports batched forwarding - | otherwise = Just (MSASendBatched conn) - pendingOrForwarded = case memberCategory m of - GCUserMember -> Nothing -- shouldn't happen - GCInviteeMember -> Just MSAPending - GCHostMember -> Just MSAPending - GCPreMember -> forwardSupportedOrPending (invitedByGroupMemberId $ membership gInfo) - GCPostMember -> forwardSupportedOrPending (invitedByGroupMemberId m) - where - forwardSupportedOrPending invitingMemberId_ - | membersSupport && all isForwardedGroupMsg events = Just MSAForwarded - | any isXGrpMsgForward events = Nothing - | otherwise = Just MSAPending - where - membersSupport = - m `supportsVersion` groupForwardVersion && invitingMemberSupportsForward - invitingMemberSupportsForward = case invitingMemberId_ of - Just invMemberId -> - -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember - case find (\m' -> groupMemberId' m' == invMemberId) members of - Just invitingMember -> invitingMember `supportsVersion` groupForwardVersion - Nothing -> False - Nothing -> False - isXGrpMsgForward event = case event of - XGrpMsgForward {} -> True - _ -> False - -sendGroupMemberMessage :: MsgEncodingI e => User -> GroupInfo -> GroupMember -> ChatMsgEvent e -> Maybe Int64 -> CM () -> CM () -sendGroupMemberMessage user gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} chatMsgEvent introId_ postDeliver = do - msg <- createSndMessage chatMsgEvent (GroupId groupId) - messageMember msg `catchChatError` (toView . CRChatError (Just user)) - where - messageMember :: SndMessage -> CM () - messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case - MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver - MSASendBatched conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver - MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ - MSAForwarded -> pure () - --- TODO ensure order - pending messages interleave with user input messages -sendPendingGroupMessages :: User -> GroupMember -> Connection -> CM () -sendPendingGroupMessages user GroupMember {groupMemberId} conn = do - pgms <- withStore' $ \db -> getPendingGroupMessages db groupMemberId - forM_ (L.nonEmpty pgms) $ \pgms' -> do - let msgs = L.map (\(sndMsg, _, _) -> sndMsg) pgms' - void $ batchSendConnMessages user conn MsgFlags {notification = True} msgs - lift . void . withStoreBatch' $ \db -> L.map (\SndMessage {msgId} -> deletePendingGroupMessage db groupMemberId msgId) msgs - lift . void . withStoreBatch' $ \db -> L.map (\(_, tag, introId_) -> updateIntro_ db tag introId_) pgms' - where - updateIntro_ :: DB.Connection -> ACMEventTag -> Maybe Int64 -> IO () - updateIntro_ db tag introId_ = case (tag, introId_) of - (ACMEventTag _ XGrpMemFwd_, Just introId) -> updateIntroStatus db introId GMIntroInvForwarded - _ -> pure () - -saveDirectRcvMSG :: MsgEncodingI e => Connection -> MsgMeta -> MsgBody -> ChatMessage e -> CM (Connection, RcvMessage) -saveDirectRcvMSG conn@Connection {connId} agentMsgMeta msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do - conn' <- updatePeerChatVRange conn chatVRange - let agentMsgId = fst $ recipient agentMsgMeta - newMsg = NewRcvMessage {chatMsgEvent, msgBody} - rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} - msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing - pure (conn', msg) - -saveGroupRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> MsgBody -> ChatMessage e -> CM (GroupMember, Connection, RcvMessage) -saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do - (am'@GroupMember {memberId = amMemId, groupMemberId = amGroupMemId}, conn') <- updateMemberChatVRange authorMember conn chatVRange - let agentMsgId = fst $ recipient agentMsgMeta - newMsg = NewRcvMessage {chatMsgEvent, msgBody} - rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} - msg <- - withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery $ Just amGroupMemId) - `catchChatError` \e -> case e of - ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do - vr <- chatVersionRange - fm <- withStore $ \db -> getGroupMember db vr user groupId forwardedByGroupMemberId - forM_ (memberConn fm) $ \fmConn -> - void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemId) groupId - throwError e - _ -> throwError e - pure (am', conn', msg) - -saveGroupFwdRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> GroupMember -> MsgBody -> ChatMessage e -> CM RcvMessage -saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {memberId = refMemberId} msgBody ChatMessage {msgId = sharedMsgId_, chatMsgEvent} = do - let newMsg = NewRcvMessage {chatMsgEvent, msgBody} - fwdMemberId = Just $ groupMemberId' forwardingMember - refAuthorId = Just $ groupMemberId' refAuthorMember - withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId) - `catchChatError` \e -> case e of - ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do - vr <- chatVersionRange - am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db vr user groupId authorGroupMemberId - if sameMemberId refMemberId am - then forM_ (memberConn forwardingMember) $ \fmConn -> - void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemberId) groupId - else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id" - throwError e - _ -> throwError e - -saveSndChatItem :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> CM (ChatItem c 'MDSnd) -saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing Nothing False - -saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd) -saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live = - saveSndChatItems user cd [Right NewSndChatItemData {msg, content, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case - [Right ci] -> pure ci - _ -> throwChatError $ CEInternalError "saveSndChatItem': expected 1 item" - -data NewSndChatItemData c = NewSndChatItemData - { msg :: SndMessage, - content :: CIContent 'MDSnd, - ciFile :: Maybe (CIFile 'MDSnd), - quotedItem :: Maybe (CIQuote c), - itemForwarded :: Maybe CIForwardedFrom - } - -saveSndChatItems :: - forall c. - ChatTypeI c => - User -> - ChatDirection c 'MDSnd -> - [Either ChatError (NewSndChatItemData c)] -> - Maybe CITimed -> - Bool -> - CM [Either ChatError (ChatItem c 'MDSnd)] -saveSndChatItems user cd itemsData itemTimed live = do - createdAt <- liftIO getCurrentTime - when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $ - withStore' (\db -> updateChatTs db user cd createdAt) - lift $ withStoreBatch (\db -> map (bindRight $ createItem db createdAt) itemsData) - where - createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd)) - createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, ciFile, quotedItem, itemForwarded} = do - ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt - forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt - pure $ Right $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live createdAt Nothing createdAt - -saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> CM (ChatItem c 'MDRcv) -saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content = - saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False - -saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDRcv) -saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do - createdAt <- liftIO getCurrentTime - (ciId, quotedItem, itemForwarded) <- withStore' $ \db -> do - when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt - r@(ciId, _, _) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt - forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt - pure r - pure $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live brokerTs forwardedByMember createdAt - -mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d -mkChatItem cd ciId content file quotedItem sharedMsgId itemForwarded itemTimed live itemTs forwardedByMember currentTs = - let itemText = ciContentToText content - itemStatus = ciCreateStatus content - meta = mkCIMeta ciId content itemText itemStatus Nothing sharedMsgId itemForwarded Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByMember currentTs currentTs - in ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} - -deleteDirectCIs :: User -> Contact -> [CChatItem 'CTDirect] -> Bool -> Bool -> CM ChatResponse -deleteDirectCIs user ct items byUser timed = do - let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items - deleteCIFiles user ciFilesInfo - (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure $ CRChatItemsDeleted user deletions byUser timed - where - deleteItem db (CChatItem md ci) = do - deleteDirectChatItem db user ct ci - pure $ contactDeletion md ct ci Nothing - -deleteGroupCIs :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> CM ChatResponse -deleteGroupCIs user gInfo items byUser timed byGroupMember_ deletedTs = do - let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items - deleteCIFiles user ciFilesInfo - (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure $ CRChatItemsDeleted user deletions byUser timed - where - deleteItem :: DB.Connection -> CChatItem 'CTGroup -> IO ChatItemDeletion - deleteItem db (CChatItem md ci) = do - ci' <- case byGroupMember_ of - Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs - Nothing -> Nothing <$ deleteGroupChatItem db user gInfo ci - pure $ groupDeletion md gInfo ci ci' - -deleteLocalCIs :: User -> NoteFolder -> [CChatItem 'CTLocal] -> Bool -> Bool -> CM ChatResponse -deleteLocalCIs user nf items byUser timed = do - let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items - deleteFilesLocally ciFilesInfo - (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure $ CRChatItemsDeleted user deletions byUser timed - where - deleteItem db (CChatItem md ci) = do - deleteLocalChatItem db user nf ci - pure $ ChatItemDeletion (nfItem md ci) Nothing - nfItem :: MsgDirectionI d => SMsgDirection d -> ChatItem 'CTLocal d -> AChatItem - nfItem md = AChatItem SCTLocal md (LocalChat nf) - -deleteCIFiles :: User -> [CIFileInfo] -> CM () -deleteCIFiles user filesInfo = do - cancelFilesInProgress user filesInfo - deleteFilesLocally filesInfo - -markDirectCIsDeleted :: User -> Contact -> [CChatItem 'CTDirect] -> Bool -> UTCTime -> CM ChatResponse -markDirectCIsDeleted user ct items byUser deletedTs = do - let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items - cancelFilesInProgress user ciFilesInfo - (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (markDeleted db) items) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure $ CRChatItemsDeleted user deletions byUser False - where - markDeleted db (CChatItem md ci) = do - ci' <- markDirectChatItemDeleted db user ct ci deletedTs - pure $ contactDeletion md ct ci (Just ci') - -markGroupCIsDeleted :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> Maybe GroupMember -> UTCTime -> CM ChatResponse -markGroupCIsDeleted user gInfo items byUser byGroupMember_ deletedTs = do - let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items - cancelFilesInProgress user ciFilesInfo - (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (markDeleted db) items) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure $ CRChatItemsDeleted user deletions byUser False - where - markDeleted db (CChatItem md ci) = do - ci' <- markGroupChatItemDeleted db user gInfo ci byGroupMember_ deletedTs - pure $ groupDeletion md gInfo ci (Just ci') - -groupDeletion :: MsgDirectionI d => SMsgDirection d -> GroupInfo -> ChatItem 'CTGroup d -> Maybe (ChatItem 'CTGroup d) -> ChatItemDeletion -groupDeletion md g ci ci' = ChatItemDeletion (gItem ci) (gItem <$> ci') - where - gItem = AChatItem SCTGroup md (GroupChat g) - -contactDeletion :: MsgDirectionI d => SMsgDirection d -> Contact -> ChatItem 'CTDirect d -> Maybe (ChatItem 'CTDirect d) -> ChatItemDeletion -contactDeletion md ct ci ci' = ChatItemDeletion (ctItem ci) (ctItem <$> ci') - where - ctItem = AChatItem SCTDirect md (DirectChat ct) - -createAgentConnectionAsync :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> CM (CommandId, ConnId) -createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do - cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction - connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode - pure (cmdId, connId) - -joinAgentConnectionAsync :: User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId) -joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do - cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn - connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo PQSupportOff subMode - pure (cmdId, connId) - -allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM () -allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersion} confId msg = do - cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn - dm <- encodeConnInfoPQ pqSupport connChatVersion msg - withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm - withStore' $ \db -> updateConnectionStatus db conn ConnAccepted - -agentAcceptContactAsync :: MsgEncodingI e => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> PQSupport -> VersionChat -> CM (CommandId, ConnId) -agentAcceptContactAsync user enableNtfs invId msg subMode pqSup chatV = do - cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact - dm <- encodeConnInfoPQ pqSup chatV msg - connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pqSup subMode - pure (cmdId, connId) - -deleteAgentConnectionAsync :: User -> ConnId -> CM () -deleteAgentConnectionAsync user acId = deleteAgentConnectionAsync' user acId False - -deleteAgentConnectionAsync' :: User -> ConnId -> Bool -> CM () -deleteAgentConnectionAsync' user acId waitDelivery = do - withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchChatError` (toView . CRChatError (Just user)) - -deleteAgentConnectionsAsync :: User -> [ConnId] -> CM () -deleteAgentConnectionsAsync user acIds = deleteAgentConnectionsAsync' user acIds False - -deleteAgentConnectionsAsync' :: User -> [ConnId] -> Bool -> CM () -deleteAgentConnectionsAsync' _ [] _ = pure () -deleteAgentConnectionsAsync' user acIds waitDelivery = do - withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchChatError` (toView . CRChatError (Just user)) - -agentXFTPDeleteRcvFile :: RcvFileId -> FileTransferId -> CM () -agentXFTPDeleteRcvFile aFileId fileId = do - lift $ withAgent' (`xftpDeleteRcvFile` aFileId) - withStore' $ \db -> setRcvFTAgentDeleted db fileId - -agentXFTPDeleteRcvFiles :: [(XFTPRcvFile, FileTransferId)] -> CM' () -agentXFTPDeleteRcvFiles rcvFiles = do - let rcvFiles' = filter (not . agentRcvFileDeleted . fst) rcvFiles - rfIds = mapMaybe fileIds rcvFiles' - withAgent' $ \a -> xftpDeleteRcvFiles a (map fst rfIds) - void . withStoreBatch' $ \db -> map (setRcvFTAgentDeleted db . snd) rfIds - where - fileIds :: (XFTPRcvFile, FileTransferId) -> Maybe (RcvFileId, FileTransferId) - fileIds (XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId)}, fileId) = Just (aFileId, fileId) - fileIds _ = Nothing - -agentXFTPDeleteSndFileRemote :: User -> XFTPSndFile -> FileTransferId -> CM' () -agentXFTPDeleteSndFileRemote user xsf fileId = - agentXFTPDeleteSndFilesRemote user [(xsf, fileId)] - -agentXFTPDeleteSndFilesRemote :: User -> [(XFTPSndFile, FileTransferId)] -> CM' () -agentXFTPDeleteSndFilesRemote user sndFiles = do - (_errs, redirects) <- partitionEithers <$> withStoreBatch' (\db -> map (lookupFileTransferRedirectMeta db user . snd) sndFiles) - let redirects' = mapMaybe mapRedirectMeta $ concat redirects - sndFilesAll = redirects' <> sndFiles - sndFilesAll' = filter (not . agentSndFileDeleted . fst) sndFilesAll - -- while file is being prepared and uploaded, it would not have description available; - -- this partitions files into those with and without descriptions - - -- files with description are deleted remotely, files without description are deleted internally - (sfsNoDescr, sfsWithDescr) <- partitionSndDescr sndFilesAll' [] [] - withAgent' $ \a -> xftpDeleteSndFilesInternal a sfsNoDescr - withAgent' $ \a -> xftpDeleteSndFilesRemote a (aUserId user) sfsWithDescr - void . withStoreBatch' $ \db -> map (setSndFTAgentDeleted db user . snd) sndFilesAll' - where - mapRedirectMeta :: FileTransferMeta -> Maybe (XFTPSndFile, FileTransferId) - mapRedirectMeta FileTransferMeta {fileId = fileId, xftpSndFile = Just sndFileRedirect} = Just (sndFileRedirect, fileId) - mapRedirectMeta _ = Nothing - partitionSndDescr :: - [(XFTPSndFile, FileTransferId)] -> - [SndFileId] -> - [(SndFileId, ValidFileDescription 'FSender)] -> - CM' ([SndFileId], [(SndFileId, ValidFileDescription 'FSender)]) - partitionSndDescr [] filesWithoutDescr filesWithDescr = pure (filesWithoutDescr, filesWithDescr) - partitionSndDescr ((XFTPSndFile {agentSndFileId = AgentSndFileId aFileId, privateSndFileDescr}, _) : xsfs) filesWithoutDescr filesWithDescr = - case privateSndFileDescr of - Nothing -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr - Just sfdText -> - tryChatError' (parseFileDescription sfdText) >>= \case - Left _ -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr - Right sfd -> partitionSndDescr xsfs filesWithoutDescr ((aFileId, sfd) : filesWithDescr) - -userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Bool -> Profile -userProfileToSend user@User {profile = p} incognitoProfile ct inGroup = do - let p' = fromMaybe (fromLocalProfile p) incognitoProfile - if inGroup - then redactedMemberProfile p' - else - let userPrefs = maybe (preferences' user) (const Nothing) incognitoProfile - in (p' :: Profile) {preferences = Just . toChatPrefs $ mergePreferences (userPreferences <$> ct) userPrefs} - -createRcvFeatureItems :: User -> Contact -> Contact -> CM' () -createRcvFeatureItems user ct ct' = - createFeatureItems user ct ct' CDDirectRcv CIRcvChatFeature CIRcvChatPreference contactPreference - -createSndFeatureItems :: User -> Contact -> Contact -> CM' () -createSndFeatureItems user ct ct' = - createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref - where - getPref ContactUserPreference {userPreference} = case userPreference of - CUPContact {preference} -> preference - CUPUser {preference} -> preference - -createContactsSndFeatureItems :: User -> [ChangedProfileContact] -> CM' () -createContactsSndFeatureItems user cts = - createContactsFeatureItems user cts' CDDirectSnd CISndChatFeature CISndChatPreference getPref - where - cts' = map (\ChangedProfileContact {ct, ct'} -> (ct, ct')) cts - getPref ContactUserPreference {userPreference} = case userPreference of - CUPContact {preference} -> preference - CUPUser {preference} -> preference - -type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d - -createFeatureItems :: - MsgDirectionI d => - User -> - Contact -> - Contact -> - (Contact -> ChatDirection 'CTDirect d) -> - FeatureContent PrefEnabled d -> - FeatureContent FeatureAllowed d -> - (forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) -> - CM' () -createFeatureItems user ct ct' = createContactsFeatureItems user [(ct, ct')] - -createContactsFeatureItems :: - forall d. - MsgDirectionI d => - User -> - [(Contact, Contact)] -> - (Contact -> ChatDirection 'CTDirect d) -> - FeatureContent PrefEnabled d -> - FeatureContent FeatureAllowed d -> - (forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) -> - CM' () -createContactsFeatureItems user cts chatDir ciFeature ciOffer getPref = do - let dirsCIContents = map contactChangedFeatures cts - (errs, acis) <- partitionEithers <$> createInternalItemsForChats user Nothing dirsCIContents - unless (null errs) $ toView' $ CRChatErrors (Just user) errs - toView' $ CRNewChatItems user acis - where - contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, [CIContent d]) - contactChangedFeatures (Contact {mergedPreferences = cups}, ct'@Contact {mergedPreferences = cups'}) = do - let contents = mapMaybe (\(ACF f) -> featureCIContent_ f) allChatFeatures - (chatDir ct', contents) - where - featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d) - featureCIContent_ f - | state /= state' = Just $ fContent ciFeature state' - | prefState /= prefState' = Just $ fContent ciOffer prefState' - | otherwise = Nothing - where - fContent :: FeatureContent a d -> (a, Maybe Int) -> CIContent d - fContent ci (s, param) = ci f' s param - f' = chatFeature f - state = featureState cup - state' = featureState cup' - prefState = preferenceState $ getPref cup - prefState' = preferenceState $ getPref cup' - cup = getContactUserPreference f cups - cup' = getContactUserPreference f cups' - -createGroupFeatureChangedItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> GroupInfo -> CM () -createGroupFeatureChangedItems user cd ciContent GroupInfo {fullGroupPreferences = gps} GroupInfo {fullGroupPreferences = gps'} = - forM_ allGroupFeatures $ \(AGF f) -> do - let state = groupFeatureState $ getGroupPreference f gps - pref' = getGroupPreference f gps' - state'@(_, param', role') = groupFeatureState pref' - when (state /= state') $ - createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref') param' role') Nothing - -sameGroupProfileInfo :: GroupProfile -> GroupProfile -> Bool -sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferences = Nothing} - -createGroupFeatureItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM () -createGroupFeatureItems user cd ciContent GroupInfo {fullGroupPreferences} = - forM_ allGroupFeatures $ \(AGF f) -> do - let p = getGroupPreference f fullGroupPreferences - (_, param, role) = groupFeatureState p - createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing - -createInternalChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> CM () -createInternalChatItem user cd content itemTs_ = - lift (createInternalItemsForChats user itemTs_ [(cd, [content])]) >>= \case - [Right aci] -> toView $ CRNewChatItems user [aci] - [Left e] -> throwError e - rs -> throwChatError $ CEInternalError $ "createInternalChatItem: expected 1 result, got " <> show (length rs) - -createInternalItemsForChats :: - forall c d. - (ChatTypeI c, MsgDirectionI d) => - User -> - Maybe UTCTime -> - [(ChatDirection c d, [CIContent d])] -> - CM' [Either ChatError AChatItem] -createInternalItemsForChats user itemTs_ dirsCIContents = do - createdAt <- liftIO getCurrentTime - let itemTs = fromMaybe createdAt itemTs_ - void . withStoreBatch' $ \db -> map (uncurry $ updateChat db createdAt) dirsCIContents - withStoreBatch' $ \db -> concatMap (uncurry $ createACIs db itemTs createdAt) dirsCIContents - where - updateChat :: DB.Connection -> UTCTime -> ChatDirection c d -> [CIContent d] -> IO () - updateChat db createdAt cd contents - | any ciRequiresAttention contents || contactChatDeleted cd = updateChatTs db user cd createdAt - | otherwise = pure () - createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem] - createACIs db itemTs createdAt cd = map $ \content -> do - ciId <- createNewChatItemNoMsg db user cd content itemTs createdAt - let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False itemTs Nothing createdAt - pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci - -createLocalChatItems :: - User -> - ChatDirection 'CTLocal 'MDSnd -> - [(CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom)] -> - UTCTime -> - CM [ChatItem 'CTLocal 'MDSnd] -createLocalChatItems user cd itemsData createdAt = do - withStore' $ \db -> updateChatTs db user cd createdAt - (errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) itemsData) - unless (null errs) $ toView $ CRChatErrors (Just user) errs - pure items - where - createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom) -> IO (ChatItem 'CTLocal 'MDSnd) - createItem db (content, ciFile, itemForwarded) = do - ciId <- createNewChatItem_ db user cd Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False createdAt Nothing createdAt - forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt - pure $ mkChatItem cd ciId content ciFile Nothing Nothing itemForwarded Nothing False createdAt Nothing createdAt - -withUser' :: (User -> CM ChatResponse) -> CM ChatResponse -withUser' action = - asks currentUser - >>= readTVarIO - >>= maybe (throwChatError CENoActiveUser) run - where - run u = action u `catchChatError` (pure . CRChatCmdError (Just u)) - -withUser :: (User -> CM ChatResponse) -> CM ChatResponse -withUser action = withUser' $ \user -> - ifM (lift chatStarted) (action user) (throwChatError CEChatNotStarted) - -withUser_ :: CM ChatResponse -> CM ChatResponse -withUser_ = withUser . const - -withUserId' :: UserId -> (User -> CM ChatResponse) -> CM ChatResponse -withUserId' userId action = withUser' $ \user -> do - checkSameUser userId user - action user - -withUserId :: UserId -> (User -> CM ChatResponse) -> CM ChatResponse -withUserId userId action = withUser $ \user -> do - checkSameUser userId user - action user - -checkSameUser :: UserId -> User -> CM () -checkSameUser userId User {userId = activeUserId} = when (userId /= activeUserId) $ throwChatError (CEDifferentActiveUser userId activeUserId) - -chatStarted :: CM' Bool -chatStarted = fmap isJust . readTVarIO =<< asks agentAsync - -waitChatStartedAndActivated :: CM' () -waitChatStartedAndActivated = do - agentStarted <- asks agentAsync - chatActivated <- asks chatActivated - atomically $ do - started <- readTVar agentStarted - activated <- readTVar chatActivated - unless (isJust started && activated) retry - -chatVersionRange :: CM VersionRangeChat -chatVersionRange = lift chatVersionRange' -{-# INLINE chatVersionRange #-} - -chatVersionRange' :: CM' VersionRangeChat -chatVersionRange' = do - ChatConfig {chatVRange} <- asks config - pure chatVRange -{-# INLINE chatVersionRange' #-} - -chatCommandP :: Parser ChatCommand -chatCommandP = - choice - [ "/mute " *> ((`SetShowMessages` MFNone) <$> chatNameP), - "/unmute " *> ((`SetShowMessages` MFAll) <$> chatNameP), - "/unmute mentions " *> ((`SetShowMessages` MFMentions) <$> chatNameP), - "/receipts " *> (SetSendReceipts <$> chatNameP <* " " <*> ((Just <$> onOffP) <|> ("default" $> Nothing))), - "/block #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False), - "/unblock #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True), - "/_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 contacts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings), - "/set receipts contacts " *> (SetUserContactReceipts <$> receiptSettings), - "/_set receipts groups " *> (APISetUserGroupReceipts <$> A.decimal <* A.space <*> receiptSettings), - "/set receipts groups " *> (SetUserGroupReceipts <$> receiptSettings), - "/_hide user " *> (APIHideUser <$> A.decimal <* A.space <*> jsonP), - "/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP), - "/_mute user " *> (APIMuteUser <$> A.decimal), - "/_unmute user " *> (APIUnmuteUser <$> A.decimal), - "/hide user " *> (HideUser <$> pwdP), - "/unhide user " *> (UnhideUser <$> pwdP), - "/mute user" $> MuteUser, - "/unmute user" $> UnmuteUser, - "/_delete user " *> (APIDeleteUser <$> A.decimal <* " del_smp=" <*> onOffP <*> optional (A.space *> jsonP)), - "/delete user " *> (DeleteUser <$> displayName <*> pure True <*> optional (A.space *> pwdP)), - ("/user" <|> "/u") $> ShowActiveUser, - "/_start " *> do - mainApp <- "main=" *> onOffP - enableSndFiles <- " snd_files=" *> onOffP <|> pure mainApp - pure StartChat {mainApp, enableSndFiles}, - "/_start" $> StartChat True True, - "/_check running" $> CheckChatRunning, - "/_stop" $> APIStopChat, - "/_app activate restore=" *> (APIActivateChat <$> onOffP), - "/_app activate" $> APIActivateChat True, - "/_app suspend " *> (APISuspendChat <$> A.decimal), - "/_resubscribe all" $> ResubscribeAllConnections, - -- deprecated, use /set file paths - "/_temp_folder " *> (SetTempFolder <$> filePath), - -- /_files_folder deprecated, use /set file paths - ("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath), - -- deprecated, use /set file paths - "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath), - "/set file paths " *> (APISetAppFilePaths <$> jsonP), - "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), - "/contact_merge " *> (SetContactMergeEnabled <$> onOffP), - "/_db export " *> (APIExportArchive <$> jsonP), - "/db export" $> ExportArchive, - "/_db import " *> (APIImportArchive <$> jsonP), - "/_db delete" $> APIDeleteStorage, - "/_db encryption " *> (APIStorageEncryption <$> jsonP), - "/db encrypt " *> (APIStorageEncryption . dbEncryptionConfig "" <$> dbKeyP), - "/db key " *> (APIStorageEncryption <$> (dbEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)), - "/db decrypt " *> (APIStorageEncryption . (`dbEncryptionConfig` "") <$> dbKeyP), - "/db test key " *> (TestStorageEncryption <$> dbKeyP), - "/_save app settings" *> (APISaveAppSettings <$> jsonP), - "/_get app settings" *> (APIGetAppSettings <$> optional (A.space *> jsonP)), - "/sql chat " *> (ExecChatStoreSQL <$> textP), - "/sql agent " *> (ExecAgentStoreSQL <$> textP), - "/sql slow" $> SlowSQLQueries, - "/_get chats " - *> ( APIGetChats - <$> A.decimal - <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False) - <*> (A.space *> paginationByTimeP <|> pure (PTLast 5000)) - <*> (A.space *> jsonP <|> pure clqNoFilters) - ), - "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), - "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)), - "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal), - "/_send " *> (APISendMessages <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), - "/_create *" *> (APICreateChatItems <$> A.decimal <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), - "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), - "/_delete item " *> (APIDeleteChatItem <$> chatRefP <*> _strP <* A.space <*> ciDeleteMode), - "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <*> _strP), - "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP), - "/_reaction members " *> (APIGetReactionMembers <$> A.decimal <* " #" <*> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP), - "/_forward plan " *> (APIPlanForwardChatItems <$> chatRefP <*> _strP), - "/_forward " *> (APIForwardChatItems <$> chatRefP <* A.space <*> chatRefP <*> _strP <*> sendMessageTTLP), - "/_read user " *> (APIUserRead <$> A.decimal), - "/read user" $> UserRead, - "/_read chat " *> (APIChatRead <$> chatRefP), - "/_read chat items " *> (APIChatItemsRead <$> chatRefP <*> _strP), - "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), - "/_delete " *> (APIDeleteChat <$> chatRefP <*> chatDeleteMode), - "/_clear chat " *> (APIClearChat <$> chatRefP), - "/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal), - "/_reject " *> (APIRejectContact <$> A.decimal), - "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP), - "/call " *> char_ '@' *> (SendCallInvitation <$> displayName <*> pure defaultCallType), - "/_call reject @" *> (APIRejectCall <$> A.decimal), - "/_call offer @" *> (APISendCallOffer <$> A.decimal <* A.space <*> jsonP), - "/_call answer @" *> (APISendCallAnswer <$> A.decimal <* A.space <*> jsonP), - "/_call extra @" *> (APISendCallExtraInfo <$> A.decimal <* A.space <*> jsonP), - "/_call end @" *> (APIEndCall <$> A.decimal), - "/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP), - "/_call get" $> APIGetCallInvitations, - "/_network_statuses" $> APIGetNetworkStatuses, - "/_profile " *> (APIUpdateProfile <$> A.decimal <* A.space <*> jsonP), - "/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")), - "/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")), - "/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP), - "/_set theme user " *> (APISetUserUIThemes <$> A.decimal <*> optional (A.space *> jsonP)), - "/_set theme " *> (APISetChatUIThemes <$> chatRefP <*> optional (A.space *> jsonP)), - "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString), - "/_ntf get" $> APIGetNtfToken, - "/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP), - "/_ntf verify " *> (APIVerifyToken <$> strP <* A.space <*> strP <* A.space <*> strP), - "/_ntf delete " *> (APIDeleteToken <$> strP), - "/_ntf conns " *> (APIGetNtfConns <$> strP <* A.space <*> strP), - "/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP), - "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), - "/_join #" *> (APIJoinGroup <$> A.decimal), - "/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole), - "/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP), - "/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal), - "/_leave #" *> (APILeaveGroup <$> A.decimal), - "/_members #" *> (APIListMembers <$> A.decimal), - "/_server test " *> (APITestProtoServer <$> A.decimal <* A.space <*> strP), - "/smp test " *> (TestProtoServer . AProtoServerWithAuth SPSMP <$> strP), - "/xftp test " *> (TestProtoServer . AProtoServerWithAuth SPXFTP <$> strP), - "/ntf test " *> (TestProtoServer . AProtoServerWithAuth SPNTF <$> strP), - "/smp " *> (SetUserProtoServers (AProtocolType SPSMP) . map (AProtoServerWithAuth SPSMP) <$> protocolServersP), - "/xftp " *> (SetUserProtoServers (AProtocolType SPXFTP) . map (AProtoServerWithAuth SPXFTP) <$> protocolServersP), - "/smp" $> GetUserProtoServers (AProtocolType SPSMP), - "/xftp" $> GetUserProtoServers (AProtocolType SPXFTP), - "/_operators" $> APIGetServerOperators, - "/_operators " *> (APISetServerOperators <$> jsonP), - "/operators " *> (SetServerOperators . L.fromList <$> operatorRolesP `A.sepBy1` A.char ','), - "/_servers " *> (APIGetUserServers <$> A.decimal), - "/_servers " *> (APISetUserServers <$> A.decimal <* A.space <*> jsonP), - "/_validate_servers " *> (APIValidateServers <$> A.decimal <* A.space <*> jsonP), - "/_conditions" $> APIGetUsageConditions, - "/_conditions_notified " *> (APISetConditionsNotified <$> A.decimal), - "/_accept_conditions " *> (APIAcceptConditions <$> A.decimal <*> _strP), - "/_ttl " *> (APISetChatItemTTL <$> A.decimal <* A.space <*> ciTTLDecimal), - "/ttl " *> (SetChatItemTTL <$> ciTTL), - "/_ttl " *> (APIGetChatItemTTL <$> A.decimal), - "/ttl" $> GetChatItemTTL, - "/_network info " *> (APISetNetworkInfo <$> jsonP), - "/_network " *> (APISetNetworkConfig <$> jsonP), - ("/network " <|> "/net ") *> (SetNetworkConfig <$> netCfgP), - ("/network" <|> "/net") $> APIGetNetworkConfig, - "/reconnect " *> (ReconnectServer <$> A.decimal <* A.space <*> strP), - "/reconnect" $> ReconnectAllServers, - "/_settings " *> (APISetChatSettings <$> chatRefP <* A.space <*> jsonP), - "/_member settings #" *> (APISetMemberSettings <$> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP), - "/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal), - "/_info #" *> (APIGroupInfo <$> A.decimal), - "/_info @" *> (APIContactInfo <$> A.decimal), - ("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* char_ '@' <*> displayName), - ("/info #" <|> "/i #") *> (ShowGroupInfo <$> displayName), - ("/info " <|> "/i ") *> char_ '@' *> (ContactInfo <$> displayName), - "/_queue info #" *> (APIGroupMemberQueueInfo <$> A.decimal <* A.space <*> A.decimal), - "/_queue info @" *> (APIContactQueueInfo <$> A.decimal), - ("/queue info #" <|> "/qi #") *> (GroupMemberQueueInfo <$> displayName <* A.space <* char_ '@' <*> displayName), - ("/queue info " <|> "/qi ") *> char_ '@' *> (ContactQueueInfo <$> displayName), - "/_switch #" *> (APISwitchGroupMember <$> A.decimal <* A.space <*> A.decimal), - "/_switch @" *> (APISwitchContact <$> A.decimal), - "/_abort switch #" *> (APIAbortSwitchGroupMember <$> A.decimal <* A.space <*> A.decimal), - "/_abort switch @" *> (APIAbortSwitchContact <$> A.decimal), - "/_sync #" *> (APISyncGroupMemberRatchet <$> A.decimal <* A.space <*> A.decimal <*> (" force=on" $> True <|> pure False)), - "/_sync @" *> (APISyncContactRatchet <$> A.decimal <*> (" force=on" $> True <|> pure False)), - "/switch #" *> (SwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName), - "/switch " *> char_ '@' *> (SwitchContact <$> displayName), - "/abort switch #" *> (AbortSwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName), - "/abort switch " *> char_ '@' *> (AbortSwitchContact <$> displayName), - "/sync #" *> (SyncGroupMemberRatchet <$> displayName <* A.space <* char_ '@' <*> displayName <*> (" force=on" $> True <|> pure False)), - "/sync " *> char_ '@' *> (SyncContactRatchet <$> displayName <*> (" force=on" $> True <|> pure False)), - "/_get code @" *> (APIGetContactCode <$> A.decimal), - "/_get code #" *> (APIGetGroupMemberCode <$> A.decimal <* A.space <*> A.decimal), - "/_verify code @" *> (APIVerifyContact <$> A.decimal <*> optional (A.space *> verifyCodeP)), - "/_verify code #" *> (APIVerifyGroupMember <$> A.decimal <* A.space <*> A.decimal <*> optional (A.space *> verifyCodeP)), - "/_enable @" *> (APIEnableContact <$> A.decimal), - "/_enable #" *> (APIEnableGroupMember <$> A.decimal <* A.space <*> A.decimal), - "/code " *> char_ '@' *> (GetContactCode <$> displayName), - "/code #" *> (GetGroupMemberCode <$> displayName <* A.space <* char_ '@' <*> displayName), - "/verify " *> char_ '@' *> (VerifyContact <$> displayName <*> optional (A.space *> verifyCodeP)), - "/verify #" *> (VerifyGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> optional (A.space *> verifyCodeP)), - "/enable " *> char_ '@' *> (EnableContact <$> displayName), - "/enable #" *> (EnableGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName), - ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles, - ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups, - ("/help contacts" <|> "/help contact" <|> "/hc") $> ChatHelp HSContacts, - ("/help address" <|> "/ha") $> ChatHelp HSMyAddress, - ("/help incognito" <|> "/hi") $> ChatHelp HSIncognito, - ("/help messages" <|> "/hm") $> ChatHelp HSMessages, - ("/help remote" <|> "/hr") $> ChatHelp HSRemote, - ("/help settings" <|> "/hs") $> ChatHelp HSSettings, - ("/help db" <|> "/hd") $> ChatHelp HSDatabase, - ("/help" <|> "/h") $> ChatHelp HSMain, - ("/group" <|> "/g") *> (NewGroup <$> incognitoP <* A.space <* char_ '#' <*> groupProfile), - "/_group " *> (APINewGroup <$> A.decimal <*> incognitoOnOffP <* A.space <*> jsonP), - ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> (memberRole <|> pure GRMember)), - ("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName), - ("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole), - "/block for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True), - "/unblock for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False), - ("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayName <* A.space <* char_ '@' <*> displayName), - ("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayName), - ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName), - ("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayName <*> chatDeleteMode), - "/clear *" $> ClearNoteFolder, - "/clear #" *> (ClearGroup <$> displayName), - "/clear " *> char_ '@' *> (ClearContact <$> displayName), - ("/members " <|> "/ms ") *> char_ '#' *> (ListMembers <$> displayName), - "/_groups" *> (APIListGroups <$> A.decimal <*> optional (" @" *> A.decimal) <*> optional (A.space *> stringP)), - ("/groups" <|> "/gs") *> (ListGroups <$> optional (" @" *> displayName) <*> optional (A.space *> stringP)), - "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP), - ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayName <* A.space <*> groupProfile), - ("/group_profile " <|> "/gp ") *> char_ '#' *> (ShowGroupProfile <$> displayName), - "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> optional (A.space *> msgTextP)), - "/set welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayName <* A.space <*> (Just <$> msgTextP)), - "/delete welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> pure Nothing), - "/show welcome " *> char_ '#' *> (ShowGroupDescription <$> displayName), - "/_create link #" *> (APICreateGroupLink <$> A.decimal <*> (memberRole <|> pure GRMember)), - "/_set link role #" *> (APIGroupLinkMemberRole <$> A.decimal <*> memberRole), - "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal), - "/_get link #" *> (APIGetGroupLink <$> A.decimal), - "/create link #" *> (CreateGroupLink <$> displayName <*> (memberRole <|> pure GRMember)), - "/set link role #" *> (GroupLinkMemberRole <$> displayName <*> memberRole), - "/delete link #" *> (DeleteGroupLink <$> displayName), - "/show link #" *> (ShowGroupLink <$> displayName), - "/_create member contact #" *> (APICreateMemberContact <$> A.decimal <* A.space <*> A.decimal), - "/_invite member contact @" *> (APISendMemberContactInvitation <$> A.decimal <*> optional (A.space *> msgContentP)), - (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP), - (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP), - "/_contacts " *> (APIListContacts <$> A.decimal), - "/contacts" $> ListContacts, - "/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP), - "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), - "/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP), - "/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP), - "/_set conn user :" *> (APIChangeConnectionUser <$> A.decimal <* A.space <*> A.decimal), - ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeTill isSpace $> Nothing)), - ("/connect" <|> "/c") *> (AddContact <$> incognitoP), - ForwardMessage <$> chatNameP <* " <- @" <*> displayName <* A.space <*> msgTextP, - ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayName <* A.space <* A.char '@' <*> (Just <$> displayName) <* A.space <*> msgTextP, - ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayName <*> pure Nothing <* A.space <*> msgTextP, - ForwardLocalMessage <$> chatNameP <* " <- * " <*> msgTextP, - SendMessage <$> chatNameP <* A.space <*> msgTextP, - "/* " *> (SendMessage (ChatName CTLocal "") <$> msgTextP), - "@#" *> (SendMemberContactMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> msgTextP), - "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), - (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), - (">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd), - ("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> textP), - ("\\\\ #" <|> "\\\\#") *> (DeleteMemberMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> textP), - ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> msgTextP), - ReactToMessage <$> (("+" $> True) <|> ("-" $> False)) <*> reactionP <* A.space <*> chatNameP' <* A.space <*> textP, - "/feed " *> (SendMessageBroadcast <$> msgTextP), - ("/chats" <|> "/cs") *> (LastChats <$> (" all" $> Nothing <|> Just <$> (A.space *> A.decimal <|> pure 20))), - ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing), - ("/search" <|> "/?") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> (Just <$> (A.space *> stringP))), - "/last_item_id" *> (LastChatItemId <$> optional (A.space *> chatNameP) <*> (A.space *> A.decimal <|> pure 0)), - "/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)), - "/show " *> (ShowChatItem . Just <$> A.decimal), - "/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP), - ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> cryptoFileP), - ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> cryptoFileP), - ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal), - ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal), - ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath), - ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> (" approved_relays=" *> onOffP <|> pure False) <*> optional (" encrypt=" *> onOffP) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)), - "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> (" approved_relays=" *> onOffP <|> pure False) <*> optional (" encrypt=" *> onOffP)), - ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal), - ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal), - "/_connect contact " *> (APIConnectContactViaAddress <$> A.decimal <*> incognitoOnOffP <* A.space <*> A.decimal), - "/simplex" *> (ConnectSimplex <$> incognitoP), - "/_address " *> (APICreateMyAddress <$> A.decimal), - ("/address" <|> "/ad") $> CreateMyAddress, - "/_delete_address " *> (APIDeleteMyAddress <$> A.decimal), - ("/delete_address" <|> "/da") $> DeleteMyAddress, - "/_show_address " *> (APIShowMyAddress <$> A.decimal), - ("/show_address" <|> "/sa") $> ShowMyAddress, - "/_profile_address " *> (APISetProfileAddress <$> A.decimal <* A.space <*> onOffP), - ("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP), - "/_auto_accept " *> (APIAddressAutoAccept <$> A.decimal <* A.space <*> autoAcceptP), - "/auto_accept " *> (AddressAutoAccept <$> autoAcceptP), - ("/accept" <|> "/ac") *> (AcceptContact <$> incognitoP <* A.space <* char_ '@' <*> displayName), - ("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName), - ("/markdown" <|> "/m") $> ChatHelp HSMarkdown, - ("/welcome" <|> "/w") $> Welcome, - "/set profile image " *> (UpdateProfileImage . Just . ImageData <$> imageP), - "/delete profile image" $> UpdateProfileImage Nothing, - "/show profile image" $> ShowProfileImage, - ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> profileNames), - ("/profile" <|> "/p") $> ShowProfile, - "/set voice #" *> (SetGroupFeatureRole (AGFR SGFVoice) <$> displayName <*> _strP <*> optional memberRole), - "/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)), - "/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP), - "/set files #" *> (SetGroupFeatureRole (AGFR SGFFiles) <$> displayName <*> _strP <*> optional memberRole), - "/set history #" *> (SetGroupFeature (AGFNR SGFHistory) <$> displayName <*> (A.space *> strP)), - "/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayName <*> (A.space *> strP)), - "/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)), - "/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP), - "/set delete #" *> (SetGroupFeature (AGFNR SGFFullDelete) <$> displayName <*> (A.space *> strP)), - "/set delete @" *> (SetContactFeature (ACF SCFFullDelete) <$> displayName <*> optional (A.space *> strP)), - "/set delete " *> (SetUserFeature (ACF SCFFullDelete) <$> strP), - "/set direct #" *> (SetGroupFeatureRole (AGFR SGFDirectMessages) <$> displayName <*> _strP <*> optional memberRole), - "/set disappear #" *> (SetGroupTimedMessages <$> displayName <*> (A.space *> timedTTLOnOffP)), - "/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)), - "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))), - "/set links #" *> (SetGroupFeatureRole (AGFR SGFSimplexLinks) <$> displayName <*> _strP <*> optional memberRole), - ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito, - "/set device name " *> (SetLocalDeviceName <$> textP), - "/list remote hosts" $> ListRemoteHosts, - "/switch remote host " *> (SwitchRemoteHost <$> ("local" $> Nothing <|> (Just <$> A.decimal))), - "/start remote host " *> (StartRemoteHost <$> ("new" $> Nothing <|> (Just <$> ((,) <$> A.decimal <*> (" multicast=" *> onOffP <|> pure False)))) <*> optional (A.space *> rcCtrlAddressP) <*> optional (" port=" *> A.decimal)), - "/stop remote host " *> (StopRemoteHost <$> ("new" $> RHNew <|> RHId <$> A.decimal)), - "/delete remote host " *> (DeleteRemoteHost <$> A.decimal), - "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath), - "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP), - ("/connect remote ctrl " <|> "/crc ") *> (ConnectRemoteCtrl <$> strP), - "/find remote ctrl" $> FindKnownRemoteCtrl, - "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal), - "/verify remote ctrl " *> (VerifyRemoteCtrlSession <$> textP), - "/list remote ctrls" $> ListRemoteCtrls, - "/stop remote ctrl" $> StopRemoteCtrl, - "/delete remote ctrl " *> (DeleteRemoteCtrl <$> A.decimal), - "/_upload " *> (APIUploadStandaloneFile <$> A.decimal <* A.space <*> cryptoFileP), - "/_download info " *> (APIStandaloneFileInfo <$> strP), - "/_download " *> (APIDownloadStandaloneFile <$> A.decimal <* A.space <*> strP_ <*> cryptoFileP), - ("/quit" <|> "/q" <|> "/exit") $> QuitChat, - ("/version" <|> "/v") $> ShowVersion, - "/debug locks" $> DebugLocks, - "/debug event " *> (DebugEvent <$> jsonP), - "/get subs total " *> (GetAgentSubsTotal <$> A.decimal), - "/get servers summary " *> (GetAgentServersSummary <$> A.decimal), - "/reset servers stats" $> ResetAgentServersStats, - "/get subs" $> GetAgentSubs, - "/get subs details" $> GetAgentSubsDetails, - "/get workers" $> GetAgentWorkers, - "/get workers details" $> GetAgentWorkersDetails, - "/get queues" $> GetAgentQueuesInfo, - "//" *> (CustomChatCommand <$> A.takeByteString) - ] - where - choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput) - incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False - incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False - imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,") - imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P)) - chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char '*' $> CTLocal <|> A.char ':' $> CTContactConnection - chatPaginationP = - (CPLast <$ "count=" <*> A.decimal) - <|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) - <|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) - <|> (CPAround <$ "around=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) - <|> (CPInitial <$ "initial=" <*> A.decimal) - paginationByTimeP = - (PTLast <$ "count=" <*> A.decimal) - <|> (PTAfter <$ "after=" <*> strP <* A.space <* "count=" <*> A.decimal) - <|> (PTBefore <$ "before=" <*> strP <* A.space <* "count=" <*> A.decimal) - mcTextP = MCText . safeDecodeUtf8 <$> A.takeByteString - msgContentP = "text " *> mcTextP <|> "json " *> jsonP - ciDeleteMode = "broadcast" $> CIDMBroadcast <|> "internal" $> CIDMInternal - chatDeleteMode = - A.choice - [ " full" *> (CDMFull <$> notifyP), - " entity" *> (CDMEntity <$> notifyP), - " messages" $> CDMMessages, - CDMFull <$> notifyP -- backwards compatible - ] - where - notifyP = " notify=" *> onOffP <|> pure True - displayName = safeDecodeUtf8 <$> (quoted "'" <|> takeNameTill isSpace) - where - takeNameTill p = - A.peekChar' >>= \c -> - if refChar c then A.takeTill p else fail "invalid first character in display name" - quoted cs = A.choice [A.char c *> takeNameTill (== c) <* A.char c | c <- cs] - refChar c = c > ' ' && c /= '#' && c /= '@' - sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> msgTextP - quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space - reactionP = MREmoji <$> (mrEmojiChar <$?> (toEmoji <$> A.anyChar)) - toEmoji = \case - '1' -> '👍' - '+' -> '👍' - '-' -> '👎' - ')' -> '😀' - ',' -> '😢' - '*' -> head "❤️" - '^' -> '🚀' - c -> c - composedMessagesTextP = do - text <- mcTextP - pure $ (ComposedMessage Nothing Nothing text) :| [] - 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 - (cName, fullName) <- profileNames - let profile = Just Profile {displayName = cName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing} - pure NewUser {profile, pastTimestamp = False} - jsonP :: J.FromJSON a => Parser a - jsonP = J.eitherDecodeStrict' <$?> A.takeByteString - groupProfile = do - (gName, fullName) <- profileNames - let groupPreferences = - Just - (emptyGroupPrefs :: GroupPreferences) - { directMessages = Just DirectMessagesGroupPreference {enable = FEOn, role = Nothing}, - history = Just HistoryGroupPreference {enable = FEOn} - } - pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences} - fullNameP = A.space *> textP <|> pure "" - textP = safeDecodeUtf8 <$> A.takeByteString - pwdP = jsonP <|> (UserPwd . safeDecodeUtf8 <$> A.takeTill (== ' ')) - verifyCodeP = safeDecodeUtf8 <$> A.takeWhile (\c -> isDigit c || c == ' ') - msgTextP = jsonP <|> textP - stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString - filePath = stringP - cryptoFileP = do - cfArgs <- optional $ CFArgs <$> (" key=" *> strP <* A.space) <*> (" nonce=" *> strP) - path <- filePath - pure $ CryptoFile path cfArgs - memberRole = - A.choice - [ " owner" $> GROwner, - " admin" $> GRAdmin, - " member" $> GRMember, - " observer" $> GRObserver - ] - chatNameP = - chatTypeP >>= \case - CTLocal -> pure $ ChatName CTLocal "" - ct -> ChatName ct <$> displayName - chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName - chatRefP = ChatRef <$> chatTypeP <*> A.decimal - msgCountP = A.space *> A.decimal <|> pure 10 - ciTTLDecimal = ("none" $> Nothing) <|> (Just <$> A.decimal) - ciTTL = - ("day" $> Just 86400) - <|> ("week" $> Just (7 * 86400)) - <|> ("month" $> Just (30 * 86400)) - <|> ("none" $> Nothing) - timedTTLP = - ("30s" $> 30) - <|> ("5min" $> 300) - <|> ("1h" $> 3600) - <|> ("8h" $> (8 * 3600)) - <|> ("day" $> 86400) - <|> ("week" $> (7 * 86400)) - <|> ("month" $> (30 * 86400)) - <|> A.decimal - timedTTLOnOffP = - optional ("on" *> A.space) *> (Just <$> timedTTLP) - <|> ("off" $> Nothing) - timedMessagesEnabledP = - optional ("yes" *> A.space) *> (TMEEnableSetTTL <$> timedTTLP) - <|> ("yes" $> TMEEnableKeepTTL) - <|> ("no" $> TMEDisableKeepTTL) - operatorRolesP = do - operatorId' <- A.decimal - enabled' <- A.char ':' *> onOffP - smpRoles' <- (":smp=" *> srvRolesP) <|> pure allRoles - xftpRoles' <- (":xftp=" *> srvRolesP) <|> pure allRoles - pure ServerOperatorRoles {operatorId', enabled', smpRoles', xftpRoles'} - srvRolesP = srvRoles <$?> A.takeTill (\c -> c == ':' || c == ',') - where - srvRoles = \case - "off" -> Right $ ServerRoles False False - "proxy" -> Right ServerRoles {storage = False, proxy = True} - "storage" -> Right ServerRoles {storage = True, proxy = False} - "on" -> Right allRoles - _ -> Left "bad ServerRoles" - netCfgP = do - socksProxy <- "socks=" *> ("off" $> Nothing <|> "on" $> Just defaultSocksProxyWithAuth <|> Just <$> strP) - socksMode <- " socks-mode=" *> strP <|> pure SMAlways - hostMode <- " host-mode=" *> (textToHostMode . safeDecodeUtf8 <$?> A.takeTill (== ' ')) <|> pure (defaultHostMode socksProxy) - requiredHostMode <- (" required-host-mode" $> True) <|> pure False - smpProxyMode_ <- optional $ " smp-proxy=" *> strP - smpProxyFallback_ <- optional $ " smp-proxy-fallback=" *> strP - smpWebPort <- (" smp-web-port" $> True) <|> pure False - t_ <- optional $ " timeout=" *> A.decimal - logTLSErrors <- " log=" *> onOffP <|> pure False - let tcpTimeout_ = (1000000 *) <$> t_ - pure $ SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} - dbKeyP = nonEmptyKey <$?> strP - nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k - dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False} - autoAcceptP = ifM onOffP (Just <$> (businessAA <|> addressAA)) (pure Nothing) - where - addressAA = AutoAccept False <$> (" incognito=" *> onOffP <|> pure False) <*> autoReply - businessAA = AutoAccept True <$> (" business" *> pure False) <*> autoReply - autoReply = optional (A.space *> msgContentP) - rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (jsonP <|> text1P)) - text1P = safeDecodeUtf8 <$> A.takeTill (== ' ') - char_ = optional . A.char - -adminContactReq :: ConnReqContact -adminContactReq = - either error id $ strDecode "simplex:/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D" - -simplexTeamContactProfile :: Profile -simplexTeamContactProfile = - Profile - { displayName = "SimpleX Chat team", - fullName = "", - image = Just (ImageData "data:image/jpg;base64,/9j/4AAQSkZJRgABAgAAAQABAAD/2wBDAAUDBAQEAwUEBAQFBQUGBwwIBwcHBw8KCwkMEQ8SEhEPERATFhwXExQaFRARGCEYGhwdHx8fExciJCIeJBweHx7/2wBDAQUFBQcGBw4ICA4eFBEUHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh7/wAARCAETARMDASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwD7LooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiivP/iF4yFvv0rSpAZek0yn7v+yPeunC4WpiqihBf8A8rOc5w2UYZ4jEPTourfZDvH3jL7MW03SpR53SWUfw+w96veA/F0erRLY3zKl6owD2k/8Ar15EWLEljknqadDK8MqyxMUdTlWB5Br66WS0Hh/ZLfv1ufiNLj7Mo5m8ZJ3g9OTpy+Xn5/pofRdFcd4B8XR6tEthfMEvVHyk9JB/jXY18fiMPUw9R06i1P3PK80w2aYaOIw8rxf3p9n5hRRRWB6AUUVDe3UFlavc3MixxIMsxppNuyJnOMIuUnZIL26gsrV7m5kWOJBlmNeU+I/Gd9e6sk1hI8FvA2Y1z973NVPGnimfXLoxRFo7JD8if3vc1zefevr8syiNKPtKyvJ9Ox+F8Ycb1cdU+rYCTjTi/iWjk1+nbue3eEPEdtrtoMER3SD95Hn9R7Vu18+6bf3On3kd1aSmOVDkEd/Y17J4P8SW2vWY6R3aD97F/Ue1eVmmVPDP2lP4fyPtODeMoZrBYXFO1Zf+Tf8AB7r5o3qKKK8Q/QgooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAqavbTXmmz20Fw1vJIhVZB1FeDa3p15pWoSWl6hWQHr2YeoNfQlY3izw9Z6/YGGZQky8xSgcqf8K9jKcyWEnyzXuv8D4njLhZ51RVSi7VYLRdGu3k+z+88HzRuq1rWmXmkX8lnexFHU8Hsw9RVLNfcxlGcVKLumfgFahUozdOorSWjT6E0M0kMqyxOyOpyrKcEGvXPAPjCPVolsb9wl6owGPAkH+NeO5p8M0kMqyxOyOpyrA4INcWPy+njKfLLfoz2+HuIMTkmI9pT1i/ij0a/wA+zPpGiuM+H/jCPV4lsL91S+QfKTwJR/jXW3t1BZWslzcyLHFGMsxNfB4jC1aFX2U1r+fof0Rl2bYXMMKsVRl7vXy7p9rBfXVvZWr3NzKscSDLMTXjnjbxVPrtyYoiY7JD8if3vc0zxv4ruNeujFEWjsoz8if3vc1zOa+synKFh0qtVe9+X/BPxvjLjKWZSeEwjtSW7/m/4H5kmaM1HmlB54r3bH51YkzXo3wz8MXMc0es3ZeED/VR5wW9z7VB8O/BpnMerarEREDuhhb+L3Pt7V6cAAAAAAOgFfL5xmqs6FH5v9D9a4H4MlzQzHGq1tYR/KT/AEXzCiiivlj9hCiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAxfFvh208QWBhmASdRmKUdVP+FeH63pl5pGoSWV5EUdTwezD1HtX0VWL4t8O2fiHTzBONk6g+TKByp/wr28pzZ4WXs6msH+B8NxdwhTzeDxGHVqy/8m8n59n954FmjNW9b0y80fUHsr2MpIp4PZh6iqWfevuYyjOKlF3TPwetQnRm6dRWktGmSwzSQyrLE7I6nKsDgg1teIPFOqa3a29vdy4jiUAheN7f3jWBmjNROhTnJTkrtbGtLF4ijSnRpzajPddHbuP3e9Lmo80ua0scth+a9E+HXgw3Hl6tqsZEX3oYmH3vc+1J8OPBZnKavq0eIhzDCw+9/tH29q9SAAAAGAOgr5bOM35b0KD16v8ARH6twXwXz8uPx0dN4xfXzf6IFAUAAAAdBRRRXyZ+wBRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFB4GTXyj+1p+0ONJjufA3ga6DX7qU1DUY24gB4McZH8Xqe38tqFCdefLETaSufQ3h/4geEde8Uah4a0rWra51Ow/wBfCrD8ceuO+OldRX5I+GfEWseG/ENvr2j30ttqFvJ5iSqxyT3z6g96/RH9nD41aT8U9AWGcx2fiK1QC7tC33/+mieqn07V14zL3QXNHVEQnc9dooorzjQKKKKACiis7xHrel+HdGudY1m8is7K2QvLLI2AAP600m3ZAYfxUg8Pr4VutT1+7isYbSMuLp/4Pb3z6V8++HNd0zxDpq6hpVys8DHGRwVPoR2NeIftJ/G7VPifrbWVk8lp4btZD9mtwcGU/wDPR/c9h2rgfh34z1LwdrAurV2ktZCBcW5PyyD/AB9DX2WTyqYWny1Ho+nY+C4t4Wp5tF16CtVX/k3k/Ps/vPr/ADRmsjwx4g07xFpMWpaZOJInHI/iQ9wR61qbq+mVmro/D6tCdGbp1FZrdEma6/4XafpWoa7jUpV3oA0MLdJD/ntXG5p8E0kMqyxOyOhyrKcEGsMTRlWpShGVm+p1ZbiYYPFQr1IKai72fU+nFAUAKAAOABRXEfDnxpFrMK6fqDhL9BhSeko9frXb1+a4rDVMNUdOotT+k8szLD5lh44jDu8X968n5hRRRXOegFFFFABUGoXlvYWkl1dSrHFGMliaL+7t7C0kuruVYoYxlmNeI+OvFtx4huzHFuisYz+7jz97/aNenluW1MbU00it2fM8S8SUMkoXetR/DH9X5fmeteF/E+m+IFkFoxSWMnMb9cev0rbr5t0vULrTb6K8s5TFNGcgj+R9q9w8E+KbXxDYjlY7xB+9i/qPaurNsneE/eUtYfkeTwlxjHNV9XxVo1V90vTz8vmjoqKKK8I+8CiiigAooooAKKKKACiiigD5V/a8+P0mgvdeAvCUskepFdl9eDjyQR9xPfHeviiR3lkaSR2d2OWZjkk+tfoj+058CtP+Jektq2jxRWnie2T91KMKLlR/yzf+h7V+fOuaVqGiarcaXqtpLaXls5jlikXDKRX0mWSpOlaG/U56l76lKtPwtr+reGNetdb0S8ls761cPHJG2D9D6g9MVmUV6TSasyD9Jf2cfjXpPxR0MW9w0dp4gtkAubYnHmf7aeo/lXr1fkh4W1/V/DGuW2taHey2d9bOHjkjP6H1HtX6Jfs5fGvR/inoQgmeOz8RWqD7XaE439vMT1U+navnMfgHRfPD4fyN4Tvoz12iis7xJremeHdEutZ1i7jtLK1jLyyucAAf1rzUm3ZGgeJNb0vw7otzrOs3kVpZWyF5ZZDgAD+Z9q/PL9pP436r8UNZaxs2ks/Dlq5+z24ODMf77+p9B2o/aU+N2p/FDXDZ2LS2fhy1ci3t84Mx/wCej+/oO1eNV9DgMAqS55/F+RhOd9EFFFABJwBkmvUMzqPh34y1Lwjq63FszSWshAntyeHHt719Z2EstzpVlqD2txbR3kCzxLPGUbawyODXK/slfs8nUpbXx144tGFkhElhp8q4849pHB/h9B3r608X+GLDxBpX2WRFiljX9xIowUPYfT2rGnnkMPWVJ6x6vt/XU+P4o4SjmtN4igrVV/5N5Pz7P7z56zRmrmvaVe6LqMljexMkiHg9mHqKoZr6uEozipRd0z8Rq0J0ZunUVmtGmTwTSQTJNC7JIhyrKcEGvZvhz41j1mJdP1GRUv0GFY8CX/69eJZqSCaWCVZYXZHU5VlOCDXDmGXU8bT5ZaPo+x7WQZ9iMlxHtKesX8UejX+fZn1FRXDfDbxtHrUKadqDqmoIuAx4EoHf613NfnWKwtTC1HTqKzR/QGW5lh8yw8cRh3eL+9Ps/MKr6heW1hZyXd3KsUUYyzGjUby20+zku7yZYoY13MzGvDPHvi+48RXpjiZorCM/u4/73+0feuvLMsqY6pZaRW7/AK6nlcScR0MloXetR/DH9X5D/Hni648Q3nlxlo7GM/u48/e9zXL7qZmjNfodDDwoU1TpqyR+AY7G18dXlXryvJ/19w/dVvSdRutMvo7yzlaOVDkY7+xqkDmvTPhn4HMxj1jV4v3Y+aCFh97/AGjWGPxNHDUXKrt27+R15JlWLzHFxp4XSS1v/L53PQ/C+oXGqaJb3t1bNbyyLkoe/v8AQ1p0AAAAAADoBRX5nUkpSbirLsf0lh6c6dKMJy5mkrvv5hRRRUGwUUUUAFFFFABRRRQAV4d+038CdO+JWkyavo8cdp4mtkzHIBhbkD+B/f0Ne40VpSqypSUovUTV9GfkTruk6joer3Ok6taS2d7ayGOaGVdrKRVKv0T/AGnfgXp/xK0h9Y0iOO18TWqZikAwLkD+B/6Gvz51zStQ0TVbjS9UtZbW8tnKSxSLgqRX1GExccRG636o55RcSlWp4V1/VvDGvWut6JeSWl9bOGjkQ4/A+oPpWXRXU0mrMk/RP4LftDeFvF3ge41HxDfW+lappkG+/idsBwP40HfJ7V8o/tJ/G/VPifrbWVk8tn4btn/0e2zgykfxv6n0HavGwSM4JGeuO9JXFRwFKlUc18vIpzbVgoooAJIAGSa7SQr6x/ZM/Z4k1J7Xxz44tClkMSWFhIuDL3Ejg/w+g70fsmfs8NqMtt448c2eLJCJLCwlX/WnqHcH+H0HevtFFVECIoVVGAAMACvFx+PtenTfqzWEOrEjRI41jjUIigBVAwAPSnUUV4ZsYXjLwzZeJNOaCcBLhQfJmA5U/wCFeBa/pV7ompSWF9GUkToccMOxHtX01WF4z8M2XiXTTBOAk6AmGYDlD/hXvZPnEsHL2dTWD/A+K4r4UhmsHXoK1Zf+TeT8+z+8+c80Zq5r2k3ui6jJY30ZSRTwezD1FUM1+gQlGcVKLumfiFWjOjN06is1umTwTSQTJNE7JIh3KynBBr2PwL8QrO701odbnSC5t0yZCcCUD+teK5pd1cWPy2ljoctTdbPqetkme4rJ6rqUHdPdPZ/8Mdb4/wDGFz4ivDFGxisIz+7j/ve5rls1HuozXTQw1PD01TpqyR5+OxlfHV5V68ryf9fcSZozTAa9P+GHgQzmPWdZhIjHzQQMPvf7R9qxxuMpYOk6lR/8E6MpyfEZriFQoL1fRLux/wAMvApmMesazFiP70EDfxf7R9vavWFAUAAAAcACgAAAAAAdBRX5xjsdVxtXnn8l2P3/ACXJcNlGHVGivV9W/wCugUUUVxHrhRRRQAUUUUAFFFFABRRRQAUUUUAFeH/tOfArT/iXpUmsaSsVp4mto/3UuMLcgDhH/oe1e4Vn+I9a0zw7otzrGsXkVpZWyF5ZZGwAB/WtaNSdOalDcTSa1PyZ1zStQ0TVrnStVtZLS8tnMcsUgwVIqlXp/wC0l8S7T4nePn1aw0q3srO3XyYJBGBNOoPDSHv7DtXmFfXU5SlBOSszlYUUUVYAAScDk19Zfsmfs7vqLW3jjx1ZFLMESafYSjmXuJHHZfQd6+VtLvJtO1K2v7cRtLbyrKgkQOpKnIyp4I46Gv0b/Zv+NOjfFDw+lrIIrDX7RAtzZ8AMMffj9V9u1efmVSrCn7m3Vl00m9T16NEjjWONVRFGFUDAA9KWiivmToCiiigAooooAwfGnhiy8S6cYJwEuEH7mYDlT/hXz7r+k32h6lJYahFskQ8Hsw9QfSvpjUr2106ykvLyZYYYxlmY18+/EXxa/ijU1aOMRWkGRCCBuPuT/Svr+GK2KcnTSvT/ACfl/kfmPiBhMvUI1m7Vn0XVefp0fy9Oa3UbqZmjNfa2PynlJM+9AOajzTo5GjkV0YqynIPoaVg5T1P4XeA/P8vWdaiIj+9BAw+9/tH29q9dAAAAAAHQVwPwx8dQ63Ammai6R6hGuFJ4Ew9vf2rvq/Ms5qYmeJaxGjWy6W8j+gOFcPl9LAReBd0931b8+3oFFFFeSfSBRRRQAUUUUAFFFFABRRRQAUUUUAFFFZ3iTW9L8OaJdazrN5HaWNqheWWQ4AH+NNJt2QB4l1vTPDmiXWs6xdx2llaxl5ZHOAAO3ufavzx/aT+N2qfFDWzZWbSWfhy2ci3tg2DKf77+p9B2pf2lfjdqfxQ1trGxeW08N2z/AOj2+cGYj/lo/v6DtXjVfQ4DAKkuefxfkYTnfRBRRQAScAZNeoZhRXv3w2/Zh8V+Lfh7deJprgadcvHv02zlT5rgdcsf4Qe1eHa5pWoaJq1zpWq2ktpeW0hjlikXDKwrOFanUk4xd2htNFKtTwrr+reGNdtta0S8ltL22cPHIhx07H1HtWXRWjSasxH6S/s4/GrSfijoYtp3jtfENqg+1WpON4/vp6j27V69X5IeFfEGr+F9etdc0O9ks7+1cPHKh/QjuD3Ffoj+zl8bNI+KWhLbztFZ+IraMfa7TON+Osieqn07V85j8A6L54fD+RvCd9GevUUUV5hoFVtTvrXTbGW9vJligiXczNRqd9aabYy3t7MsMEQyzMa+ffiN42uvE96YoS0OmxH91F3b/ab3r1spympmFSy0it3+i8z57iDiCjlFG71qPZfq/Id8RPGl14lvTFEzRafGf3cf97/aNclmmZozX6Xh8NTw1NU6askfheNxdbG1pV68ryY/NGTTM16R4J+GVxrGkSX+pSSWfmJ/oq45J7MR6Vni8ZRwkOes7I1y7K8TmNX2WHjd7/0zzvJozV3xDpF7oepyWF/EUkQ8HHDD1FZ+feuiEozipRd0zjq0Z0puE1ZrdE0E8sEyTQu0ciHKspwQa9z+GHjuLXIU0zUpFTUEXCseBKB/WvBs1JBPLBMk0LmORCGVlOCDXn5lllLH0uWWjWz7HsZFnlfJ6/tKesXuu6/z7M+tKK4D4X+PItdhTTNSdY9SQYVicCYDuPf2rv6/M8XhKuEqulVVmj92y7MaGYUFXoO6f4Ps/MKKKK5juCiiigAooooAKKKKACiig9KAM7xLrmleG9EudZ1q8jtLG2QvLK5wAPQep9q/PH9pP43ap8T9beyspJbTw3bSH7NbZx5pH8b+p9u1bH7YPxL8XeJPG114V1G0udH0jT5SIrNuDOR0kbs2e3pXgdfRZfgVTSqT3/IwnO+iCiigAkgAZJr1DMK+s/2TP2d31Brbxz46tNtmMSafp8i8y9/MkB6L0wO9J+yb+zwdSe28b+ObLFmpEljYSr/rT1DuP7voO9faCKqIERQqqMAAYAFeLj8fa9Om/VmsIdWEaJGixooVFGFUDAA9K8Q/ac+BWnfErSZNY0mOO08T2yZilAwtyAPuP/Q9q9worx6VWVKSlF6mrSasfkTrmlahomrXOlaray2l7bSGOaKRcMrCqVfon+098C7D4l6U+s6Skdr4mtY/3UmMC5UdI29/Q1+fOt6XqGi6rcaVqlrJa3ls5SWKQYKkV9RhMXHERut+qOeUeUpVqeFfEGreGNdttb0W7ktb22cNG6HH4H1FZdFdTSasyT9Jf2cPjVpXxR0Fbe4eK18Q2qD7Va7sbx/z0T1H8q9V1O+tdNsZb29mWGCJdzMxr8ovAOoeIdK8W2GoeF5podVhlDQtEefcH2PevsbxP4417xTp1jDq3lQGKFPOigJ2NLj5m59849K4KHD0sTX9x2h18vJHj55xDSyqhd61Hsv1fkaXxG8bXXie9MURaLTo2/dR5+9/tH3rkM1HmjNffYfC08NTVOmrJH4ljMXWxtaVau7yZJmgHmmAmvWfhN8PTceVrmuQkRDDW9uw+9/tN7Vjj8dSwNJ1ar9F3OjK8pr5nXVGivV9Eu7H/Cf4emcx63rkJEfDW9u4+9/tMPT2r2RQFAVQABwAKAAAAAAB0Aor8uzDMKuOq+0qfJdj9zyjKMPlVBUaK9X1bOf8b+FbHxRppt7gCO4UfuZwOUP9R7V86+IdHv8AQtTk0/UIikqHg9mHqD6V9VVz3jnwrY+KNMNvcKEuEBME2OUP+FenkmdywUvZVdab/A8PijheGZw9vQVqq/8AJvJ+fZnzLuo3Ve8Q6Pf6FqclhqERjkQ8Hsw9Qazs1+jwlGpFSi7pn4xVozpTcJqzW6J7eeSCZJoZGjkQhlZTgg17t8LvHsWuQppmpOseooMKxPEw/wAa8DzV3Q7fULvVIIdLWQ3ZcGMx8EH1z2rzs1y2jjaLVTRrZ9v+AezkGcYnK8SpUVzKWjj3/wCD2PrCiqOgx38Oj20eqTJNeLGBK6jAJq9X5VOPLJq9z98pyc4KTVr9H0CiiipLCiiigAooooAKKKKAPK/2hfg3o/xT8PFdsVprlupNnebec/3W9VNfnR4y8Naz4R8RXWg69ZvaXts5V1YcEdmB7g9jX6115V+0P8GtF+Knh05SO0161UmzvQuD/uP6qf0r08DjnRfJP4fyM5wvqj80RycCvrP9kz9ndtRNr458dWTLaAiTT9PlXBl9JJB/d7gd+tXv2bv2Y7yz19vEHxFs1VbKYi1sCQwlZTw7f7PcDvX2CiLGioihVUYAAwAK6cfmGns6T9WTCHVhGiRoqRqFRRgKBgAUtFFeGbBRRRQAV4h+038CtP8AiZpTatpCQ2fia2jPlS4wtyo52P8A0Pavb6K0pVZUpKUXqJq+jPyJ1zStQ0TVrnStVtJbS9tnMcsUgwVIqPS7C61O+isrKFpZ5W2qor9AP2r/AIM6J448OzeJLV7fTtesoyRO3yrcqP4H9/Q14F8OvBlp4XsvMkCTajKP3suM7f8AZX0H86+1yiDzFcy0S3Pms+zqllNLXWb2X6vyH/DnwZaeF7EPIEm1CUDzZcfd/wBke1dfmo80ua+0pUY0oqMVofjWLxNXF1XWrO8mSZozUea9N+B/hTTdau5NUv5opvsrjbak8k9mYelc+OxcMHQlWqbI1y3LqmYYmOHpbvuafwj+HhnMWva5DiMENb27D73ozD09q9oAAAAAAHQCkUBVCqAAOABS1+U5jmNXH1XUqfJdj9yyjKKGV0FRor1fVsKKKK4D1AooooA57xz4UsPFOmG3uFEdwgJgnA5Q/wBR7V84eI9Gv9A1SXT9RhMcqHg/wuOxB7ivrCud8d+E7DxTpZt51CXKDMEwHKn/AAr6LI88lgpeyq603+Hmv1Pj+J+GIZnB16KtVX/k3k/Psz5p0uxu9Tv4rGxheaeVtqIoyTX0T8OPBNp4XsRJKFm1GQfvZf7v+yvtR8OfBFn4UtDIxW41CUfvJsdB/dX0FdfWue568W3RoP3Pz/4BhwvwtHL0sTiVeq9l/L/wQooor5g+3CiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKrarf2ml2E19fTpBbwrud2OAKTVdQtNLsJb6+mWGCJcszGvm34nePLzxXfmGEtDpkTfuos/f/wBpvevZyfJ6uZVbLSC3f6LzPBz3PaOVUbvWb2X6vyH/ABM8d3fiq/MULPDpsR/dRdN3+03vXF5pm6jdX6phsLTw1JUqSskfjGLxVbGVnWrO8mSZ96M0wGnSq8UhjkRkdeCrDBFb2OXlFzWn4b1y/wBA1SPUNPmMciHkdmHoR6Vk7hS596ipTjUi4zV0y6c50pqcHZrZn1X4C8W2HizShc27BLmMATwZ5Q/4V0dfIfhvXL/w/qseo6dMY5U6js47gj0r6Y8BeLtP8WaUtzbER3KAefATyh/qPevzPPshlgJe1pa03+Hk/wBGfr/DfEkcygqNbSqv/JvNefdHSUUUV80fWhRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFVtVv7TS7CW+vp1ht4l3O7HpSatqNnpWny319OsMES7mZjXzP8UfH154tv8AyYWeDS4WPlQ5xvP95vU/yr2smyarmVWy0gt3+i8zws8zylldK71m9l+r8h/xP8eXfiy/MUJaHTIm/cxZ5b/ab3ris0zNGa/V8NhaWFpKlSVkj8bxeKrYuq61Z3kx+aX2pmTXsnwc+GrXBh8Qa/CViB3W9sw5b0Zh6e1YZhj6OAourVfourfY3y3LK+Y11Ror1fRLux3wc+GxuPK1/X4SIgQ1tbuPvf7TD09BXT/Fv4dQ6/bPqukxpFqca5KgYE4Hb6+9ekKAqhVAAHAApa/L62fYupi1ilKzWy6W7f5n63R4bwVPBPBuN0931v3/AMj4wuIZred4J42jlQlWVhgg0zNfRHxc+HUXiCB9W0mNI9TRcso4EwH9a+eLiKW2neCeNo5UO1kYYIPpX6TlOa0cypc8NJLddv8AgH5XnOS1srrck9YvZ9/+CJmtPw1rl/4f1WLUdPmMcqHkZ4Yeh9qys0Zr0qlONSLhNXTPKpznSmpwdmtmfWHgDxfp/i3SVubZhHcoAJ4CfmQ/1HvXSV8feGdd1Dw9q0WpabMY5UPIz8rr3UjuK+nPAHjDT/FulLcW7CO6QYngJ5Q/1FfmGfZBLAS9rS1pv8PJ/oz9c4c4jjmMFRraVV/5N5rz7o6WiiivmT6wKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAOY+JXhRfFvh5rAXDwTod8LA/KW9GHcV8s65pV/oupzadqNu0FxC2GVu/uPUV9m1x/xM8DWHi/TD8qw6jEP3E4HP+6fUV9Tw7n7wEvY1v4b/AAf+Xc+S4k4eWYR9vR/iL8V29ex8q5o+gq9ruk32i6nLp2oQNFPG2CCOvuPUV6v8Gvhk1w0PiDxDBiH71tbOPvejMPT2r9Cx2Z4fB4f283o9rdfQ/OMBlWIxuI+rwjZre/T1F+DPw0NwYfEPiCDEQ+a2tnH3vRmHp6Cvc1AVQqgADgAUKoVQqgAAYAHalr8lzPMq2Y1nVqv0XRI/YsryuhltBUqS9X1bCiiivOPSCvNfi98OYvEVu+raTEseqRrllHAnHoff3r0qiuvBY2tgqyq0nZr8fJnHjsDRx1F0ayun+Hmj4ruIZbad4J42ilQlWRhgg1Hmvoz4vfDiLxDA+raRGseqRjLIOBOP8a8AsdI1K91hdIgtJDetJ5ZiK4Knvn0xX6zleb0Mwoe1Ts1uu3/A8z8dzbJK+XYj2TV0/hff/g+Q3SbC81XUIbCwgee4mYKiKOpr6a+F3ga28IaaWkYTajOo8+Tsv+yvtTPhd4DtPCWnCWULNqcq/vZcfd/2V9q7avh+IeIHjG6FB/u1u+//AAD73hrhuOBSxGIV6j2X8v8AwQooor5M+xCiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAxdd8LaHrd/a32pWKTT2rbo2Pf2PqK2VAVQqgAAYAHalorSVWc4qMm2lt5GcKNOEnKMUm9/MKKKKzNAooooAKKKKACs+HRdLh1iXV4rKFb6VQrzBfmIrQoqozlG/K7XJlCMrOSvYKKKKkoKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooA//2Q=="), - contactLink = Just adminContactReq, - preferences = Nothing - } - -simplexStatusContactProfile :: Profile -simplexStatusContactProfile = - Profile - { displayName = "SimpleX-Status", - fullName = "", - image = Just (ImageData "data:image/jpg;base64,/9j/4AAQSkZJRgABAQAASABIAAD/4QBYRXhpZgAATU0AKgAAAAgAAgESAAMAAAABAAEAAIdpAAQAAAABAAAAJgAAAAAAA6ABAAMAAAABAAEAAKACAAQAAAABAAAAr6ADAAQAAAABAAAArwAAAAD/7QA4UGhvdG9zaG9wIDMuMAA4QklNBAQAAAAAAAA4QklNBCUAAAAAABDUHYzZjwCyBOmACZjs+EJ+/8AAEQgArwCvAwEiAAIRAQMRAf/EAB8AAAEFAQEBAQEBAAAAAAAAAAABAgMEBQYHCAkKC//EALUQAAIBAwMCBAMFBQQEAAABfQECAwAEEQUSITFBBhNRYQcicRQygZGhCCNCscEVUtHwJDNicoIJChYXGBkaJSYnKCkqNDU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6g4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2drh4uPk5ebn6Onq8fLz9PX29/j5+v/EAB8BAAMBAQEBAQEBAQEAAAAAAAABAgMEBQYHCAkKC//EALURAAIBAgQEAwQHBQQEAAECdwABAgMRBAUhMQYSQVEHYXETIjKBCBRCkaGxwQkjM1LwFWJy0QoWJDThJfEXGBkaJicoKSo1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoKDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uLj5OXm5+jp6vLz9PX29/j5+v/bAEMAAQEBAQEBAgEBAgMCAgIDBAMDAwMEBgQEBAQEBgcGBgYGBgYHBwcHBwcHBwgICAgICAkJCQkJCwsLCwsLCwsLC//bAEMBAgICAwMDBQMDBQsIBggLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLC//dAAQAC//aAAwDAQACEQMRAD8A/v4ooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAP/Q/v4ooooAKKKKACiiigAoorE8R+ItF8J6Jc+IvEVwlrZ2iGSWWQ4CgVUISlJRirtmdatTo05VaslGMU223ZJLVtvokbdFfl3of/BRbS734rtpup2Ig8LSsIYrjnzkOcea3bafTqBX6cafqFjq1jFqemSrPbzqHjkQ5VlPIINetm2Q43LXD65T5eZXX+XquqPiuC/Efh/itYh5HiVUdGTjJWaflJJ6uEvsy2fqXKKKK8c+5Ciq17e2mnWkl/fyLDDCpd3c4VVHJJJr8c/2kf8Ago34q8M3mpTfByG3fT7CGSJZrlC3nStwJF5GFU8gd69LA5VicXTrVaMfdpxcpPokk397toj4LjvxKyLhGjRqZxValVkowhFc05O9m0tPdjfV7dN2kfq346+J3w9+GWlPrXxA1m00i1QZL3Uqxj8Mnn8K/Mj4tf8ABYD4DeEJ5dM+Gmn3niq4TIE0YEFtn/ffBI+imv51vHfxA8b/ABR1+bxT8RNUuNXvp3LtJcOWCk84VeigdgBXI18LXzupLSkrL72fzrxH9IXNsTKVPKKMaMOkpe/P8fdXpaXqfqvrf/BYH9p6+1w3+iafo1jZA8WrRPKSPeTcpz9BX1l8J/8Ags34PvxDp/xn8M3OmSnAe709hcQfUoSHA/A1/PtSE4/GuKGZ4mLvz39T4TL/ABe4swlZ1ljpTvvGaUo/dbT/ALdsf2rfCX9pT4HfHGzF18M/EdnqTYBaFXCzJn+9G2GH5V7nX8IOm6hqGkX8eraLcy2d3EcpPbuY5FPsykGv6gf+CWf7QPxB+OPwX1Ky+JF22pX3h69+yJdyf62WJlDrvPdlzjPevdwGae3l7OcbP8D+i/DTxm/1ixkcqx2H5K7TalF3jLlV2rPWLtqtWvM/T2iiivYP3c//0f7+KKKKACiiigAooooAK/Fv/goX8Qvi2fFcXgfWrRtP8NDEls0bZS7YfxORxlT0Xt1r9pK8u+L/AMI/Cfxp8F3HgvxbFujlGYpgB5kMg6Op9R+tfR8K5vQy3MYYnE01KK0843+0vNf8NZn5f4wcFZhxTwziMpy3FOjVeqSdo1Lf8u5u11GXk97Xuro/mBFyDX3t+yL+2Be/CW+h8B+OHafw7cyALIxJa0Ldx6p6jt1FfMvx/wDgR4w/Z+8YN4d8RoZrSbLWd4owk6D+TDuK8KF0K/pLFYHA51geWVp0pq6a/Brs1/wH2P8ALvJsz4h4D4h9tR5qGLoS5ZRls11jJbSjJferSi9mf1uafqFlqtlFqWmyrPBOoeORDlWU8gg069vrPTbSS/v5FhghUu7ucKqjqSa/CH9j79sm++EuoQ/D/wAeSNceHbmRVjlZstZk9x6p6jt2q3+15+2fffFS8n8AfD2V7bw9CxWWZThrwj+Se3evxB+G2Zf2n9TX8Lf2nTl/+S/u/PbU/v2P0nuGv9Vf7cf+9/D9Xv73tLd/+ffXn7afF7pqftbfth3nxUu5vAXgGR7fw/A5WWUHDXZX19E9B361+Z/xKm3eCL9R3UfzFbQul6Cn+I/A3ivxR8LPEXivSbVn07RoVkurg8Iu5gAue7HPSv1HOsrwmVcN4uhRSjBUp6vq3Fq7fVt/5I/gTNeI884x4kjmeYOVWtKSdop2hCPvWjFbQjFNv5ybbuz4Toqa0ge9uoLOIhWnkSNSxwAXIUEnsBnmv0+/aK/4Jg+O/gj8Hoviz4b1n/hJFt40l1G2ig2NDG4yZEIJ3KvfgHHNfxVTw9SpGUoK6W5+xZVw1mWZYfEYrA0XOFBKU2raJ31te72b0T0R+XRIAyegr+gr/glx+yZoHhjwBc/tKfFywiafUY2OmpeIGS3sVGWmIbgF+TkjhR71+YP7DX7Lt9+1H8ZLfR75WTw5pBS61ScDKsoIKwg+snf0Ffqd/wAFSv2o4Phf4Ltv2WvhmVtrjUbRBfvA2Ps1kOFhAHQyAc9ML9a9HL6UacHi6q0W3mz9Q8M8owuV4KvxpnEL0aN40Yv/AJeVXpp5LZPo7v7J+M/7U/jX4e/EL4/+JfFXwrsI9P0Ke5K26RKESTZw0oUcAOeQBX7J/wDBFU5+HPjYf9RWH/0SK/nqACgKOgr+hT/giouPh143b11SH/0SKWVzc8YpPrf8jHwexk8XxzSxVRJSn7WTSVknKMnoui7H7a0UUV9cf3Mf/9L+/iiiigAoorzX4wfGD4afAP4bav8AF74v6xbaD4d0K3e6vb26cJHHGgyevUnoAOSeBTjFyajFXYHpVFf55Xxt/wCDu34nj9vzS/G3wX0Qz/ArQ2ksLnSp1CXurQyMA15uPMTqBmJD2+914/uU/Y//AGxfgH+3P8ENL+P37OutxazoWpoNwHyzW02PmhmjPKSKeCD9RxXqY/JcXg4QqV4WUvw8n2ZnCrGTaTPqGiiivKNDy/4u/CLwd8afBtx4N8ZW4kilBMUoH7yGTs6HsR+tfzjftA/AXxl+z54yfw34jQzWkuXs7xF/dzR/0YdxX9OPiDxBofhPQ7vxN4mu4rDT7CF57m4ncJHFFGMszMcAAAZJNf53n/Bav/g5W1H4ufGjTvg5+xB5F14E8JX4l1HVriIE6xNE2GjhLDKQdRuGC55HHX9L8Os+x2ExP1eKcsO/iX8vmvPy6/ifg3jZ4NYDjDBPFUEqeYU17k/50vsT8n0lvF+V0fq0LhTUgnA4r4y/ZG/bJ+FX7YXw9HjDwBP5N/ahV1LTZeJrSUjoR3U/wsOK+sRdL/n/APXX9G0nCrBTpu6Z/mVmuSYvLcXUwOPpOnWg7SjJWaf9ap7NarQ+pf2dP2evGH7Q3i4aLogNvp1uQ15esMpEnoPVj2Ffrd+1V8GvDnw5/YU8X+APh/Z7IrewEjYGXlZGUs7nqSQM18C/sO/ti6b8F7o/Dnx6qpoN9LvS6RRvglbjL45ZT69vpX7wX1poHjjwxNYzbL3TdUt2jbaQySRSrg4PoQa/nnxXxGaTxLwmIjy4e3uW2lpu33Xbp87v+7Po58I8L4nhfFVMuqKeY1oTp1nJe9S5k0oxWtoPfmXxve1uVfwqKA0YHYiv6Ev+CZ37bVv490eP9mb4zXAn1GKJo9Murg5F3bgYMLk9XUcD+8tflR+1/wDsn+Nv2XfiNdadqFs8vh28md9Mv1GY3iJyEY9nXoQa+UrC/v8ASr+DVdJnktbq2dZYZomKvG6nIZSOhFfztQrVMJW1Xqu5+Z8PZ5mvBWeSc4NSg+WrTeinHqv1jL56ptP+s7xHZ/A//gnR8EfE/jTwra+RHqF5JdxWpbLTXcwwkSnrsGPwXNfyrfEDx54l+J/jXU/iB4wna51LVZ3nmdj3Y8KPQKOAPQV2vxX/AGhvjT8corC3+K2vz6vFpq7beNgERT3YqvBY92NeNVeOxirNRpq0Fsju8RePKWfTo4TLqPscFRXuU9F7z+KTSuvJK7srvqwr+ir/AIIuaVd2/wAH/FesSIRDd6uFjb+8Y41Dfka/BX4YfCzx78ZfGVr4C+G+nyajqV22Aqj5I17u7dFUdya/r+/ZV+Aenfs2fBLSPhbZyC4ntVaW7nAx5tzKd0jfTJwPYV1ZLQk63tbaI+w8AOHcXiM8ebcjVClGS5ujlJWUV3sm27baX3R9FUUUV9Uf2gf/0/7+KKKKACv4If8Ag8QT9vN9W8IsVk/4Z+WJedOL7f7Xyd32/HGNu3yc/LnPev73q84+Lnwj+G/x3+HGr/CT4uaRba74d123e1vbK6QPHJG4weD0I6gjkHkV6WUY9YLFQxDgpJdP8vMipDmi0f4W1frt/wAEhP8Agrt8af8AglD8b38V+Fo21zwPr7xp4i0B3KpcRoeJoTyEnjBO04+boeK+m/8AguZ/wQz+I3/BMD4kyfEn4Ww3fiD4Oa5KzWWolC76XKx4tbphwOuI3PDAc81/PdX7LCeFzHC3VpU5f18mjympU5eZ/t9fsk/tb/Av9tv4G6N+0F+z3rUWs6BrEQYFCPNt5cfPDMnVJEPDKf5V794h8Q6F4T0O78TeJ7uGw06wiae4uZ3EcUUaDLMzHAAA6k1/j9f8EiP+Cunxv/4JTfHAeKPCZfWfAuuyRx+IvD8jkRTxg486Lsk8YJ2n+Loa/V7/AILy/wDBxZd/t2eHl/Zc/Y6mu9I+Gl1DDNrWoSBoLvUpGAY2+OqQoeH/AL5GOlfneI4OxCxio0taT+12Xn59u53xxMeW73ND/g4M/wCDgzVP2yNV1H9jz9j3UZrD4ZWE7waxrEDlH110ONiEYItgQe/7z6V/I6AAMDgCgAKNo6Cv0j/4Jkf8Ex/j/wD8FOvj/Y/Cj4UWE9voFvNGdf18xk2um2pPzEt0MhGdiZyTX6FhsNhctwvLH3YR1bfXzfn/AEjhlKVSR77/AMEMf2Rf2v8A9qr9tPRrb9mNpdL0fSp438UaxKjNYW+nk/PHKOA7uoIjTrnniv7Lfj98CvG37PPjiXwj4uiLxNl7S7UYjuIuzD39R1Ffvt+wn+wd+z5/wTy+A+n/AAF/Z70pbKyt1V728cA3V/c4w0079WYnoOijgV7V8cPgb4G+Pngqfwb41twwYEwXCgebBJ2ZT/MdDXi5N4mTwmYWqRvhXpb7S/vL9V28z8c8YfBXC8XYL61hbQx9Ne7LpNfyT8v5ZfZfkfyXi5r9Lf2Jv24bn4S3UHwz+JkzT+HZ5AsNy5LNZlu3vHn8q+KPj38CPHf7PPjabwn4yt2ELMxtLsD91cRg8Mp6Z9R2rxAXAPANfuePyzL89y/2c7TpTV1JdOzT6Nf8Bn8C5FnGfcEZ79Yw96OJpPlnCS0a6xkusX/k4u9mf2IeK/B/w++Mngt9C8U2ltrWi6lEGCuA6OrDhlPY+hHNfztftw/8E4tN+AGlTfE34ba3HJo0koVdMvGC3CFv4Ym/5aAenBArvf2PP2+9R+CGmv4B+JSy6joEUbtaOp3TQOBkRj1Rjx7V8uftEftH+Nf2i/G7+KPEzmG0hyllZqT5cEef1Y9zX4LT8GMTisynhsY7UI6qot5J7Jefe+i87o/prxI8YuEM/wCF6WM+rc2ZSXKo6qVJrdykvih/Ktebsmnb4DkilicxyqVYdQRzXUaN4R1HVMSzjyIf7zDk/QV6dIlpJIJ5Y1Z16MRk1+qf7DX7Ed58ULmH4p/Fe2kt/D8Dq9paSDabwjncf+mf/oX0rKXg3lOR+0zDPMW6lCL92EVyufZN3vfyjbvdI/AeFsJnHFOPp5TktD97L4pP4YLrJu2iXnq3ok20es/8Erv2f/G/gf8AtD4ozj7Bo2pwiFIpY/3t2VOQ4J5VFzx659q/aKq9paWthax2VlGsUMShERBtVVHAAA6AVYr4LNcdTxWIdSjRjSpqyjGKslFber7t6tn+k3APB1LhjJaOUUqsqjjdylJ/FKTvJpfZV9orbzd2yiiivNPsj//U/v4ooooAKKKKAPO/iz8Jvh18c/h1q/wm+LGk2+ueHtdt3tb2yukDxyxuMEEHoR1B6g81/lm/8Fy/+CFfxG/4Jh/ENvid8J4bzxF8Htdmke1vliaRtHctxbXTAEBecRyHAbGDzX+q54j8R6B4Q0C88U+KbyHT9N0+F7i5ubhxHFFFGMszMcAADqa/zM/+Dhb/AIL06p+3f4rvP2Tf2Xr6S0+Eui3DR397GcHXriM8N7W6EfIP4jz6V9fwfPGLFctD+H9q+3/D9jmxKjy+9ufyq0UAY4or9ZPMP0v/AOCX3/BLf9oT/gqP8d4Phf8ACa0lsvDtjLG3iDxDJGTa6bbse56NKwB8uPOSfav9ZX9hD9hT4Df8E8v2fdK/Z7+AenLbWNkoe8vHUfab+6I+eeZhyWY9B0UcCv8AKC/4JUf8FV/j1/wSu+PCfEf4aSHUvC+rPHH4i0CViIL63U43D+7MgJKN+B4r/Wd/Yy/bM+BH7eHwH0j9oL9n7Vo9S0fU4182LI8+0nx88MydVdTxz16ivzbjZ43nipfwOlu/n59uh6GE5Labn1ZRRRXwB2Hi3x3+BPgj9oHwJceCPGcIIYFre4UfvYJezKf5jvX8vH7QvwB8d/s4eOZfB/jKEtDIS9neKP3VxFngqfX1Hav6gvj58e/An7PHgK48ceN7gLtBW2twf3txL2RR/M9hX8rX7Qn7Rnjz9o3x5L418ZyhUXKWlqh/dW8WeFUevqe5r988G4Zu3Ut/ueu/839z/wBu6fM/jj6UdPhlwo8y/wCFTS3Lb+H/ANPf/bPtf9unlQuAec077SPWueFznrTxc1+/eyP4udE/XX9g79h24+K8tv8AF74qQvD4fgkDWdo64N4V53H/AKZg/wDfX0r+ge0tLWwtY7KyjWKGJQiIgwqqOAAOwFfzc/sIft2XnwO1KH4ZfEeVp/Ct5L8k7Es9k7YHH/TMnkjt1r+kDTNT07WtOg1fSJ0ubW5QSRSxncjowyCCOoNfyr4q0s3jmreYfwtfZW+Hl/8Akv5r6/Kx/or9HSXDX+rqhkqtidPb81vac/d/3P5Lab/auXqKKK/Lz+gwooooA//V/v4ooooAKxfEniTQPB2gXnirxVew6dpunQvcXV1cOI4oYoxlndjgAADJJrar/PV/4Ozf+CiX7Xlr8Yrf9hCx0u98GfDaS0iv5L1GZT4iZs5HmKceTERgx9d3LcYr08py2eOxMaEXbu/L9SKk1CN2fIX/AAcD/wDBfrXv27vFF1+yx+ylqFzpnwl0id476+icxSa/MhwGOMEWykHYv8fU9hX8qoAAwOAKUAAYFfqj/wAEnf8AglH8cv8Agqp8ek+Hvw/R9M8I6NJFJ4k19lzHZW7k/ImeGmcAhF/E8V+xUKGFyzC2Xuwju/1fds8tuVSXmM/4JQ/8Epfjr/wVU+Pcfw5+HiPpXhPSXjl8ReIZEJhsoGP3E7PO4B2J+J4r7o/4Li/8EC/H3/BL/UYPjH8Hp7vxV8JNQMcL3sy7rnTLkgDbcFRjZI3KPwATg9q/0rP2MP2MPgL+wZ8BdI/Z5/Z60hNM0bS4x5kpANxeTn7887gAvI55JPToOK9y+J/ww8AfGfwBqvwu+KOlW+t6Brdu9re2V0gkilicYIIP6HqDXwVbjSu8YqlNfulpy9139e3Y7VhY8tnuf4VdfqD/AMErP+Cpvx1/4Jb/ALQNn8S/h7cS6j4VvpUj8QeH2kIt723zgsB0WVRyjetffn/BeH/ghJ4x/wCCZvjlvjP8EYbvXPg5rk7GKcqZJdGmc5FvOwH+rOcRyH0wea/nCr9ApVcNmOGuvehL+vk0cLUqcvM/24v2Mf20PgH+3l8CdK/aA/Z61iPVNI1FF86LI+0Wc+PnhnTqjqeOevUcV3nx/wD2gfh/+zp4CuPHHjq5CBQVtrZT+9uJeyIP5noBX+Ud/wAEL/25f2t/2NP2u7A/s7xPrPhzW5Yk8T6LOzCyls1PzTE9I5UXJRupPHIr+p39o79pXx/+0v8AEGbxv42l2RrlLO0QnyreLPCqPX1PUmvM4b8KauYZg5VJWwkdW/tP+6vPu+i8z8r8VvF3D8L4P6vhbTx017sekF/PL/21fafkjV/aF/aN8e/tHePZ/GvjOc+XuK2lopPlW8WeFUevqe9eFfasDmsL7UB1r9kv+Cen/BPuX4mPa/Gv41Wrw6HE4k0/T5FwbsjkO4PPl56D+L6V/QWbZjlnDmW+1q2hSgrRit2+kYrq/wDh2fw9kXDmdcZ526NK9SvUfNOctorrKT6JdF6JIh/Yq/4JyXXxq8MSfEn4wtPpukXkLLp1vH8s0hYcTHPRR1Ud6+KP2nP2bvHX7MXj+Twl4pUz2U+Xsb5QRHcRZ/Rh/Etf2D2trbWNtHZ2caxRRKEREGFVRwAAOgFeSfHL4G+Af2gvAVz4A8f2wmt5huimUDzYJB0dD2I/Wv5/yrxgx0c3niMcr4abtyL7C6OPdrr/ADeWlv604g+jdlFTh6ngsrfLjaauqj/5eS6xn2i/s2+Hz1v/ABi+d3r9O/2DP28r/wCBGpRfDT4lSvdeFL2UBJmYs9izcZX1j7kduor48/ah/Zr8bfsu/EWTwZ4pHn2c4MtheqMJcQ5IB9mHRhXzd9oAFf0Djsuy3iHLeSdqlGorpr8Gn0a/4DW6P5DyrMc74Mzz2tG9LE0XaUXs11jJdYv/ACaezP7pdK1bTNd02DWdGnS6tLlBJFLEwZHRuQQR1FaFfix/wSG1n47X3hPVLHXUL+BoT/oEtxneLjPzLD6pjr2B6d6/aev424nyP+yMyrZf7RT5Huvv17NdV0Z/pTwPxP8A6w5Lh82dGVJ1FrGXdaNp9YveL6oKKKK8A+sP/9b+/iiiigAr4E/4KI/8E4f2b/8AgpZ8DLr4M/H7SklljV5NJ1aJQLzTblhxLC/Uc43L0YcGvvuitKNadKaqU3aS2Ymk1Zn+Vt8Nf+DZH9vDxJ/wUEn/AGQfGti+m+DdMkF5eeNlTNjLpRb5Xgz964cfL5XVWyTx1/0lv2L/ANif9nv9gn4H6b8Bv2dNDh0jSrFF8+YKDcXs4GGmuJOskjHPJ6dBxX1lgZz3pa9bNc+xWPjGFV2iui6vu/60M6dKMNgooorxTU4T4m/DHwB8ZfAeqfDH4paRba7oGtQPbXtjeRiWGaJxghlII/wr/M//AOCw/wDwbq/En9kb9o7Ttc/ZhQ6h8KvGl4VgknkUyaJIxy0UmTueMDmNgCexr/SN/aA/aA+Hf7N3w6u/iL8RbtYYIFIggBHm3Ev8Mca9yfyA5NfyB/tTftZfEX9qv4gSeL/GEv2exgLJYWEZPlW8WeOO7H+Ju9fsXhRwnmOZYl4hNwwi+Jv7T/lj5930Xnofj3iv4nYThrCPD0bTxs17kekV/PPy7L7T8rn58fs1fs1/Df8AZg8Dp4U8CwB7qYK19fuAZrmQDkseyjsvQV9GfaWrAWcjvUnnt6mv62w+Cp0KapUo2itkfwFmOLxWPxNTGYyo51Zu8pN6t/1stktEftx/wTa/YHsfi6sHx2+L8aT6BFJnT7DcGFy6dWlAzhQf4T171/SBaWltY20dlZRrFDEoREQYVVHAAA6AV/Hv+xJ+3N4y/ZO8Wi0ui+oeE9QkX7dYk5KdjLFzw49Ohr+tj4c/Efwb8WPB1l498A30eoaZqEYkiljOevVWHZh0IPIr+TPGXLs6p5p9Zxz5sO9KbXwxX8rXSXd/a3Wmi/t76P8AmHD08l+qZZDkxUdaydueT/mT0vDsl8Oz1d33FFFFfjR/QB4x8dPgN8O/2hvA1x4F+Idms8MgJhmAxLbydnjbqCP1r8RPg3/wSV8Z/wDC9r7T/izMreDNIlEkM8TYfUVPKpgcoAPv+/Ar+iKivrsh43zbKMLWweCq2hUXXXlf80eza0/HdJnwPFHhpkHEGOw+YZlQ5qlJ7rTnXSM/5op6/hs2jD8NeGdA8HaHbeGvC9nFYWFmgjhghUIiKOwArcoor5Oc5Tk5Sd292fd06cacVCCtFaJLZLsgoooqSz//1/7+KKKKACiiigAooooAK8J/aK/aG+H37M/wzvPiX8QrgRwwDbb26kebczH7saDuSep7DmvdW3bTt69s1/Hj/wAFS9c/acu/2hbiw+Psf2fTYWf+w47bd9ha2zw0ZPWQj7+eQfav0Dw44PpcRZssLXqqFOK5pK9pSS6RXfu+i1PzvxN4zrcN5PLF4ei51JPli7XjFv7U327Lq9Dwr9qv9rn4lftZ+Pv+Ev8AG8i29na7ksNPiJ8m2iJ7Ak5Y/wATHrXy/wDacDJNYfn45PFftR/wTX/4Ju6j8aryz+OXxttpLXwtbSrJY2Mi7W1Bl53MD0hB/wC+vpX9jZpmGU8LZT7WolTo01aMVu30jFdW/wDNvqz+HcryTOeLs4dODdSvUd5Tlsl1lJ9Eui9Elsix/wAE8/8Agmpc/Hq3HxZ+OcFxY+F8f6Daj93Jen++eMiMdum76V88ft4fsM+LP2RvGH9p6MJtS8G6gxNnfMMmFj/yxmIAAYfwnuPev7DbGxs9Ms4tP0+JYIIFCRxoNqqq8AADoBXL+P8AwB4R+KHhG+8C+OrGPUNM1CMxTQyjIIPcehHUEdDX8x4PxqzWOdvH11fDS0dJbKPRp/zrdvrtta39V47wCyWeQRy7D6YqOqrPeUuqkv5Hsl9ndXd7/wACwuGHevvT9iL9u7x1+yP4n+wMDqXhPUJVN/YMTlOxlh/uuB+BqH9vD9hXxl+yD4v/ALS03zNT8HajIfsV8VyYSf8AljNjgMOx/iHvX59C6bHav6fjDKeJsqurVcPVX9ecZRfzTP5LdLOeE850vRxNJ/15SjJfJo/v3+GnxJ8HfF3wRp/xC8BXiX2l6lEJYZEPr1Vh2YdCDyDXd1/PD/wRa8KftJW8moeKfPNp8N7kMBBdKT9ouR/Hbgn5QP4m6Gv6Hq/iHjXh6lkmb1svoVlUjF6Nbq/2ZdOZdbfhsf6AcC8SVs9yahmWIoOlOS1T2dvtR68r3V/x3ZRRRXyh9eFFFFABRRRQB//Q/v4ooooAKKKKACiiigAr5u/aj/Zg+HX7VvwyuPh14+i2N/rLO8jA861mHR0Pp2YdCOK+kaK6sDjq+DxEMVhZuFSDumt00cmOwOHxuHnhcVBTpzVpJ7NM/nF/ZW/4I2eINL+MV9rH7Rk0Vz4d0G5H2GCA8anjlXfuiDjcvJJ46V/RfY2FlpdlFpumxJBbwII444wFVEUYAAHAAFW6K9/injHM+Ia8a+Y1L8qsorSK7tLu3q3+iSPn+E+C8q4dw86GW07czvJvWT7Jvstkv1bYUUUV8sfVnEfEb4c+Dvix4Mv/AAB49sY9Q0vUYjFNDIMjB7j0YdQRyDX4HeH/APgiNJB+0LKNe1vzvhzARcxBeLyUEn/R27ADu46jtmv6KKK+r4d42zjI6Vajl1ZxjUVmt7P+aN9pW0uv0R8lxJwNk2e1aFfMqCnKk7p7XX8srbxvrZ/qzn/CnhXw/wCCPDll4R8K2sdlp2nQrBbwRDCoiDAAFdBRRXy05ynJzm7t6tvqfVwhGEVCCsloktkgoooqSgooooAKKKKAP//R/v4ooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAP/Z"), - contactLink = Just (either error id $ strDecode "simplex:/contact/#/?v=1-2&smp=smp%3A%2F%2Fu2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU%3D%40smp4.simplex.im%2FShQuD-rPokbDvkyotKx5NwM8P3oUXHxA%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEA6fSx1k9zrOmF0BJpCaTarZvnZpMTAVQhd3RkDQ35KT0%253D%26srv%3Do5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"), - preferences = Nothing - } - -timeItToView :: String -> CM' a -> CM' a -timeItToView s action = do - t1 <- liftIO getCurrentTime - a <- action - t2 <- liftIO getCurrentTime - let diff = diffToMilliseconds $ diffUTCTime t2 t1 - toView' $ CRTimedAction s diff - pure a - -mkValidName :: String -> String -mkValidName = reverse . dropWhile isSpace . fst3 . foldl' addChar ("", '\NUL', 0 :: Int) - where - fst3 (x, _, _) = x - addChar (r, prev, punct) c = if validChar then (c' : r, c', punct') else (r, prev, punct) - where - c' = if isSpace c then ' ' else c - punct' - | isPunctuation c = punct + 1 - | isSpace c = punct - | otherwise = 0 - validChar - | c == '\'' = False - | prev == '\NUL' = c > ' ' && c /= '#' && c /= '@' && validFirstChar - | isSpace prev = validFirstChar || (punct == 0 && isPunctuation c) - | isPunctuation prev = validFirstChar || isSpace c || (punct < 3 && isPunctuation c) - | otherwise = validFirstChar || isSpace c || isMark c || isPunctuation c - validFirstChar = isLetter c || isNumber c || isSymbol c - -xftpSndFileTransfer_ :: User -> CryptoFile -> Integer -> Int -> Maybe ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta) -xftpSndFileTransfer_ user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup_ = do - let fileName = takeFileName filePath - fInv = xftpFileInvitation fileName fileSize dummyFileDescr - fsFilePath <- lift $ toFSFilePath filePath - let srcFile = CryptoFile fsFilePath cfArgs - aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) srcFile (roundedFDCount n) - -- TODO CRSndFileStart event for XFTP - chSize <- asks $ fileChunkSize . config - ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup_ file fInv (AgentSndFileId aFileId) Nothing chSize - let fileSource = Just $ CryptoFile filePath cfArgs - ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP} - pure (fInv, ciFile, ft) - -xftpSndFileRedirect :: User -> FileTransferId -> ValidFileDescription 'FRecipient -> CM FileTransferMeta -xftpSndFileRedirect user ftId vfd = do - let fileName = "redirect.yaml" - file = CryptoFile fileName Nothing - fInv = xftpFileInvitation fileName (fromIntegral $ B.length $ strEncode vfd) dummyFileDescr - aFileId <- withAgent $ \a -> xftpSendDescription a (aUserId user) vfd (roundedFDCount 1) - chSize <- asks $ fileChunkSize . config - withStore' $ \db -> createSndFileTransferXFTP db user Nothing file fInv (AgentSndFileId aFileId) (Just ftId) chSize - -dummyFileDescr :: FileDescr -dummyFileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 593c328d0c..ffefddd701 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -294,11 +294,17 @@ data ChatCommand | ExecChatStoreSQL Text | ExecAgentStoreSQL Text | SlowSQLQueries + | APIGetChatTags UserId | APIGetChats {userId :: UserId, pendingConnections :: Bool, pagination :: PaginationByTime, query :: ChatListQuery} | APIGetChat ChatRef ChatPagination (Maybe String) | APIGetChatItems ChatPagination (Maybe String) | APIGetChatItemInfo ChatRef ChatItemId | APISendMessages {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage} + | APICreateChatTag ChatTagData + | APISetChatTags ChatRef (Maybe (NonEmpty ChatTagId)) + | APIDeleteChatTag ChatTagId + | APIUpdateChatTag ChatTagId ChatTagData + | APIReorderChatTags (NonEmpty ChatTagId) | APICreateChatItems {noteFolderId :: NoteFolderId, composedMessages :: NonEmpty ComposedMessage} | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent} | APIDeleteChatItem ChatRef (NonEmpty ChatItemId) CIDeleteMode @@ -587,6 +593,7 @@ data ChatResponse | CRApiChats {user :: User, chats :: [AChat]} | CRChats {chats :: [AChat]} | CRApiChat {user :: User, chat :: AChat, navInfo :: Maybe NavigationInfo} + | CRChatTags {user :: User, userTags :: [ChatTag]} | CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]} | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo} | CRChatItemId User (Maybe ChatItemId) @@ -617,6 +624,7 @@ data ChatResponse | CRContactCode {user :: User, contact :: Contact, connectionCode :: Text} | CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text} | CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text} + | CRTagsUpdated {user :: User, userTags :: [ChatTag], chatTags :: [ChatTagId]} | CRNewChatItems {user :: User, chatItems :: [AChatItem]} | CRChatItemsStatusesUpdated {user :: User, chatItems :: [AChatItem]} | CRChatItemUpdated {user :: User, chatItem :: AChatItem} @@ -1068,6 +1076,16 @@ instance FromJSON ComposedMessage where parseJSON invalid = JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid) +data ChatTagData = ChatTagData + { emoji :: Maybe Text, + text :: Text + } + deriving (Show) + +instance FromJSON ChatTagData where + parseJSON (J.Object v) = ChatTagData <$> v .:? "emoji" <*> v .: "text" + parseJSON invalid = JT.prependFailure "bad ChatTagData, " (JT.typeMismatch "Object" invalid) + data NtfConn = NtfConn { user_ :: Maybe User, connEntity_ :: Maybe ConnectionEntity, @@ -1603,3 +1621,5 @@ $(JQ.deriveFromJSON defaultJSON ''ArchiveConfig) $(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig) $(JQ.deriveToJSON defaultJSON ''ComposedMessage) + +$(JQ.deriveToJSON defaultJSON ''ChatTagData) diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 94af3a9dad..37a5d5bf0d 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -21,11 +21,12 @@ import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) import Simplex.Chat import Simplex.Chat.Controller +import Simplex.Chat.Library.Commands import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..)) import Simplex.Chat.Store.Profiles import Simplex.Chat.Types import Simplex.Chat.View (serializeChatResponse) -import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore, withTransaction, MigrationConfirmation (..)) +import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore, withTransaction) import System.Exit (exitFailure) import System.IO (hFlush, stdout) import Text.Read (readMaybe) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs new file mode 100644 index 0000000000..cadf35f580 --- /dev/null +++ b/src/Simplex/Chat/Library/Commands.hs @@ -0,0 +1,3992 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + +module Simplex.Chat.Library.Commands where + +import Control.Applicative (optional, (<|>)) +import Control.Concurrent.STM (retry) +import Control.Logger.Simple +import Control.Monad +import Control.Monad.Except +import Control.Monad.IO.Unlift +import Control.Monad.Reader +import qualified Data.Aeson as J +import Data.Attoparsec.ByteString.Char8 (Parser) +import qualified Data.Attoparsec.ByteString.Char8 as A +import Data.Bifunctor (bimap, first, second) +import qualified Data.ByteArray as BA +import qualified Data.ByteString.Base64 as B64 +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as LB +import Data.Char +import Data.Constraint (Dict (..)) +import Data.Either (fromRight, partitionEithers, rights) +import Data.Foldable (foldr') +import Data.Functor (($>)) +import Data.Int (Int64) +import Data.List (find, foldl', isSuffixOf, partition, sortOn, zipWith4) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as L +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeLatin1, encodeUtf8) +import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime) +import Data.Time.Clock (UTCTime, getCurrentTime, nominalDay) +import Data.Type.Equality +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as V4 +import qualified Database.SQLite.Simple as SQL +import Simplex.Chat.Library.Subscriber +import Simplex.Chat.Archive +import Simplex.Chat.Call +import Simplex.Chat.Controller +import Simplex.Chat.Files +import Simplex.Chat.Markdown +import Simplex.Chat.Messages +import Simplex.Chat.Messages.CIContent +import Simplex.Chat.Messages.CIContent.Events +import Simplex.Chat.Operators +import Simplex.Chat.Options +import Simplex.Chat.ProfileGenerator (generateRandomProfile) +import Simplex.Chat.Protocol +import Simplex.Chat.Remote +import Simplex.Chat.Remote.Types +import Simplex.Chat.Library.Internal +import Simplex.Chat.Stats +import Simplex.Chat.Store +import Simplex.Chat.Store.AppSettings +import Simplex.Chat.Store.Connections +import Simplex.Chat.Store.Direct +import Simplex.Chat.Store.Files +import Simplex.Chat.Store.Groups +import Simplex.Chat.Store.Messages +import Simplex.Chat.Store.NoteFolders +import Simplex.Chat.Store.Profiles +import Simplex.Chat.Store.Shared +import Simplex.Chat.Types +import Simplex.Chat.Types.Preferences +import Simplex.Chat.Types.Shared +import Simplex.Chat.Util (liftIOEither) +import qualified Simplex.Chat.Util as U +import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, maxFileSizeHard) +import Simplex.Messaging.Agent as Agent +import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary) +import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles) +import Simplex.Messaging.Agent.Protocol +import Simplex.Messaging.Agent.Store.SQLite (execSQL, upMigration, withConnection) +import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) +import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations +import Simplex.Messaging.Client (NetworkConfig (..), SocksMode (SMAlways), textToHostMode) +import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) +import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQSupportOff, pattern PQSupportOn) +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Parsers (base64P) +import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol) +import qualified Simplex.Messaging.Protocol as SMP +import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) +import qualified Simplex.Messaging.TMap as TM +import Simplex.Messaging.Transport.Client (defaultSocksProxyWithAuth) +import Simplex.Messaging.Util +import Simplex.Messaging.Version +import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..)) +import Simplex.RemoteControl.Types (RCCtrlAddress (..)) +import System.Exit (ExitCode, exitSuccess) +import System.FilePath (takeFileName, ()) +import System.IO (Handle, IOMode (..)) +import System.Random (randomRIO) +import UnliftIO.Async +import UnliftIO.Concurrent (forkIO, threadDelay) +import UnliftIO.Directory +import qualified UnliftIO.Exception as E +import UnliftIO.IO (hClose) +import UnliftIO.STM + +_defaultNtfServers :: [NtfServer] +_defaultNtfServers = + [ "ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,5ex3mupcazy3zlky64ab27phjhijpemsiby33qzq3pliejipbtx5xgad.onion" + -- "ntf://KmpZNNXiVZJx_G2T7jRUmDFxWXM3OAnunz3uLT0tqAA=@ntf3.simplex.im,pxculznuryunjdvtvh6s6szmanyadumpbmvevgdpe4wk5c65unyt4yid.onion", + -- "ntf://CJ5o7X6fCxj2FFYRU2KuCo70y4jSqz7td2HYhLnXWbU=@ntf4.simplex.im,wtvuhdj26jwprmomnyfu5wfuq2hjkzfcc72u44vi6gdhrwxldt6xauad.onion" + ] + +maxImageSize :: Integer +maxImageSize = 261120 * 2 -- auto-receive on mobiles + +imageExtensions :: [String] +imageExtensions = [".jpg", ".jpeg", ".png", ".gif"] + +fixedImagePreview :: ImageData +fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg==" + +-- enableSndFiles has no effect when mainApp is True +startChatController :: Bool -> Bool -> CM' (Async ()) +startChatController mainApp enableSndFiles = do + asks smpAgent >>= liftIO . resumeAgentClient + unless mainApp $ chatWriteVar' subscriptionMode SMOnlyCreate + users <- fromRight [] <$> runExceptT (withFastStore' getUsers) + restoreCalls + s <- asks agentAsync + readTVarIO s >>= maybe (start s users) (pure . fst) + where + start s users = do + a1 <- async agentSubscriber + a2 <- + if mainApp + then Just <$> async (subscribeUsers False users) + else pure Nothing + atomically . writeTVar s $ Just (a1, a2) + if mainApp + then do + startXFTP xftpStartWorkers + void $ forkIO $ startFilesToReceive users + startCleanupManager + void $ forkIO $ startExpireCIs users + else when enableSndFiles $ startXFTP xftpStartSndWorkers + pure a1 + startXFTP startWorkers = do + tmp <- readTVarIO =<< asks tempDirectory + runExceptT (withAgent $ \a -> startWorkers a tmp) >>= \case + Left e -> liftIO $ putStrLn $ "Error starting XFTP workers: " <> show e + Right _ -> pure () + startCleanupManager = do + cleanupAsync <- asks cleanupManagerAsync + readTVarIO cleanupAsync >>= \case + Nothing -> do + a <- Just <$> async (void $ runExceptT cleanupManager) + atomically $ writeTVar cleanupAsync a + _ -> pure () + startExpireCIs users = + forM_ users $ \user -> do + ttl <- fromRight Nothing <$> runExceptT (withStore' (`getChatItemTTL` user)) + forM_ ttl $ \_ -> do + startExpireCIThread user + setExpireCIFlag user True + +subscribeUsers :: Bool -> [User] -> CM' () +subscribeUsers onlyNeeded users = do + let (us, us') = partition activeUser users + vr <- chatVersionRange' + subscribe vr us + subscribe vr us' + where + subscribe :: VersionRangeChat -> [User] -> CM' () + subscribe vr = mapM_ $ runExceptT . subscribeUserConnections vr onlyNeeded Agent.subscribeConnections + +startFilesToReceive :: [User] -> CM' () +startFilesToReceive users = do + let (us, us') = partition activeUser users + startReceive us + startReceive us' + where + startReceive :: [User] -> CM' () + startReceive = mapM_ $ runExceptT . startReceiveUserFiles + +startReceiveUserFiles :: User -> CM () +startReceiveUserFiles user = do + filesToReceive <- withStore' (`getRcvFilesToReceive` user) + forM_ filesToReceive $ \ft -> + flip catchChatError (toView . CRChatError (Just user)) $ + toView =<< receiveFile' user ft False Nothing Nothing + +restoreCalls :: CM' () +restoreCalls = do + savedCalls <- fromRight [] <$> runExceptT (withFastStore' getCalls) + let callsMap = M.fromList $ map (\call@Call {contactId} -> (contactId, call)) savedCalls + calls <- asks currentCalls + atomically $ writeTVar calls callsMap + +stopChatController :: ChatController -> IO () +stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIFlags, remoteHostSessions, remoteCtrlSession} = do + readTVarIO remoteHostSessions >>= mapM_ (cancelRemoteHost False . snd) + atomically (stateTVar remoteCtrlSession (,Nothing)) >>= mapM_ (cancelRemoteCtrl False . snd) + disconnectAgentClient smpAgent + readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2) + closeFiles sndFiles + closeFiles rcvFiles + atomically $ do + keys <- M.keys <$> readTVar expireCIFlags + forM_ keys $ \k -> TM.insert k False expireCIFlags + writeTVar s Nothing + where + closeFiles :: TVar (Map Int64 Handle) -> IO () + closeFiles files = do + fs <- readTVarIO files + mapM_ hClose fs + atomically $ writeTVar files M.empty + +updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig +updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} = + let cfg1 = maybe cfg (\smpProxyMode -> cfg {smpProxyMode}) smpProxyMode_ + cfg2 = maybe cfg1 (\smpProxyFallback -> cfg1 {smpProxyFallback}) smpProxyFallback_ + cfg3 = maybe cfg2 (\tcpTimeout -> cfg2 {tcpTimeout, tcpConnectTimeout = (tcpTimeout * 3) `div` 2}) tcpTimeout_ + in cfg3 {socksProxy, socksMode, hostMode, requiredHostMode, smpWebPort, logTLSErrors} + +useServers :: Foldable f => RandomAgentServers -> [(Text, ServerOperator)] -> f UserOperatorServers -> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)) +useServers as opDomains uss = + let smp' = useServerCfgs SPSMP as opDomains $ concatMap (servers' SPSMP) uss + xftp' = useServerCfgs SPXFTP as opDomains $ concatMap (servers' SPXFTP) uss + in (smp', xftp') + +execChatCommand :: Maybe RemoteHostId -> ByteString -> CM' ChatResponse +execChatCommand rh s = do + u <- readTVarIO =<< asks currentUser + case parseChatCommand s of + Left e -> pure $ chatCmdError u e + Right cmd -> case rh of + Just rhId + | allowRemoteCommand cmd -> execRemoteCommand u rhId cmd s + | otherwise -> pure $ CRChatCmdError u $ ChatErrorRemoteHost (RHId rhId) $ RHELocalCommand + _ -> do + cc@ChatController {config = ChatConfig {chatHooks}} <- ask + liftIO (preCmdHook chatHooks cc cmd) >>= either pure (execChatCommand_ u) + +execChatCommand' :: ChatCommand -> CM' ChatResponse +execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd) + +execChatCommand_ :: Maybe User -> ChatCommand -> CM' ChatResponse +execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd + +execRemoteCommand :: Maybe User -> RemoteHostId -> ChatCommand -> ByteString -> CM' ChatResponse +execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostClient rhId >>= \rh -> processRemoteCommand rhId rh cmd s + +handleCommandError :: Maybe User -> CM ChatResponse -> CM' ChatResponse +handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catches` ioErrors) + where + ioErrors = + [ E.Handler $ \(e :: ExitCode) -> E.throwIO e, + E.Handler $ pure . Left . mkChatError + ] + +parseChatCommand :: ByteString -> Either String ChatCommand +parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace + +-- | Chat API commands interpreted in context of a local zone +processChatCommand :: ChatCommand -> CM ChatResponse +processChatCommand cmd = + chatVersionRange >>= (`processChatCommand'` cmd) +{-# INLINE processChatCommand #-} + +processChatCommand' :: VersionRangeChat -> ChatCommand -> CM ChatResponse +processChatCommand' vr = \case + ShowActiveUser -> withUser' $ pure . CRActiveUser + CreateActiveUser NewUser {profile, pastTimestamp} -> do + forM_ profile $ \Profile {displayName} -> checkValidName displayName + p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile + u <- asks currentUser + users <- withFastStore' getUsers + forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} -> + when (n == displayName) . throwChatError $ + if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""} + (uss, (smp', xftp')) <- chooseServers =<< readTVarIO u + auId <- withAgent $ \a -> createUser a smp' xftp' + ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure + user <- withFastStore $ \db -> do + user <- createUserRecordAt db (AgentUserId auId) p True ts + mapM_ (setUserServers db user ts) uss + createPresetContactCards db user `catchStoreError` \_ -> pure () + createNoteFolder db user + pure user + atomically . writeTVar u $ Just user + pure $ CRActiveUser user + where + createPresetContactCards :: DB.Connection -> User -> ExceptT StoreError IO () + createPresetContactCards db user = do + createContact db user simplexStatusContactProfile + createContact db user simplexTeamContactProfile + chooseServers :: Maybe User -> CM ([UpdatedUserOperatorServers], (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))) + chooseServers user_ = do + as <- asks randomAgentServers + mapM (withFastStore . flip getUserServers >=> liftIO . groupByOperator) user_ >>= \case + Just uss -> do + let opDomains = operatorDomains $ mapMaybe operator' uss + uss' = map copyServers uss + pure $ (uss',) $ useServers as opDomains uss + Nothing -> do + ps <- asks randomPresetServers + uss <- presetUserServers <$> withFastStore' (\db -> getUpdateServerOperators db ps True) + let RandomAgentServers {smpServers = smp', xftpServers = xftp'} = as + pure (uss, (smp', xftp')) + copyServers :: UserOperatorServers -> UpdatedUserOperatorServers + copyServers UserOperatorServers {operator, smpServers, xftpServers} = + let new srv = AUS SDBNew srv {serverId = DBNewEntity} + in UpdatedUserOperatorServers {operator, smpServers = map new smpServers, xftpServers = map new xftpServers} + coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day) + day = 86400 + ListUsers -> CRUsersList <$> withFastStore' getUsersInfo + APISetActiveUser userId' viewPwd_ -> do + unlessM (lift chatStarted) $ throwChatError CEChatNotStarted + user_ <- chatReadVar currentUser + user' <- privateGetUser userId' + validateUserPassword_ user_ user' viewPwd_ + user'' <- withFastStore' (`setActiveUser` user') + chatWriteVar currentUser $ Just user'' + pure $ CRActiveUser user'' + SetActiveUser uName viewPwd_ -> do + tryChatError (withFastStore (`getUserIdByName` uName)) >>= \case + Left _ -> throwChatError CEUserUnknown + Right userId -> processChatCommand $ APISetActiveUser userId viewPwd_ + SetAllContactReceipts onOff -> withUser $ \_ -> withFastStore' (`updateAllContactReceipts` onOff) >> ok_ + APISetUserContactReceipts userId' settings -> withUser $ \user -> do + user' <- privateGetUser userId' + validateUserPassword user user' Nothing + withFastStore' $ \db -> updateUserContactReceipts db user' settings + ok user + SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserContactReceipts userId settings + APISetUserGroupReceipts userId' settings -> withUser $ \user -> do + user' <- privateGetUser userId' + validateUserPassword user user' Nothing + withFastStore' $ \db -> updateUserGroupReceipts db user' settings + ok user + SetUserGroupReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserGroupReceipts userId settings + APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do + user' <- privateGetUser userId' + case viewPwdHash user' of + Just _ -> throwChatError $ CEUserAlreadyHidden userId' + _ -> do + when (T.null viewPwd) $ throwChatError $ CEEmptyUserPassword userId' + users <- withFastStore' getUsers + unless (length (filter (isNothing . viewPwdHash) users) > 1) $ throwChatError $ CECantHideLastUser userId' + viewPwdHash' <- hashPassword + setUserPrivacy user user' {viewPwdHash = viewPwdHash', showNtfs = False} + where + hashPassword = do + salt <- drgRandomBytes 16 + let hash = B64UrlByteString $ C.sha512Hash $ encodeUtf8 viewPwd <> salt + pure $ Just UserPwdHash {hash, salt = B64UrlByteString salt} + APIUnhideUser userId' viewPwd@(UserPwd pwd) -> withUser $ \user -> do + user' <- privateGetUser userId' + case viewPwdHash user' of + Nothing -> throwChatError $ CEUserNotHidden userId' + _ -> do + when (T.null pwd) $ throwChatError $ CEEmptyUserPassword userId' + validateUserPassword user user' $ Just viewPwd + setUserPrivacy user user' {viewPwdHash = Nothing, showNtfs = True} + APIMuteUser userId' -> setUserNotifications userId' False + APIUnmuteUser userId' -> setUserNotifications userId' True + HideUser viewPwd -> withUser $ \User {userId} -> processChatCommand $ APIHideUser userId viewPwd + UnhideUser viewPwd -> withUser $ \User {userId} -> processChatCommand $ APIUnhideUser userId viewPwd + MuteUser -> withUser $ \User {userId} -> processChatCommand $ APIMuteUser userId + UnmuteUser -> withUser $ \User {userId} -> processChatCommand $ APIUnmuteUser userId + APIDeleteUser userId' delSMPQueues viewPwd_ -> withUser $ \user -> do + user' <- privateGetUser userId' + validateUserPassword user user' viewPwd_ + checkDeleteChatUser user' + withChatLock "deleteUser" . procCmd $ deleteChatUser user' delSMPQueues + DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_ + StartChat {mainApp, enableSndFiles} -> withUser' $ \_ -> + asks agentAsync >>= readTVarIO >>= \case + Just _ -> pure CRChatRunning + _ -> checkStoreNotChanged . lift $ startChatController mainApp enableSndFiles $> CRChatStarted + CheckChatRunning -> maybe CRChatStopped (const CRChatRunning) <$> chatReadVar agentAsync + APIStopChat -> do + ask >>= liftIO . stopChatController + pure CRChatStopped + APIActivateChat restoreChat -> withUser $ \_ -> do + lift $ when restoreChat restoreCalls + lift $ withAgent' foregroundAgent + chatWriteVar chatActivated True + when restoreChat $ do + users <- withFastStore' getUsers + lift $ do + void . forkIO $ subscribeUsers True users + void . forkIO $ startFilesToReceive users + setAllExpireCIFlags True + ok_ + APISuspendChat t -> do + chatWriteVar chatActivated False + lift $ setAllExpireCIFlags False + stopRemoteCtrl + lift $ withAgent' (`suspendAgent` t) + ok_ + ResubscribeAllConnections -> withStore' getUsers >>= lift . subscribeUsers False >> ok_ + -- has to be called before StartChat + SetTempFolder tf -> do + createDirectoryIfMissing True tf + asks tempDirectory >>= atomically . (`writeTVar` Just tf) + ok_ + SetFilesFolder ff -> do + createDirectoryIfMissing True ff + asks filesFolder >>= atomically . (`writeTVar` Just ff) + ok_ + SetRemoteHostsFolder rf -> do + createDirectoryIfMissing True rf + chatWriteVar remoteHostsFolder $ Just rf + ok_ + -- has to be called before StartChat + APISetAppFilePaths cfg -> do + setFolder filesFolder $ appFilesFolder cfg + setFolder tempDirectory $ appTempFolder cfg + setFolder assetsDirectory $ appAssetsFolder cfg + mapM_ (setFolder remoteHostsFolder) $ appRemoteHostsFolder cfg + ok_ + where + setFolder sel f = do + createDirectoryIfMissing True f + chatWriteVar sel $ Just f + APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_ + SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_ + APIExportArchive cfg -> checkChatStopped $ CRArchiveExported <$> lift (exportArchive cfg) + ExportArchive -> do + ts <- liftIO getCurrentTime + let filePath = "simplex-chat." <> formatTime defaultTimeLocale "%FT%H%M%SZ" ts <> ".zip" + processChatCommand $ APIExportArchive $ ArchiveConfig filePath Nothing Nothing + APIImportArchive cfg -> checkChatStopped $ do + fileErrs <- lift $ importArchive cfg + setStoreChanged + pure $ CRArchiveImported fileErrs + APISaveAppSettings as -> withFastStore' (`saveAppSettings` as) >> ok_ + APIGetAppSettings platformDefaults -> CRAppSettings <$> withFastStore' (`getAppSettings` platformDefaults) + APIDeleteStorage -> withStoreChanged deleteStorage + APIStorageEncryption cfg -> withStoreChanged $ sqlCipherExport cfg + TestStorageEncryption key -> sqlCipherTestKey key >> ok_ + ExecChatStoreSQL query -> CRSQLResult <$> withStore' (`execSQL` query) + ExecAgentStoreSQL query -> CRSQLResult <$> withAgent (`execAgentStoreSQL` query) + SlowSQLQueries -> do + ChatController {chatStore, smpAgent} <- ask + chatQueries <- slowQueries chatStore + agentQueries <- slowQueries $ agentClientStore smpAgent + pure CRSlowSQLQueries {chatQueries, agentQueries} + where + slowQueries st = + liftIO $ + map (uncurry SlowSQLQuery . first SQL.fromQuery) + . sortOn (timeAvg . snd) + . M.assocs + <$> withConnection st (readTVarIO . DB.slow) + APIGetChatTags userId -> withUserId' userId $ \user -> do + tags <- withFastStore' (`getUserChatTags` user) + pure $ CRChatTags user tags + APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do + (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user pendingConnections pagination query) + unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs) + pure $ CRApiChats user previews + APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of + -- TODO optimize queries calculating ChatStats, currently they're disabled + CTDirect -> do + (directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId pagination search) + pure $ CRApiChat user (AChat SCTDirect directChat) navInfo + CTGroup -> do + (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId pagination search) + pure $ CRApiChat user (AChat SCTGroup groupChat) navInfo + CTLocal -> do + (localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search) + pure $ CRApiChat user (AChat SCTLocal localChat) navInfo + CTContactRequest -> pure $ chatCmdError (Just user) "not implemented" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + APIGetChatItems pagination search -> withUser $ \user -> do + chatItems <- withFastStore $ \db -> getAllChatItems db vr user pagination search + pure $ CRChatItems user Nothing chatItems + APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do + (aci@(AChatItem cType dir _ ci), versions) <- withFastStore $ \db -> + (,) <$> getAChatItem db vr user chatRef itemId <*> liftIO (getChatItemVersions db itemId) + let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions + memberDeliveryStatuses <- case (cType, dir) of + (SCTGroup, SMDSnd) -> L.nonEmpty <$> withFastStore' (`getGroupSndStatuses` itemId) + _ -> pure Nothing + forwardedFromChatItem <- getForwardedFromItem user ci + pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses, forwardedFromChatItem} + where + getForwardedFromItem :: User -> ChatItem c d -> CM (Maybe AChatItem) + getForwardedFromItem user ChatItem {meta = CIMeta {itemForwarded}} = case itemForwarded of + Just (CIFFContact _ _ (Just ctId) (Just fwdItemId)) -> + Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTDirect ctId) fwdItemId) + Just (CIFFGroup _ _ (Just gId) (Just fwdItemId)) -> + Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTGroup gId) fwdItemId) + _ -> pure Nothing + APISendMessages (ChatRef cType chatId) live itemTTL cms -> withUser $ \user -> case cType of + CTDirect -> + withContactLock "sendMessage" chatId $ + sendContactContentMessages user chatId live itemTTL (L.map (,Nothing) cms) + CTGroup -> + withGroupLock "sendMessage" chatId $ + sendGroupContentMessages user chatId live itemTTL (L.map (,Nothing) cms) + CTLocal -> pure $ chatCmdError (Just user) "not supported" + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + APICreateChatTag (ChatTagData emoji text) -> withUser $ \user -> withFastStore' $ \db -> do + _ <- createChatTag db user emoji text + CRChatTags user <$> getUserChatTags db user + APISetChatTags (ChatRef cType chatId) tagIds -> withUser $ \user -> withFastStore' $ \db -> case cType of + CTDirect -> do + updateDirectChatTags db chatId (maybe [] L.toList tagIds) + CRTagsUpdated user <$> getUserChatTags db user <*> getDirectChatTags db chatId + CTGroup -> do + updateGroupChatTags db chatId (maybe [] L.toList tagIds) + CRTagsUpdated user <$> getUserChatTags db user <*> getGroupChatTags db chatId + _ -> pure $ chatCmdError (Just user) "not supported" + APIDeleteChatTag tagId -> withUser $ \user -> do + withFastStore' $ \db -> deleteChatTag db user tagId + ok user + APIUpdateChatTag tagId (ChatTagData emoji text) -> withUser $ \user -> do + withFastStore' $ \db -> updateChatTag db user tagId emoji text + ok user + APIReorderChatTags tagIds -> withUser $ \user -> do + withFastStore' $ \db -> reorderChatTags db user $ L.toList tagIds + ok user + APICreateChatItems folderId cms -> withUser $ \user -> + createNoteFolderContentItems user folderId (L.map (,Nothing) cms) + APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> case cType of + CTDirect -> withContactLock "updateChatItem" chatId $ do + ct@Contact {contactId} <- withFastStore $ \db -> getContact db vr user chatId + assertDirectAllowed user MDSnd ct XMsgUpdate_ + cci <- withFastStore $ \db -> getDirectCIWithReactions db user ct itemId + case cci of + CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do + case (ciContent, itemSharedMsgId, editable) of + (CISndMsgContent oldMC, Just itemSharedMId, True) -> do + let changed = mc /= oldMC + if changed || fromMaybe False itemLive + then do + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) + ci' <- withFastStore' $ \db -> do + currentTs <- liftIO getCurrentTime + when changed $ + addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) + let edited = itemLive /= Just True + updateDirectChatItem' db user contactId ci (CISndMsgContent mc) edited live Nothing $ Just msgId + startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' + pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci') + else pure $ CRChatItemNotChanged user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) + _ -> throwChatError CEInvalidChatItemUpdate + CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate + CTGroup -> withGroupLock "updateChatItem" chatId $ do + Group gInfo@GroupInfo {groupId, membership} ms <- withFastStore $ \db -> getGroup db vr user chatId + assertUserGroupRole gInfo GRAuthor + if prohibitedSimplexLinks gInfo membership mc + then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFSimplexLinks)) + else do + cci <- withFastStore $ \db -> getGroupCIWithReactions db user gInfo itemId + case cci of + CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do + case (ciContent, itemSharedMsgId, editable) of + (CISndMsgContent oldMC, Just itemSharedMId, True) -> do + let changed = mc /= oldMC + if changed || fromMaybe False itemLive + then do + SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) + ci' <- withFastStore' $ \db -> do + currentTs <- liftIO getCurrentTime + when changed $ + addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) + let edited = itemLive /= Just True + updateGroupChatItem db user groupId ci (CISndMsgContent mc) edited live $ Just msgId + startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' + pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci') + else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) + _ -> throwChatError CEInvalidChatItemUpdate + CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate + CTLocal -> do + (nf@NoteFolder {noteFolderId}, cci) <- withFastStore $ \db -> (,) <$> getNoteFolder db user chatId <*> getLocalChatItem db user chatId itemId + case cci of + CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent oldMC} + | mc == oldMC -> pure $ CRChatItemNotChanged user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci) + | otherwise -> withFastStore' $ \db -> do + currentTs <- getCurrentTime + addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) + ci' <- updateLocalChatItem' db user noteFolderId ci (CISndMsgContent mc) True + pure $ CRChatItemUpdated user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci') + _ -> throwChatError CEInvalidChatItemUpdate + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + APIDeleteChatItem (ChatRef cType chatId) itemIds mode -> withUser $ \user -> case cType of + CTDirect -> withContactLock "deleteChatItem" chatId $ do + (ct, items) <- getCommandDirectChatItems user chatId itemIds + case mode of + CIDMInternal -> deleteDirectCIs user ct items True False + CIDMBroadcast -> do + assertDeletable items + assertDirectAllowed user MDSnd ct XMsgDel_ + let msgIds = itemsMsgIds items + events = map (\msgId -> XMsgDel msgId Nothing) msgIds + forM_ (L.nonEmpty events) $ \events' -> + sendDirectContactMessages user ct events' + if featureAllowed SCFFullDelete forUser ct + then deleteDirectCIs user ct items True False + else markDirectCIsDeleted user ct items True =<< liftIO getCurrentTime + CTGroup -> withGroupLock "deleteChatItem" chatId $ do + (gInfo, items) <- getCommandGroupChatItems user chatId itemIds + ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo + case mode of + CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime + CIDMBroadcast -> do + assertDeletable items + assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier + let msgIds = itemsMsgIds items + events = L.nonEmpty $ map (`XMsgDel` Nothing) msgIds + mapM_ (sendGroupMessages user gInfo ms) events + delGroupChatItems user gInfo items Nothing + CTLocal -> do + (nf, items) <- getCommandLocalChatItems user chatId itemIds + deleteLocalCIs user nf items True False + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + where + assertDeletable :: forall c. ChatTypeI c => [CChatItem c] -> CM () + assertDeletable items = do + currentTs <- liftIO getCurrentTime + unless (all (itemDeletable currentTs) items) $ throwChatError CEInvalidChatItemDelete + where + itemDeletable :: UTCTime -> CChatItem c -> Bool + itemDeletable currentTs (CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, itemTs, itemDeleted}, content}) = + case msgDir of + -- We check with a 6 hour margin compared to CIMeta deletable to account for deletion on the border + SMDSnd -> isJust itemSharedMsgId && deletable' content itemDeleted itemTs (nominalDay + 6 * 3600) currentTs + SMDRcv -> False + itemsMsgIds :: [CChatItem c] -> [SharedMsgId] + itemsMsgIds = mapMaybe (\(CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId}}) -> itemSharedMsgId) + APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do + (gInfo@GroupInfo {membership}, items) <- getCommandGroupChatItems user gId itemIds + ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo + assertDeletable gInfo items + assertUserGroupRole gInfo GRAdmin + let msgMemIds = itemsMsgMemIds gInfo items + events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds + mapM_ (sendGroupMessages user gInfo ms) events + delGroupChatItems user gInfo items (Just membership) + where + assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM () + assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items = + unless (all itemDeletable items) $ throwChatError CEInvalidChatItemDelete + where + itemDeletable :: CChatItem 'CTGroup -> Bool + itemDeletable (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = + case chatDir of + CIGroupRcv GroupMember {memberRole} -> membershipMemRole >= memberRole && isJust itemSharedMsgId + CIGroupSnd -> isJust itemSharedMsgId + itemsMsgMemIds :: GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)] + itemsMsgMemIds GroupInfo {membership = GroupMember {memberId = membershipMemId}} = mapMaybe itemMsgMemIds + where + itemMsgMemIds :: CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId) + itemMsgMemIds (CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = + join <$> forM itemSharedMsgId $ \msgId -> Just $ case chatDir of + CIGroupRcv GroupMember {memberId} -> (msgId, memberId) + CIGroupSnd -> (msgId, membershipMemId) + APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> case cType of + CTDirect -> + withContactLock "chatItemReaction" chatId $ + withFastStore (\db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId) >>= \case + (ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do + unless (featureAllowed SCFReactions forUser ct) $ + throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)) + unless (ciReactionAllowed ci) $ + throwChatError (CECommandError "reaction not allowed - chat item has no content") + rs <- withFastStore' $ \db -> getDirectReactions db ct itemSharedMId True + checkReactionAllowed rs + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct $ XMsgReact itemSharedMId Nothing reaction add + createdAt <- liftIO getCurrentTime + reactions <- withFastStore' $ \db -> do + setDirectReaction db ct itemSharedMId True reaction add msgId createdAt + liftIO $ getDirectCIReactions db ct itemSharedMId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTDirect SMDSnd (DirectChat ct) $ CIReaction CIDirectSnd ci' createdAt reaction + pure $ CRChatItemReaction user add r + _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" + CTGroup -> + withGroupLock "chatItemReaction" chatId $ + withFastStore (\db -> (,) <$> getGroup db vr user chatId <*> getGroupChatItem db user chatId itemId) >>= \case + (Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do + unless (groupFeatureAllowed SGFReactions g) $ + throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)) + unless (ciReactionAllowed ci) $ + throwChatError (CECommandError "reaction not allowed - chat item has no content") + let GroupMember {memberId = itemMemberId} = chatItemMember g ci + rs <- withFastStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True + checkReactionAllowed rs + SndMessage {msgId} <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add) + createdAt <- liftIO getCurrentTime + reactions <- withFastStore' $ \db -> do + setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt + liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction + pure $ CRChatItemReaction user add r + _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" + CTLocal -> pure $ chatCmdError (Just user) "not supported" + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + where + checkReactionAllowed rs = do + when ((reaction `elem` rs) == add) $ + throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed") + when (add && length rs >= maxMsgReactions) $ + throwChatError (CECommandError "too many reactions") + APIGetReactionMembers userId groupId itemId reaction -> withUserId userId $ \user -> do + memberReactions <- withStore $ \db -> do + CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}} <- getGroupChatItem db user groupId itemId + liftIO $ getReactionMembers db vr user groupId itemSharedMId reaction + pure $ CRReactionMembers user memberReactions + APIPlanForwardChatItems (ChatRef fromCType fromChatId) itemIds -> withUser $ \user -> case fromCType of + CTDirect -> planForward user . snd =<< getCommandDirectChatItems user fromChatId itemIds + CTGroup -> planForward user . snd =<< getCommandGroupChatItems user fromChatId itemIds + CTLocal -> planForward user . snd =<< getCommandLocalChatItems user fromChatId itemIds + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + where + planForward :: User -> [CChatItem c] -> CM ChatResponse + planForward user items = do + (itemIds', forwardErrors) <- unzip <$> mapM planItemForward items + let forwardConfirmation = case catMaybes forwardErrors of + [] -> Nothing + errs -> Just $ case mainErr of + FFENotAccepted _ -> FCFilesNotAccepted fileIds + FFEInProgress -> FCFilesInProgress filesCount + FFEMissing -> FCFilesMissing filesCount + FFEFailed -> FCFilesFailed filesCount + where + mainErr = minimum errs + fileIds = catMaybes $ map (\case FFENotAccepted ftId -> Just ftId; _ -> Nothing) errs + filesCount = length $ filter (mainErr ==) errs + pure CRForwardPlan {user, itemsCount = length itemIds, chatItemIds = catMaybes itemIds', forwardConfirmation} + where + planItemForward :: CChatItem c -> CM (Maybe ChatItemId, Maybe ForwardFileError) + planItemForward (CChatItem _ ci) = forwardMsgContent ci >>= maybe (pure (Nothing, Nothing)) (forwardContentPlan ci) + forwardContentPlan :: ChatItem c d -> MsgContent -> CM (Maybe ChatItemId, Maybe ForwardFileError) + forwardContentPlan ChatItem {file, meta = CIMeta {itemId}} mc = case file of + Nothing -> pure (Just itemId, Nothing) + Just CIFile {fileId, fileStatus, fileSource} -> case ciFileForwardError fileId fileStatus of + Just err -> pure $ itemIdWithoutFile err + Nothing -> case fileSource of + Just CryptoFile {filePath} -> do + exists <- doesFileExist =<< lift (toFSFilePath filePath) + pure $ if exists then (Just itemId, Nothing) else itemIdWithoutFile FFEMissing + Nothing -> pure $ itemIdWithoutFile FFEMissing + where + itemIdWithoutFile err = (if hasContent then Just itemId else Nothing, Just err) + hasContent = case mc of + MCText _ -> True + MCLink {} -> True + MCImage {} -> True + MCVideo {text} -> text /= "" + MCVoice {text} -> text /= "" + MCFile t -> t /= "" + MCUnknown {} -> True + APIForwardChatItems (ChatRef toCType toChatId) (ChatRef fromCType fromChatId) itemIds itemTTL -> withUser $ \user -> case toCType of + CTDirect -> do + cmrs <- prepareForward user + case L.nonEmpty cmrs of + Just cmrs' -> + withContactLock "forwardChatItem, to contact" toChatId $ + sendContactContentMessages user toChatId False itemTTL cmrs' + Nothing -> pure $ CRNewChatItems user [] + CTGroup -> do + cmrs <- prepareForward user + case L.nonEmpty cmrs of + Just cmrs' -> + withGroupLock "forwardChatItem, to group" toChatId $ + sendGroupContentMessages user toChatId False itemTTL cmrs' + Nothing -> pure $ CRNewChatItems user [] + CTLocal -> do + cmrs <- prepareForward user + case L.nonEmpty cmrs of + Just cmrs' -> + createNoteFolderContentItems user toChatId cmrs' + Nothing -> pure $ CRNewChatItems user [] + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + where + prepareForward :: User -> CM [ComposeMessageReq] + prepareForward user = case fromCType of + CTDirect -> withContactLock "forwardChatItem, from contact" fromChatId $ do + (ct, items) <- getCommandDirectChatItems user fromChatId itemIds + catMaybes <$> mapM (\ci -> ciComposeMsgReq ct ci <$$> prepareMsgReq ci) items + where + ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq + ciComposeMsgReq ct (CChatItem md ci) (mc', file) = + let itemId = chatItemId' ci + ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) (toMsgDirection md) (Just fromChatId) (Just itemId)) + in (ComposedMessage file Nothing mc', ciff) + where + forwardName :: Contact -> ContactName + forwardName Contact {profile = LocalProfile {displayName, localAlias}} + | localAlias /= "" = localAlias + | otherwise = displayName + CTGroup -> withGroupLock "forwardChatItem, from group" fromChatId $ do + (gInfo, items) <- getCommandGroupChatItems user fromChatId itemIds + catMaybes <$> mapM (\ci -> ciComposeMsgReq gInfo ci <$$> prepareMsgReq ci) items + where + ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq + ciComposeMsgReq gInfo (CChatItem md ci) (mc', file) = do + let itemId = chatItemId' ci + ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) (toMsgDirection md) (Just fromChatId) (Just itemId)) + in (ComposedMessage file Nothing mc', ciff) + where + forwardName :: GroupInfo -> ContactName + forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName + CTLocal -> do + (_, items) <- getCommandLocalChatItems user fromChatId itemIds + catMaybes <$> mapM (\ci -> ciComposeMsgReq ci <$$> prepareMsgReq ci) items + where + ciComposeMsgReq :: CChatItem 'CTLocal -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq + ciComposeMsgReq (CChatItem _ ci) (mc', file) = + let ciff = forwardCIFF ci Nothing + in (ComposedMessage file Nothing mc', ciff) + CTContactRequest -> throwChatError $ CECommandError "not supported" + CTContactConnection -> throwChatError $ CECommandError "not supported" + where + prepareMsgReq :: CChatItem c -> CM (Maybe (MsgContent, Maybe CryptoFile)) + prepareMsgReq (CChatItem _ ci) = forwardMsgContent ci $>>= forwardContent ci + forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom + forwardCIFF ChatItem {meta = CIMeta {itemForwarded}} ciff = case itemForwarded of + Nothing -> ciff + Just CIFFUnknown -> ciff + Just prevCIFF -> Just prevCIFF + forwardContent :: ChatItem c d -> MsgContent -> CM (Maybe (MsgContent, Maybe CryptoFile)) + forwardContent ChatItem {file} mc = case file of + Nothing -> pure $ Just (mc, Nothing) + Just CIFile {fileName, fileStatus, fileSource = Just fromCF@CryptoFile {filePath}} + | ciFileLoaded fileStatus -> + chatReadVar filesFolder >>= \case + Nothing -> + ifM (doesFileExist filePath) (pure $ Just (mc, Just fromCF)) (pure contentWithoutFile) + Just filesFolder -> do + let fsFromPath = filesFolder filePath + ifM + (doesFileExist fsFromPath) + ( do + fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName + liftIO $ B.writeFile fsNewPath "" -- create empty file + encrypt <- chatReadVar encryptLocalFiles + cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing + let toCF = CryptoFile fsNewPath cfArgs + -- to keep forwarded file in case original is deleted + liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ copyCryptoFile (fromCF {filePath = fsFromPath} :: CryptoFile) toCF + pure $ Just (mc, Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile)) + ) + (pure contentWithoutFile) + _ -> pure contentWithoutFile + where + contentWithoutFile = case mc of + MCImage {} -> Just (mc, Nothing) + MCLink {} -> Just (mc, Nothing) + _ | contentText /= "" -> Just (MCText contentText, Nothing) + _ -> Nothing + contentText = msgContentText mc + copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT CF.FTCryptoError IO () + copyCryptoFile fromCF@CryptoFile {filePath = fsFromPath, cryptoArgs = fromArgs} toCF@CryptoFile {cryptoArgs = toArgs} = do + fromSizeFull <- getFileSize fsFromPath + let fromSize = fromSizeFull - maybe 0 (const $ toInteger C.authTagSize) fromArgs + CF.withFile fromCF ReadMode $ \fromH -> + CF.withFile toCF WriteMode $ \toH -> do + copyChunks fromH toH fromSize + forM_ fromArgs $ \_ -> CF.hGetTag fromH + forM_ toArgs $ \_ -> liftIO $ CF.hPutTag toH + where + copyChunks :: CF.CryptoFileHandle -> CF.CryptoFileHandle -> Integer -> ExceptT CF.FTCryptoError IO () + copyChunks r w size = do + let chSize = min size U.chunkSize + chSize' = fromIntegral chSize + size' = size - chSize + ch <- liftIO $ CF.hGet r chSize' + when (B.length ch /= chSize') $ throwError $ CF.FTCEFileIOError "encrypting file: unexpected EOF" + liftIO . CF.hPut w $ LB.fromStrict ch + when (size' > 0) $ copyChunks r w size' + APIUserRead userId -> withUserId userId $ \user -> withFastStore' (`setUserChatsRead` user) >> ok user + UserRead -> withUser $ \User {userId} -> processChatCommand $ APIUserRead userId + APIChatRead chatRef@(ChatRef cType chatId) -> withUser $ \_ -> case cType of + CTDirect -> do + user <- withFastStore $ \db -> getUserByContactId db chatId + ts <- liftIO getCurrentTime + timedItems <- withFastStore' $ \db -> do + timedItems <- getDirectUnreadTimedItems db user chatId + updateDirectChatItemsRead db user chatId + setDirectChatItemsDeleteAt db user chatId timedItems ts + forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt + ok user + CTGroup -> do + user <- withFastStore $ \db -> getUserByGroupId db chatId + ts <- liftIO getCurrentTime + timedItems <- withFastStore' $ \db -> do + timedItems <- getGroupUnreadTimedItems db user chatId + updateGroupChatItemsRead db user chatId + setGroupChatItemsDeleteAt db user chatId timedItems ts + forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt + ok user + CTLocal -> do + user <- withFastStore $ \db -> getUserByNoteFolderId db chatId + withFastStore' $ \db -> updateLocalChatItemsRead db user chatId + ok user + CTContactRequest -> pure $ chatCmdError Nothing "not supported" + CTContactConnection -> pure $ chatCmdError Nothing "not supported" + APIChatItemsRead chatRef@(ChatRef cType chatId) itemIds -> withUser $ \_ -> case cType of + CTDirect -> do + user <- withFastStore $ \db -> getUserByContactId db chatId + timedItems <- withFastStore' $ \db -> do + timedItems <- updateDirectChatItemsReadList db user chatId itemIds + setDirectChatItemsDeleteAt db user chatId timedItems =<< getCurrentTime + forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt + ok user + CTGroup -> do + user <- withFastStore $ \db -> getUserByGroupId db chatId + timedItems <- withFastStore' $ \db -> do + timedItems <- updateGroupChatItemsReadList db user chatId itemIds + setGroupChatItemsDeleteAt db user chatId timedItems =<< getCurrentTime + forM_ timedItems $ \(itemId, deleteAt) -> startProximateTimedItemThread user (chatRef, itemId) deleteAt + ok user + CTLocal -> pure $ chatCmdError Nothing "not supported" + CTContactRequest -> pure $ chatCmdError Nothing "not supported" + CTContactConnection -> pure $ chatCmdError Nothing "not supported" + APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of + CTDirect -> do + withFastStore $ \db -> do + ct <- getContact db vr user chatId + liftIO $ updateContactUnreadChat db user ct unreadChat + ok user + CTGroup -> do + withFastStore $ \db -> do + Group {groupInfo} <- getGroup db vr user chatId + liftIO $ updateGroupUnreadChat db user groupInfo unreadChat + ok user + CTLocal -> do + withFastStore $ \db -> do + nf <- getNoteFolder db user chatId + liftIO $ updateNoteFolderUnreadChat db user nf unreadChat + ok user + _ -> pure $ chatCmdError (Just user) "not supported" + APIDeleteChat cRef@(ChatRef cType chatId) cdm -> withUser $ \user@User {userId} -> case cType of + CTDirect -> do + ct <- withFastStore $ \db -> getContact db vr user chatId + filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct + withContactLock "deleteChat direct" chatId . procCmd $ + case cdm of + CDMFull notify -> do + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + sendDelDeleteConns ct notify + -- functions below are called in separate transactions to prevent crashes on android + -- (possibly, race condition on integrity check?) + withFastStore' $ \db -> do + deleteContactConnections db user ct + deleteContactFiles db user ct + withFastStore $ \db -> deleteContact db user ct + pure $ CRContactDeleted user ct + CDMEntity notify -> do + cancelFilesInProgress user filesInfo + sendDelDeleteConns ct notify + ct' <- withFastStore $ \db -> do + liftIO $ deleteContactConnections db user ct + liftIO $ void $ updateContactStatus db user ct CSDeletedByUser + getContact db vr user chatId + pure $ CRContactDeleted user ct' + CDMMessages -> do + void $ processChatCommand $ APIClearChat cRef + withFastStore' $ \db -> setContactChatDeleted db user ct True + pure $ CRContactDeleted user ct {chatDeleted = True} + where + sendDelDeleteConns ct notify = do + let doSendDel = contactReady ct && contactActive ct && notify + when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ()) + contactConnIds <- map aConnId <$> withFastStore' (\db -> getContactConnections db vr userId ct) + deleteAgentConnectionsAsync' user contactConnIds doSendDel + CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId . procCmd $ do + conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withFastStore $ \db -> getPendingContactConnection db userId chatId + deleteAgentConnectionAsync user acId + withFastStore' $ \db -> deletePendingContactConnection db userId chatId + pure $ CRContactConnectionDeleted user conn + CTGroup -> do + Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user chatId + let GroupMember {memberRole = membershipMemRole} = membership + let isOwner = membershipMemRole == GROwner + canDelete = isOwner || not (memberCurrent membership) + unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner + filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo + withGroupLock "deleteChat group" chatId . procCmd $ do + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + let doSendDel = memberActive membership && isOwner + when doSendDel . void $ sendGroupMessage' user gInfo members XGrpDel + deleteGroupLinkIfExists user gInfo + deleteMembersConnections' user members doSendDel + updateCIGroupInvitationStatus user gInfo CIGISRejected `catchChatError` \_ -> pure () + -- functions below are called in separate transactions to prevent crashes on android + -- (possibly, race condition on integrity check?) + withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members + withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo members + withStore' $ \db -> deleteGroup db user gInfo + let contactIds = mapMaybe memberContactId members + (errs1, (errs2, connIds)) <- lift $ second unzip . partitionEithers <$> withStoreBatch (\db -> map (deleteUnusedContact db) contactIds) + let errs = errs1 <> mapMaybe (fmap ChatErrorStore) errs2 + unless (null errs) $ toView $ CRChatErrors (Just user) errs + deleteAgentConnectionsAsync user $ concat connIds + pure $ CRGroupDeletedUser user gInfo + where + deleteUnusedContact :: DB.Connection -> ContactId -> IO (Either ChatError (Maybe StoreError, [ConnId])) + deleteUnusedContact db contactId = runExceptT . withExceptT ChatErrorStore $ do + ct <- getContact db vr user contactId + ifM + ((directOrUsed ct ||) . isJust <$> liftIO (checkContactHasGroups db user ct)) + (pure (Nothing, [])) + (getConnections ct) + where + getConnections :: Contact -> ExceptT StoreError IO (Maybe StoreError, [ConnId]) + getConnections ct = do + conns <- liftIO $ getContactConnections db vr userId ct + e_ <- (setContactDeleted db user ct $> Nothing) `catchStoreError` (pure . Just) + pure (e_, map aConnId conns) + CTLocal -> pure $ chatCmdError (Just user) "not supported" + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of + CTDirect -> do + ct <- withFastStore $ \db -> getContact db vr user chatId + filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + withFastStore' $ \db -> deleteContactCIs db user ct + pure $ CRChatCleared user (AChatInfo SCTDirect $ DirectChat ct) + CTGroup -> do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user chatId + filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + withFastStore' $ \db -> deleteGroupChatItemsMessages db user gInfo + membersToDelete <- withFastStore' $ \db -> getGroupMembersForExpiration db vr user gInfo + forM_ membersToDelete $ \m -> withFastStore' $ \db -> deleteGroupMember db user m + pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo) + CTLocal -> do + nf <- withFastStore $ \db -> getNoteFolder db user chatId + filesInfo <- withFastStore' $ \db -> getNoteFolderFileInfo db user nf + deleteFilesLocally filesInfo + withFastStore' $ \db -> deleteNoteFolderFiles db userId nf + withFastStore' $ \db -> deleteNoteFolderCIs db user nf + pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf) + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + APIAcceptContact incognito connReqId -> withUser $ \_ -> do + userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId + withUserContactLock "acceptContact" userContactLinkId $ do + (user@User {userId}, cReq) <- withFastStore $ \db -> getContactRequest' db connReqId + (ct, conn@Connection {connId}, sqSecured) <- acceptContactRequest user cReq incognito + ucl <- withFastStore $ \db -> getUserContactLinkById db userId userContactLinkId + let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl + ct' <- withStore' $ \db -> do + deleteContactRequestRec db user cReq + updateContactAccepted db user ct contactUsed + conn' <- + if sqSecured + then conn {connStatus = ConnSndReady} <$ updateConnectionStatusFromTo db connId ConnNew ConnSndReady + else pure conn + pure ct {contactUsed, activeConn = Just conn'} + pure $ CRAcceptingContactRequest user ct' + APIRejectContact connReqId -> withUser $ \user -> do + userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId + withUserContactLock "rejectContact" userContactLinkId $ do + cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <- + withFastStore $ \db -> + getContactRequest db user connReqId + `storeFinally` liftIO (deleteContactRequest db user connReqId) + withAgent $ \a -> rejectContact a connId invId + pure $ CRContactRequestRejected user cReq + APISendCallInvitation contactId callType -> withUser $ \user -> do + -- party initiating call + ct <- withFastStore $ \db -> getContact db vr user contactId + assertDirectAllowed user MDSnd ct XCallInv_ + if featureAllowed SCFCalls forUser ct + then do + calls <- asks currentCalls + withContactLock "sendCallInvitation" contactId $ do + g <- asks random + callId <- atomically $ CallId <$> C.randomBytes 16 g + callUUID <- UUID.toText <$> liftIO V4.nextRandom + dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing + let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair} + callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair} + (msg, _) <- sendDirectContactMessage user ct (XCallInv callId invitation) + ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) + let call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci} + call_ <- atomically $ TM.lookupInsert contactId call' calls + forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing + toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] + ok user + else pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFCalls)) + SendCallInvitation cName callType -> withUser $ \user -> do + contactId <- withFastStore $ \db -> getContactIdByName db user cName + processChatCommand $ APISendCallInvitation contactId callType + APIRejectCall contactId -> + -- party accepting call + withCurrentCall contactId $ \user ct Call {chatItemId, callState} -> case callState of + CallInvitationReceived {} -> do + let aciContent = ACIContent SMDRcv $ CIRcvCall CISCallRejected 0 + withFastStore' $ \db -> setDirectChatItemRead db user contactId chatItemId + timed_ <- contactCITimed ct + updateDirectChatItemView user ct chatItemId aciContent False False timed_ Nothing + forM_ (timed_ >>= timedDeleteAt') $ + startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId) + pure Nothing + _ -> throwChatError . CECallState $ callStateTag callState + APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} -> + -- party accepting call + withCurrentCall contactId $ \user ct call@Call {callId, chatItemId, callState} -> case callState of + CallInvitationReceived {peerCallType, localDhPubKey, sharedKey} -> do + let callDhPubKey = if encryptedCall callType then localDhPubKey else Nothing + offer = CallOffer {callType, rtcSession, callDhPubKey} + callState' = CallOfferSent {localCallType = callType, peerCallType, localCallSession = rtcSession, sharedKey} + aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0 + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallOffer callId offer) + withFastStore' $ \db -> setDirectChatItemRead db user contactId chatItemId + updateDirectChatItemView user ct chatItemId aciContent False False Nothing $ Just msgId + pure $ Just call {callState = callState'} + _ -> throwChatError . CECallState $ callStateTag callState + APISendCallAnswer contactId rtcSession -> + -- party initiating call + withCurrentCall contactId $ \user ct call@Call {callId, chatItemId, callState} -> case callState of + CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} -> do + let callState' = CallNegotiated {localCallType, peerCallType, localCallSession = rtcSession, peerCallSession, sharedKey} + aciContent = ACIContent SMDSnd $ CISndCall CISCallNegotiated 0 + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallAnswer callId CallAnswer {rtcSession}) + updateDirectChatItemView user ct chatItemId aciContent False False Nothing $ Just msgId + pure $ Just call {callState = callState'} + _ -> throwChatError . CECallState $ callStateTag callState + APISendCallExtraInfo contactId rtcExtraInfo -> + -- any call party + withCurrentCall contactId $ \user ct call@Call {callId, callState} -> case callState of + CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} -> do + -- TODO update the list of ice servers in localCallSession + void . sendDirectContactMessage user ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} + let callState' = CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} + pure $ Just call {callState = callState'} + CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} -> do + -- TODO update the list of ice servers in localCallSession + void . sendDirectContactMessage user ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} + let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} + pure $ Just call {callState = callState'} + _ -> throwChatError . CECallState $ callStateTag callState + APIEndCall contactId -> + -- any call party + withCurrentCall contactId $ \user ct call@Call {callId} -> do + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallEnd callId) + updateCallItemStatus user ct call WCSDisconnected $ Just msgId + pure Nothing + APIGetCallInvitations -> withUser' $ \_ -> lift $ do + calls <- asks currentCalls >>= readTVarIO + let invs = mapMaybe callInvitation $ M.elems calls + rcvCallInvitations <- rights <$> mapM rcvCallInvitation invs + pure $ CRCallInvitations rcvCallInvitations + where + callInvitation Call {contactId, callUUID, callState, callTs} = case callState of + CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callUUID, callTs, peerCallType, sharedKey) + _ -> Nothing + rcvCallInvitation (contactId, callUUID, callTs, peerCallType, sharedKey) = runExceptT . withFastStore $ \db -> do + user <- getUserByContactId db contactId + contact <- getContact db vr user contactId + pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callUUID, callTs} + APIGetNetworkStatuses -> withUser $ \_ -> + CRNetworkStatuses Nothing . map (uncurry ConnNetworkStatus) . M.toList <$> chatReadVar connNetworkStatuses + APICallStatus contactId receivedStatus -> + withCurrentCall contactId $ \user ct call -> + updateCallItemStatus user ct call receivedStatus Nothing $> Just call + APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile) + APISetContactPrefs contactId prefs' -> withUser $ \user -> do + ct <- withFastStore $ \db -> getContact db vr user contactId + updateContactPrefs user ct prefs' + APISetContactAlias contactId localAlias -> withUser $ \user@User {userId} -> do + ct' <- withFastStore $ \db -> do + ct <- getContact db vr user contactId + liftIO $ updateContactAlias db userId ct localAlias + pure $ CRContactAliasUpdated user ct' + APISetConnectionAlias connId localAlias -> withUser $ \user@User {userId} -> do + conn' <- withFastStore $ \db -> do + conn <- getPendingContactConnection db userId connId + liftIO $ updateContactConnectionAlias db userId conn localAlias + pure $ CRConnectionAliasUpdated user conn' + APISetUserUIThemes uId uiThemes -> withUser $ \user@User {userId} -> do + user'@User {userId = uId'} <- withFastStore $ \db -> do + user' <- getUser db uId + liftIO $ setUserUIThemes db user uiThemes + pure user' + when (userId == uId') $ chatWriteVar currentUser $ Just (user :: User) {uiThemes} + ok user' + APISetChatUIThemes (ChatRef cType chatId) uiThemes -> withUser $ \user -> case cType of + CTDirect -> do + withFastStore $ \db -> do + ct <- getContact db vr user chatId + liftIO $ setContactUIThemes db user ct uiThemes + ok user + CTGroup -> do + withFastStore $ \db -> do + g <- getGroupInfo db vr user chatId + liftIO $ setGroupUIThemes db user g uiThemes + ok user + _ -> pure $ chatCmdError (Just user) "not supported" + APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text + APIGetNtfToken -> withUser' $ \_ -> crNtfToken <$> withAgent getNtfToken + APIRegisterToken token mode -> withUser $ \_ -> + CRNtfTokenStatus <$> withAgent (\a -> registerNtfToken a token mode) + APIVerifyToken token nonce code -> withUser $ \_ -> withAgent (\a -> verifyNtfToken a token nonce code) >> ok_ + APIDeleteToken token -> withUser $ \_ -> withAgent (`deleteNtfToken` token) >> ok_ + APIGetNtfConns nonce encNtfInfo -> withUser $ \user -> do + ntfInfos <- withAgent $ \a -> getNotificationConns a nonce encNtfInfo + (errs, ntfMsgs) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (getMsgConn db) (L.toList ntfInfos)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure $ CRNtfConns ntfMsgs + where + getMsgConn :: DB.Connection -> NotificationInfo -> IO NtfConn + getMsgConn db NotificationInfo {ntfConnId, ntfMsgMeta = nMsgMeta} = do + let agentConnId = AgentConnId ntfConnId + user_ <- getUserByAConnId db agentConnId + connEntity_ <- + pure user_ $>>= \user -> + eitherToMaybe <$> runExceptT (getConnectionEntity db vr user agentConnId) + pure $ + NtfConn + { user_, + connEntity_, + -- Decrypted ntf meta of the expected message (the one notification was sent for) + expectedMsg_ = expectedMsgInfo <$> nMsgMeta + } + ApiGetConnNtfMessages connIds -> withUser $ \_ -> do + let acIds = L.map (\(AgentConnId acId) -> acId) connIds + msgs <- lift $ withAgent' $ \a -> getConnectionMessages a acIds + let ntfMsgs = L.map (\msg -> receivedMsgInfo <$> msg) msgs + pure $ CRConnNtfMessages ntfMsgs + GetUserProtoServers (AProtocolType p) -> withUser $ \user -> withServerProtocol p $ do + srvs <- withFastStore (`getUserServers` user) + liftIO $ CRUserServers user <$> groupByOperator (protocolServers p srvs) + SetUserProtoServers (AProtocolType (p :: SProtocolType p)) srvs -> withUser $ \user@User {userId} -> withServerProtocol p $ do + userServers_ <- liftIO . groupByOperator =<< withFastStore (`getUserServers` user) + case L.nonEmpty userServers_ of + Nothing -> throwChatError $ CECommandError "no servers" + Just userServers -> case srvs of + [] -> throwChatError $ CECommandError "no servers" + _ -> do + srvs' <- mapM aUserServer srvs + processChatCommand $ APISetUserServers userId $ L.map (updatedServers p srvs') userServers + where + aUserServer :: AProtoServerWithAuth -> CM (AUserServer p) + aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of + Just Refl -> pure $ AUS SDBNew $ newUserServer srv + Nothing -> throwChatError $ CECommandError $ "incorrect server protocol: " <> B.unpack (strEncode srv) + APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user -> + lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server) + TestProtoServer srv -> withUser $ \User {userId} -> + processChatCommand $ APITestProtoServer userId srv + APIGetServerOperators -> CRServerOperatorConditions <$> withFastStore getServerOperators + APISetServerOperators operators -> do + as <- asks randomAgentServers + (opsConds, srvs) <- withFastStore $ \db -> do + liftIO $ setServerOperators db operators + opsConds <- getServerOperators db + let ops = serverOperators opsConds + ops' = map Just ops <> [Nothing] + opDomains = operatorDomains ops + liftIO $ fmap (opsConds,) . mapM (getServers db as ops' opDomains) =<< getUsers db + lift $ withAgent' $ \a -> forM_ srvs $ \(auId, (smp', xftp')) -> do + setProtocolServers a auId smp' + setProtocolServers a auId xftp' + pure $ CRServerOperatorConditions opsConds + where + getServers :: DB.Connection -> RandomAgentServers -> [Maybe ServerOperator] -> [(Text, ServerOperator)] -> User -> IO (UserId, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))) + getServers db as ops opDomains user = do + smpSrvs <- getProtocolServers db SPSMP user + xftpSrvs <- getProtocolServers db SPXFTP user + uss <- groupByOperator (ops, smpSrvs, xftpSrvs) + pure $ (aUserId user,) $ useServers as opDomains uss + SetServerOperators operatorsRoles -> do + ops <- serverOperators <$> withFastStore getServerOperators + ops' <- mapM (updateOp ops) operatorsRoles + processChatCommand $ APISetServerOperators ops' + where + updateOp :: [ServerOperator] -> ServerOperatorRoles -> CM ServerOperator + updateOp ops r = + case find (\ServerOperator {operatorId = DBEntityId opId} -> operatorId' r == opId) ops of + Just op -> pure op {enabled = enabled' r, smpRoles = smpRoles' r, xftpRoles = xftpRoles' r} + Nothing -> throwError $ ChatErrorStore $ SEOperatorNotFound $ operatorId' r + APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db -> do + CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user) + APISetUserServers userId userServers -> withUserId userId $ \user -> do + errors <- validateAllUsersServers userId $ L.toList userServers + unless (null errors) $ throwChatError (CECommandError $ "user servers validation error(s): " <> show errors) + uss <- withFastStore $ \db -> do + ts <- liftIO getCurrentTime + mapM (setUserServers db user ts) userServers + as <- asks randomAgentServers + lift $ withAgent' $ \a -> do + let auId = aUserId user + opDomains = operatorDomains $ mapMaybe operator' $ L.toList uss + (smp', xftp') = useServers as opDomains uss + setProtocolServers a auId smp' + setProtocolServers a auId xftp' + ok_ + APIValidateServers userId userServers -> withUserId userId $ \user -> + CRUserServersValidation user <$> validateAllUsersServers userId userServers + APIGetUsageConditions -> do + (usageConditions, acceptedConditions) <- withFastStore $ \db -> do + usageConditions <- getCurrentUsageConditions db + acceptedConditions <- liftIO $ getLatestAcceptedConditions db + pure (usageConditions, acceptedConditions) + -- TODO if db commit is different from source commit, conditionsText should be nothing in response + pure + CRUsageConditions + { usageConditions, + conditionsText = usageConditionsText, + acceptedConditions + } + APISetConditionsNotified condId -> do + currentTs <- liftIO getCurrentTime + withFastStore' $ \db -> setConditionsNotified db condId currentTs + ok_ + APIAcceptConditions condId opIds -> withFastStore $ \db -> do + currentTs <- liftIO getCurrentTime + acceptConditions db condId opIds currentTs + CRServerOperatorConditions <$> getServerOperators db + APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user -> + checkStoreNotChanged $ + withChatLock "setChatItemTTL" $ do + case newTTL_ of + Nothing -> do + withFastStore' $ \db -> setChatItemTTL db user newTTL_ + lift $ setExpireCIFlag user False + Just newTTL -> do + oldTTL <- withFastStore' (`getChatItemTTL` user) + when (maybe True (newTTL <) oldTTL) $ do + lift $ setExpireCIFlag user False + expireChatItems user newTTL True + withFastStore' $ \db -> setChatItemTTL db user newTTL_ + lift $ startExpireCIThread user + lift . whenM chatStarted $ setExpireCIFlag user True + ok user + SetChatItemTTL newTTL_ -> withUser' $ \User {userId} -> do + processChatCommand $ APISetChatItemTTL userId newTTL_ + APIGetChatItemTTL userId -> withUserId' userId $ \user -> do + ttl <- withFastStore' (`getChatItemTTL` user) + pure $ CRChatItemTTL user ttl + GetChatItemTTL -> withUser' $ \User {userId} -> do + processChatCommand $ APIGetChatItemTTL userId + APISetNetworkConfig cfg -> withUser' $ \_ -> lift (withAgent' (`setNetworkConfig` cfg)) >> ok_ + APIGetNetworkConfig -> withUser' $ \_ -> + CRNetworkConfig <$> lift getNetworkConfig + SetNetworkConfig simpleNetCfg -> do + cfg <- (`updateNetworkConfig` simpleNetCfg) <$> lift getNetworkConfig + void . processChatCommand $ APISetNetworkConfig cfg + pure $ CRNetworkConfig cfg + APISetNetworkInfo info -> lift (withAgent' (`setUserNetworkInfo` info)) >> ok_ + ReconnectAllServers -> withUser' $ \_ -> lift (withAgent' reconnectAllServers) >> ok_ + ReconnectServer userId srv -> withUserId userId $ \user -> do + lift (withAgent' $ \a -> reconnectSMPServer a (aUserId user) srv) + ok_ + APISetChatSettings (ChatRef cType chatId) chatSettings -> withUser $ \user -> case cType of + CTDirect -> do + ct <- withFastStore $ \db -> do + ct <- getContact db vr user chatId + liftIO $ updateContactSettings db user chatId chatSettings + pure ct + forM_ (contactConnId ct) $ \connId -> + withAgent $ \a -> toggleConnectionNtfs a connId (chatHasNtfs chatSettings) + ok user + CTGroup -> do + ms <- withFastStore $ \db -> do + Group _ ms <- getGroup db vr user chatId + liftIO $ updateGroupSettings db user chatId chatSettings + pure ms + forM_ (filter memberActive ms) $ \m -> forM_ (memberConnId m) $ \connId -> + withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchChatError` (toView . CRChatError (Just user)) + ok user + _ -> pure $ chatCmdError (Just user) "not supported" + APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do + m <- withFastStore $ \db -> do + liftIO $ updateGroupMemberSettings db user gId gMemberId settings + getGroupMember db vr user gId gMemberId + let ntfOn = showMessages $ memberSettings m + toggleNtf user m ntfOn + ok user + APIContactInfo contactId -> withUser $ \user@User {userId} -> do + -- [incognito] print user's incognito profile for this contact + ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId + incognitoProfile <- case activeConn of + Nothing -> pure Nothing + Just Connection {customUserProfileId} -> + forM customUserProfileId $ \profileId -> withFastStore (\db -> getProfileById db userId profileId) + connectionStats <- mapM (withAgent . flip getConnectionServers) (contactConnId ct) + pure $ CRContactInfo user ct connectionStats (fmap fromLocalProfile incognitoProfile) + APIContactQueueInfo contactId -> withUser $ \user -> do + ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId + case activeConn of + Just conn -> getConnQueueInfo user conn + Nothing -> throwChatError $ CEContactNotActive ct + APIGroupInfo gId -> withUser $ \user -> do + (g, s) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> liftIO (getGroupSummary db user gId) + pure $ CRGroupInfo user g s + APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do + (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId + connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) + pure $ CRGroupMemberInfo user g m connectionStats + APIGroupMemberQueueInfo gId gMemberId -> withUser $ \user -> do + GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId + case activeConn of + Just conn -> getConnQueueInfo user conn + Nothing -> throwChatError CEGroupMemberNotActive + APISwitchContact contactId -> withUser $ \user -> do + ct <- withFastStore $ \db -> getContact db vr user contactId + case contactConnId ct of + Just connId -> do + connectionStats <- withAgent $ \a -> switchConnectionAsync a "" connId + pure $ CRContactSwitchStarted user ct connectionStats + Nothing -> throwChatError $ CEContactNotActive ct + APISwitchGroupMember gId gMemberId -> withUser $ \user -> do + (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId + case memberConnId m of + Just connId -> do + connectionStats <- withAgent (\a -> switchConnectionAsync a "" connId) + pure $ CRGroupMemberSwitchStarted user g m connectionStats + _ -> throwChatError CEGroupMemberNotActive + APIAbortSwitchContact contactId -> withUser $ \user -> do + ct <- withFastStore $ \db -> getContact db vr user contactId + case contactConnId ct of + Just connId -> do + connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId + pure $ CRContactSwitchAborted user ct connectionStats + Nothing -> throwChatError $ CEContactNotActive ct + APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do + (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId + case memberConnId m of + Just connId -> do + connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId + pure $ CRGroupMemberSwitchAborted user g m connectionStats + _ -> throwChatError CEGroupMemberNotActive + APISyncContactRatchet contactId force -> withUser $ \user -> withContactLock "syncContactRatchet" contactId $ do + ct <- withFastStore $ \db -> getContact db vr user contactId + case contactConn ct of + Just conn@Connection {pqSupport} -> do + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) pqSupport force + createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing + pure $ CRContactRatchetSyncStarted user ct cStats + Nothing -> throwChatError $ CEContactNotActive ct + APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withGroupLock "syncGroupMemberRatchet" gId $ do + (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId + case memberConnId m of + Just connId -> do + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId PQSupportOff force + createInternalChatItem user (CDGroupSnd g) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing + pure $ CRGroupMemberRatchetSyncStarted user g m cStats + _ -> throwChatError CEGroupMemberNotActive + APIGetContactCode contactId -> withUser $ \user -> do + ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId + case activeConn of + Just conn@Connection {connId} -> do + code <- getConnectionCode $ aConnId conn + ct' <- case contactSecurityCode ct of + Just SecurityCode {securityCode} + | sameVerificationCode code securityCode -> pure ct + | otherwise -> do + withFastStore' $ \db -> setConnectionVerified db user connId Nothing + pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} + _ -> pure ct + pure $ CRContactCode user ct' code + Nothing -> throwChatError $ CEContactNotActive ct + APIGetGroupMemberCode gId gMemberId -> withUser $ \user -> do + (g, m@GroupMember {activeConn}) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId + case activeConn of + Just conn@Connection {connId} -> do + code <- getConnectionCode $ aConnId conn + m' <- case memberSecurityCode m of + Just SecurityCode {securityCode} + | sameVerificationCode code securityCode -> pure m + | otherwise -> do + withFastStore' $ \db -> setConnectionVerified db user connId Nothing + pure (m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} + _ -> pure m + pure $ CRGroupMemberCode user g m' code + _ -> throwChatError CEGroupMemberNotActive + APIVerifyContact contactId code -> withUser $ \user -> do + ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId + case activeConn of + Just conn -> verifyConnectionCode user conn code + Nothing -> throwChatError $ CEContactNotActive ct + APIVerifyGroupMember gId gMemberId code -> withUser $ \user -> do + GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId + case activeConn of + Just conn -> verifyConnectionCode user conn code + _ -> throwChatError CEGroupMemberNotActive + APIEnableContact contactId -> withUser $ \user -> do + ct@Contact {activeConn} <- withFastStore $ \db -> getContact db vr user contactId + case activeConn of + Just conn -> do + withFastStore' $ \db -> setAuthErrCounter db user conn 0 + ok user + Nothing -> throwChatError $ CEContactNotActive ct + APIEnableGroupMember gId gMemberId -> withUser $ \user -> do + GroupMember {activeConn} <- withFastStore $ \db -> getGroupMember db vr user gId gMemberId + case activeConn of + Just conn -> do + withFastStore' $ \db -> setAuthErrCounter db user conn 0 + ok user + _ -> throwChatError CEGroupMemberNotActive + SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn}) + SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_}) + SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do + (gId, mId) <- getGroupAndMemberId user gName mName + gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId + m <- withFastStore $ \db -> getGroupMember db vr user gId mId + let GroupInfo {membership = GroupMember {memberRole = membershipRole}} = gInfo + when (membershipRole >= GRAdmin) $ throwChatError $ CECantBlockMemberForSelf gInfo m showMessages + let settings = (memberSettings m) {showMessages} + processChatCommand $ APISetMemberSettings gId mId settings + ContactInfo cName -> withContactName cName APIContactInfo + ShowGroupInfo gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIGroupInfo groupId + GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo + ContactQueueInfo cName -> withContactName cName APIContactQueueInfo + GroupMemberQueueInfo gName mName -> withMemberName gName mName APIGroupMemberQueueInfo + SwitchContact cName -> withContactName cName APISwitchContact + SwitchGroupMember gName mName -> withMemberName gName mName APISwitchGroupMember + AbortSwitchContact cName -> withContactName cName APIAbortSwitchContact + AbortSwitchGroupMember gName mName -> withMemberName gName mName APIAbortSwitchGroupMember + SyncContactRatchet cName force -> withContactName cName $ \ctId -> APISyncContactRatchet ctId force + SyncGroupMemberRatchet gName mName force -> withMemberName gName mName $ \gId mId -> APISyncGroupMemberRatchet gId mId force + GetContactCode cName -> withContactName cName APIGetContactCode + GetGroupMemberCode gName mName -> withMemberName gName mName APIGetGroupMemberCode + VerifyContact cName code -> withContactName cName (`APIVerifyContact` code) + VerifyGroupMember gName mName code -> withMemberName gName mName $ \gId mId -> APIVerifyGroupMember gId mId code + EnableContact cName -> withContactName cName APIEnableContact + EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId + ChatHelp section -> pure $ CRChatHelp section + Welcome -> withUser $ pure . CRWelcome + APIAddContact userId incognito -> withUserId userId $ \user -> procCmd $ do + -- [incognito] generate profile for connection + incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing + subMode <- chatReadVar subscriptionMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOn subMode + -- TODO PQ pass minVersion from the current range + conn <- withFastStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode initialChatVersion PQSupportOn + pure $ CRInvitation user cReq conn + AddContact incognito -> withUser $ \User {userId} -> + processChatCommand $ APIAddContact userId incognito + APISetConnectionIncognito connId incognito -> withUser $ \user@User {userId} -> do + conn'_ <- withFastStore $ \db -> do + conn@PendingContactConnection {pccConnStatus, customUserProfileId} <- getPendingContactConnection db userId connId + case (pccConnStatus, customUserProfileId, incognito) of + (ConnNew, Nothing, True) -> liftIO $ do + incognitoProfile <- generateRandomProfile + pId <- createIncognitoProfile db user incognitoProfile + Just <$> updatePCCIncognito db user conn (Just pId) + (ConnNew, Just pId, False) -> liftIO $ do + deletePCCIncognitoProfile db user pId + Just <$> updatePCCIncognito db user conn Nothing + _ -> pure Nothing + case conn'_ of + Just conn' -> pure $ CRConnectionIncognitoUpdated user conn' + Nothing -> throwChatError CEConnectionIncognitoChangeProhibited + APIChangeConnectionUser connId newUserId -> withUser $ \user@User {userId} -> do + conn <- withFastStore $ \db -> getPendingContactConnection db userId connId + let PendingContactConnection {pccConnStatus, connReqInv} = conn + case (pccConnStatus, connReqInv) of + (ConnNew, Just cReqInv) -> do + newUser <- privateGetUser newUserId + conn' <- ifM (canKeepLink cReqInv newUser) (updateConnRecord user conn newUser) (recreateConn user conn newUser) + pure $ CRConnectionUserChanged user conn conn' newUser + _ -> throwChatError CEConnectionUserChangeProhibited + where + canKeepLink :: ConnReqInvitation -> User -> CM Bool + canKeepLink (CRInvitationUri crData _) newUser = do + let ConnReqUriData {crSmpQueues = q :| _} = crData + SMPQueueUri {queueAddress = SMPQueueAddress {smpServer}} = q + newUserServers <- + map protoServer' . L.filter (\ServerCfg {enabled} -> enabled) + <$> getKnownAgentServers SPSMP newUser + pure $ smpServer `elem` newUserServers + updateConnRecord user@User {userId} conn@PendingContactConnection {customUserProfileId} newUser = do + withAgent $ \a -> changeConnectionUser a (aUserId user) (aConnId' conn) (aUserId newUser) + withFastStore' $ \db -> do + conn' <- updatePCCUser db userId conn newUserId + forM_ customUserProfileId $ \profileId -> + deletePCCIncognitoProfile db user profileId + pure conn' + recreateConn user conn@PendingContactConnection {customUserProfileId} newUser = do + subMode <- chatReadVar subscriptionMode + (agConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId newUser) True SCMInvitation Nothing IKPQOn subMode + conn' <- withFastStore' $ \db -> do + deleteConnectionRecord db user connId + forM_ customUserProfileId $ \profileId -> + deletePCCIncognitoProfile db user profileId + createDirectConnection db newUser agConnId cReq ConnNew Nothing subMode initialChatVersion PQSupportOn + deleteAgentConnectionAsync user (aConnId' conn) + pure conn' + APIConnectPlan userId cReqUri -> withUserId userId $ \user -> + CRConnectionPlan user <$> connectPlan user cReqUri + APIConnect userId incognito (Just (ACR SCMInvitation cReq@(CRInvitationUri crData e2e))) -> withUserId userId $ \user -> withInvitationLock "connect" (strEncode cReq) . procCmd $ do + subMode <- chatReadVar subscriptionMode + -- [incognito] generate profile to send + incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing + let profileToSend = userProfileToSend user incognitoProfile Nothing False + lift (withAgent' $ \a -> connRequestPQSupport a PQSupportOn cReq) >>= \case + Nothing -> throwChatError CEInvalidConnReq + -- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan + Just (agentV, pqSup') -> do + let chatV = agentToChatVersion agentV + dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend + withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqs) >>= \case + Nothing -> joinNewConn chatV dm + Just (RcvDirectMsgConnection conn@Connection {connId, connStatus, contactConnInitiated} Nothing) + | connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV dm -- own connection link + | connStatus == ConnPrepared -> do + -- retrying join after error + pcc <- withFastStore $ \db -> getPendingContactConnection db userId connId + joinPreparedConn (aConnId conn) pcc dm + Just ent -> throwChatError $ CECommandError $ "connection exists: " <> show (connEntityInfo ent) + where + joinNewConn chatV dm = do + connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup' + pcc <- withFastStore' $ \db -> createDirectConnection db user connId cReq ConnPrepared (incognitoProfile $> profileToSend) subMode chatV pqSup' + joinPreparedConn connId pcc dm + joinPreparedConn connId pcc@PendingContactConnection {pccConnId} dm = do + void $ withAgent $ \a -> joinConnection a (aUserId user) connId True cReq dm pqSup' subMode + withFastStore' $ \db -> updateConnectionStatusFromTo db pccConnId ConnPrepared ConnJoined + pure $ CRSentConfirmation user pcc {pccConnStatus = ConnJoined} + cReqs = + ( CRInvitationUri crData {crScheme = SSSimplex} e2e, + CRInvitationUri crData {crScheme = simplexChat} e2e + ) + APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq + APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq + Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do + plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk) + unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan) + case plan of + CPContactAddress (CAPContactViaAddress Contact {contactId}) -> + processChatCommand $ APIConnectContactViaAddress userId incognito contactId + _ -> processChatCommand $ APIConnect userId incognito aCReqUri + Connect _ Nothing -> throwChatError CEInvalidConnReq + APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do + ct@Contact {activeConn, profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db vr user contactId + when (isJust activeConn) $ throwChatError (CECommandError "contact already has connection") + case contactLink of + Just cReq -> connectContactViaAddress user incognito ct cReq + Nothing -> throwChatError (CECommandError "no address in contact profile") + ConnectSimplex incognito -> withUser $ \user@User {userId} -> do + let cReqUri = ACR SCMContact adminContactReq + plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk) + unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan) + case plan of + CPContactAddress (CAPContactViaAddress Contact {contactId}) -> + processChatCommand $ APIConnectContactViaAddress userId incognito contactId + _ -> processChatCommand $ APIConnect userId incognito (Just cReqUri) + DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) cdm + ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect + APIListContacts userId -> withUserId userId $ \user -> + CRContactsList user <$> withFastStore' (\db -> getUserContacts db vr user) + ListContacts -> withUser $ \User {userId} -> + processChatCommand $ APIListContacts userId + APICreateMyAddress userId -> withUserId userId $ \user -> procCmd $ do + subMode <- chatReadVar subscriptionMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing IKPQOn subMode + withFastStore $ \db -> createUserContactLink db user connId cReq subMode + pure $ CRUserContactLinkCreated user cReq + CreateMyAddress -> withUser $ \User {userId} -> + processChatCommand $ APICreateMyAddress userId + APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do + conns <- withFastStore $ \db -> getUserAddressConnections db vr user + withChatLock "deleteMyAddress" $ do + deleteAgentConnectionsAsync user $ map aConnId conns + withFastStore' (`deleteUserAddress` user) + let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} + r <- updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing + let user' = case r of + CRUserProfileUpdated u' _ _ _ -> u' + _ -> user + pure $ CRUserContactLinkDeleted user' + DeleteMyAddress -> withUser $ \User {userId} -> + processChatCommand $ APIDeleteMyAddress userId + APIShowMyAddress userId -> withUserId' userId $ \user -> + CRUserContactLink user <$> withFastStore (`getUserAddress` user) + ShowMyAddress -> withUser' $ \User {userId} -> + processChatCommand $ APIShowMyAddress userId + APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do + let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} + updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing + APISetProfileAddress userId True -> withUserId userId $ \user@User {profile = p} -> do + ucl@UserContactLink {connReqContact} <- withFastStore (`getUserAddress` user) + let p' = (fromLocalProfile p :: Profile) {contactLink = Just connReqContact} + updateProfile_ user p' $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl + SetProfileAddress onOff -> withUser $ \User {userId} -> + processChatCommand $ APISetProfileAddress userId onOff + APIAddressAutoAccept userId autoAccept_ -> withUserId userId $ \user -> do + forM_ autoAccept_ $ \AutoAccept {businessAddress, acceptIncognito} -> + when (businessAddress && acceptIncognito) $ throwChatError $ CECommandError "requests to business address cannot be accepted incognito" + contactLink <- withFastStore (\db -> updateUserAddressAutoAccept db user autoAccept_) + pure $ CRUserContactLinkUpdated user contactLink + AddressAutoAccept autoAccept_ -> withUser $ \User {userId} -> + processChatCommand $ APIAddressAutoAccept userId autoAccept_ + AcceptContact incognito cName -> withUser $ \User {userId} -> do + connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName + processChatCommand $ APIAcceptContact incognito connReqId + RejectContact cName -> withUser $ \User {userId} -> do + connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName + processChatCommand $ APIRejectContact connReqId + ForwardMessage toChatName fromContactName forwardedMsg -> withUser $ \user -> do + contactId <- withFastStore $ \db -> getContactIdByName db user fromContactName + forwardedItemId <- withFastStore $ \db -> getDirectChatItemIdByText' db user contactId forwardedMsg + toChatRef <- getChatRef user toChatName + processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTDirect contactId) (forwardedItemId :| []) Nothing + ForwardGroupMessage toChatName fromGroupName fromMemberName_ forwardedMsg -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user fromGroupName + forwardedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId fromMemberName_ forwardedMsg + toChatRef <- getChatRef user toChatName + processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTGroup groupId) (forwardedItemId :| []) Nothing + ForwardLocalMessage toChatName forwardedMsg -> withUser $ \user -> do + folderId <- withFastStore (`getUserNoteFolderId` user) + forwardedItemId <- withFastStore $ \db -> getLocalChatItemIdByText' db user folderId forwardedMsg + toChatRef <- getChatRef user toChatName + processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTLocal folderId) (forwardedItemId :| []) Nothing + SendMessage (ChatName cType name) msg -> withUser $ \user -> do + let mc = MCText msg + case cType of + CTDirect -> + withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case + Right ctId -> do + let chatRef = ChatRef CTDirect ctId + processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| []) + Left _ -> + withFastStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case + Right [(gInfo, member)] -> do + let GroupInfo {localDisplayName = gName} = gInfo + GroupMember {localDisplayName = mName} = member + processChatCommand $ SendMemberContactMessage gName mName msg + Right (suspectedMember : _) -> + throwChatError $ CEContactNotFound name (Just suspectedMember) + _ -> + throwChatError $ CEContactNotFound name Nothing + CTGroup -> do + gId <- withFastStore $ \db -> getGroupIdByName db user name + let chatRef = ChatRef CTGroup gId + processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| []) + CTLocal + | name == "" -> do + folderId <- withFastStore (`getUserNoteFolderId` user) + processChatCommand $ APICreateChatItems folderId (ComposedMessage Nothing Nothing mc :| []) + | otherwise -> throwChatError $ CECommandError "not supported" + _ -> throwChatError $ CECommandError "not supported" + SendMemberContactMessage gName mName msg -> withUser $ \user -> do + (gId, mId) <- getGroupAndMemberId user gName mName + m <- withFastStore $ \db -> getGroupMember db vr user gId mId + let mc = MCText msg + case memberContactId m of + Nothing -> do + g <- withFastStore $ \db -> getGroupInfo db vr user gId + unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwChatError $ CECommandError "direct messages not allowed" + toView $ CRNoMemberContactCreating user g m + processChatCommand (APICreateMemberContact gId mId) >>= \case + cr@(CRNewMemberContact _ Contact {contactId} _ _) -> do + toView cr + processChatCommand $ APISendMemberContactInvitation contactId (Just mc) + cr -> pure cr + Just ctId -> do + let chatRef = ChatRef CTDirect ctId + processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| []) + SendLiveMessage chatName msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + let mc = MCText msg + processChatCommand $ APISendMessages chatRef True Nothing (ComposedMessage Nothing Nothing mc :| []) + SendMessageBroadcast msg -> withUser $ \user -> do + contacts <- withFastStore' $ \db -> getUserContacts db vr user + withChatLock "sendMessageBroadcast" . procCmd $ do + let ctConns_ = L.nonEmpty $ foldr addContactConn [] contacts + case ctConns_ of + Nothing -> do + timestamp <- liftIO getCurrentTime + pure CRBroadcastSent {user, msgContent = mc, successes = 0, failures = 0, timestamp} + Just (ctConns :: NonEmpty (Contact, Connection)) -> do + let idsEvts = L.map ctSndEvent ctConns + sndMsgs <- lift $ createSndMessages idsEvts + let msgReqs_ :: NonEmpty (Either ChatError ChatMsgReq) = L.zipWith (fmap . ctMsgReq) ctConns sndMsgs + (errs, ctSndMsgs :: [(Contact, SndMessage)]) <- + partitionEithers . L.toList . zipWith3' combineResults ctConns sndMsgs <$> deliverMessagesB msgReqs_ + timestamp <- liftIO getCurrentTime + lift . void $ withStoreBatch' $ \db -> map (createCI db user timestamp) ctSndMsgs + pure CRBroadcastSent {user, msgContent = mc, successes = length ctSndMsgs, failures = length errs, timestamp} + where + mc = MCText msg + addContactConn :: Contact -> [(Contact, Connection)] -> [(Contact, Connection)] + addContactConn ct ctConns = case contactSendConn_ ct of + Right conn | directOrUsed ct -> (ct, conn) : ctConns + _ -> ctConns + ctSndEvent :: (Contact, Connection) -> (ConnOrGroupId, ChatMsgEvent 'Json) + ctSndEvent (_, Connection {connId}) = (ConnectionId connId, XMsgNew $ MCSimple (extMsgContent mc Nothing)) + ctMsgReq :: (Contact, Connection) -> SndMessage -> ChatMsgReq + ctMsgReq (_, conn) SndMessage {msgId, msgBody} = (conn, MsgFlags {notification = hasNotification XMsgNew_}, msgBody, [msgId]) + zipWith3' :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d + zipWith3' f ~(x :| xs) ~(y :| ys) ~(z :| zs) = f x y z :| zipWith3 f xs ys zs + combineResults :: (Contact, Connection) -> Either ChatError SndMessage -> Either ChatError ([Int64], PQEncryption) -> Either ChatError (Contact, SndMessage) + combineResults (ct, _) (Right msg') (Right _) = Right (ct, msg') + combineResults _ (Left e) _ = Left e + combineResults _ _ (Left e) = Left e + createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO () + createCI db user createdAt (ct, sndMsg) = + void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt + SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do + contactId <- withFastStore $ \db -> getContactIdByName db user cName + quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg + let mc = MCText msg + processChatCommand $ APISendMessages (ChatRef CTDirect contactId) False Nothing (ComposedMessage Nothing (Just quotedItemId) mc :| []) + DeleteMessage chatName deletedMsg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg + processChatCommand $ APIDeleteChatItem chatRef (deletedItemId :| []) CIDMBroadcast + DeleteMemberMessage gName mName deletedMsg -> withUser $ \user -> do + gId <- withFastStore $ \db -> getGroupIdByName db user gName + deletedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId (Just mName) deletedMsg + processChatCommand $ APIDeleteMemberChatItem gId (deletedItemId :| []) + EditMessage chatName editedMsg msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + editedItemId <- getSentChatItemIdByText user chatRef editedMsg + let mc = MCText msg + processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc + UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + let mc = MCText msg + processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc + ReactToMessage add reaction chatName msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + chatItemId <- getChatItemIdByText user chatRef msg + processChatCommand $ APIChatItemReaction chatRef chatItemId add reaction + APINewGroup userId incognito gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do + checkValidName displayName + gVar <- asks random + -- [incognito] generate incognito profile for group membership + incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing + gInfo <- withFastStore $ \db -> createNewGroup db vr gVar user gProfile incognitoProfile + let cd = CDGroupSnd gInfo + createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing + createGroupFeatureItems user cd CISndGroupFeature gInfo + pure $ CRGroupCreated user gInfo + NewGroup incognito gProfile -> withUser $ \User {userId} -> + processChatCommand $ APINewGroup userId incognito gProfile + APIAddMember groupId contactId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do + -- TODO for large groups: no need to load all members to determine if contact is a member + (group, contact) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId + assertDirectAllowed user MDSnd contact XGrpInv_ + let Group gInfo members = group + Contact {localDisplayName = cName} = contact + assertUserGroupRole gInfo $ max GRAdmin memRole + -- [incognito] forbid to invite contact to whom user is connected incognito + when (contactConnIncognito contact) $ throwChatError CEContactIncognitoCantInvite + -- [incognito] forbid to invite contacts if user joined the group using an incognito profile + when (incognitoMembership gInfo) $ throwChatError CEGroupIncognitoCantInvite + let sendInvitation = sendGrpInvitation user contact gInfo + case contactMember contact members of + Nothing -> do + gVar <- asks random + subMode <- chatReadVar subscriptionMode + (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode + member <- withFastStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode + sendInvitation member cReq + pure $ CRSentGroupInvitation user gInfo contact member + Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole} + | memberStatus == GSMemInvited -> do + unless (mRole == memRole) $ withFastStore' $ \db -> updateGroupMemberRole db user member memRole + withFastStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case + Just cReq -> do + sendInvitation member {memberRole = memRole} cReq + pure $ CRSentGroupInvitation user gInfo contact member {memberRole = memRole} + Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName + | otherwise -> throwChatError $ CEGroupDuplicateMember cName + APIJoinGroup groupId -> withUser $ \user@User {userId} -> do + withGroupLock "joinGroup" groupId . procCmd $ do + (invitation, ct) <- withFastStore $ \db -> do + inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId + (inv,) <$> getContactViaMember db vr user fromMember + let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation + GroupMember {memberId = membershipMemId} = membership + Contact {activeConn} = ct + case activeConn of + Just Connection {peerChatVRange} -> do + subMode <- chatReadVar subscriptionMode + dm <- encodeConnInfo $ XGrpAcpt membershipMemId + agentConnId <- case memberConn fromMember of + Nothing -> do + agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff + let chatV = vr `peerConnChatVersion` peerChatVRange + void $ withFastStore' $ \db -> createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode + pure agentConnId + Just conn -> pure $ aConnId conn + withFastStore' $ \db -> do + updateGroupMemberStatus db userId fromMember GSMemAccepted + updateGroupMemberStatus db userId membership GSMemAccepted + void (withAgent $ \a -> joinConnection a (aUserId user) agentConnId True connRequest dm PQSupportOff subMode) + `catchChatError` \e -> do + withFastStore' $ \db -> do + updateGroupMemberStatus db userId fromMember GSMemInvited + updateGroupMemberStatus db userId membership GSMemInvited + throwError e + updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user)) + pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing + Nothing -> throwChatError $ CEContactNotActive ct + APIMemberRole groupId memberId memRole -> withUser $ \user -> do + Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId + if memberId == groupMemberId' membership + then changeMemberRole user gInfo members membership $ SGEUserRole memRole + else case find ((== memberId) . groupMemberId') members of + Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole + _ -> throwChatError CEGroupMemberNotFound + where + changeMemberRole user gInfo members m gEvent = do + let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m + assertUserGroupRole gInfo $ maximum ([GRAdmin, mRole, memRole] :: [GroupMemberRole]) + withGroupLock "memberRole" groupId . procCmd $ do + unless (mRole == memRole) $ do + withFastStore' $ \db -> updateGroupMemberRole db user m memRole + case mStatus of + GSMemInvited -> do + withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case + (Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq + _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName + _ -> do + msg <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) + toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] + pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole} + APIBlockMemberForAll groupId memberId blocked -> withUser $ \user -> do + Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId + when (memberId == groupMemberId' membership) $ throwChatError $ CECommandError "can't block/unblock self" + case splitMember memberId members of + Nothing -> throwChatError $ CEException "expected to find a single blocked member" + Just (bm, remainingMembers) -> do + let GroupMember {memberId = bmMemberId, memberRole = bmRole, memberProfile = bmp} = bm + assertUserGroupRole gInfo $ max GRAdmin bmRole + when (blocked == blockedByAdmin bm) $ throwChatError $ CECommandError $ if blocked then "already blocked" else "already unblocked" + withGroupLock "blockForAll" groupId . procCmd $ do + let mrs = if blocked then MRSBlocked else MRSUnrestricted + event = XGrpMemRestrict bmMemberId MemberRestrictions {restriction = mrs} + msg <- sendGroupMessage' user gInfo remainingMembers event + let ciContent = CISndGroupEvent $ SGEMemberBlocked memberId (fromLocalProfile bmp) blocked + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent + toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] + bm' <- withFastStore $ \db -> do + liftIO $ updateGroupMemberBlocked db user groupId memberId mrs + getGroupMember db vr user groupId memberId + toggleNtf user bm' (not blocked) + pure CRMemberBlockedForAllUser {user, groupInfo = gInfo, member = bm', blocked} + where + splitMember mId ms = case break ((== mId) . groupMemberId') ms of + (_, []) -> Nothing + (ms1, bm : ms2) -> Just (bm, ms1 <> ms2) + APIRemoveMember groupId memberId -> withUser $ \user -> do + Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId + case find ((== memberId) . groupMemberId') members of + Nothing -> throwChatError CEGroupMemberNotFound + Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do + assertUserGroupRole gInfo $ max GRAdmin mRole + withGroupLock "removeMember" groupId . procCmd $ do + case mStatus of + GSMemInvited -> do + deleteMemberConnection user m + withFastStore' $ \db -> deleteGroupMember db user m + _ -> do + msg <- sendGroupMessage user gInfo members $ XGrpMemDel mId + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) + toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] + deleteMemberConnection' user m True + -- undeleted "member connected" chat item will prevent deletion of member record + deleteOrUpdateMemberRecord user m + pure $ CRUserDeletedMember user gInfo m {memberStatus = GSMemRemoved} + APILeaveGroup groupId -> withUser $ \user@User {userId} -> do + Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId + filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo + withGroupLock "leaveGroup" groupId . procCmd $ do + cancelFilesInProgress user filesInfo + msg <- sendGroupMessage' user gInfo members XGrpLeave + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) + toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] + -- TODO delete direct connections that were unused + deleteGroupLinkIfExists user gInfo + -- member records are not deleted to keep history + deleteMembersConnections' user members True + withFastStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft + pure $ CRLeftMemberUser user gInfo {membership = membership {memberStatus = GSMemLeft}} + APIListMembers groupId -> withUser $ \user -> + CRGroupMembers user <$> withFastStore (\db -> getGroup db vr user groupId) + AddMember gName cName memRole -> withUser $ \user -> do + (groupId, contactId) <- withFastStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db user cName + processChatCommand $ APIAddMember groupId contactId memRole + JoinGroup gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIJoinGroup groupId + MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMemberRole gId gMemberId memRole + BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMemberForAll gId gMemberId blocked + RemoveMember gName gMemberName -> withMemberName gName gMemberName APIRemoveMember + LeaveGroup gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APILeaveGroup groupId + DeleteGroup gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) (CDMFull True) + ClearGroup gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIClearChat (ChatRef CTGroup groupId) + ListMembers gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIListMembers groupId + APIListGroups userId contactId_ search_ -> withUserId userId $ \user -> + CRGroupsList user <$> withFastStore' (\db -> getUserGroupsWithSummary db vr user contactId_ search_) + ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do + ct_ <- forM cName_ $ \cName -> withFastStore $ \db -> getContactByName db vr user cName + processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_ + APIUpdateGroupProfile groupId p' -> withUser $ \user -> do + g <- withFastStore $ \db -> getGroup db vr user groupId + runUpdateGroupProfile user g p' + UpdateGroupNames gName GroupProfile {displayName, fullName} -> + updateGroupProfileByName gName $ \p -> p {displayName, fullName} + ShowGroupProfile gName -> withUser $ \user -> + CRGroupProfile user <$> withFastStore (\db -> getGroupInfoByName db vr user gName) + UpdateGroupDescription gName description -> + updateGroupProfileByName gName $ \p -> p {description} + ShowGroupDescription gName -> withUser $ \user -> + CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db vr user gName) + APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId + assertUserGroupRole gInfo GRAdmin + when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole + groupLinkId <- GroupLinkId <$> drgRandomBytes 16 + subMode <- chatReadVar subscriptionMode + let crClientData = encodeJSON $ CRDataGroup groupLinkId + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) IKPQOff subMode + withFastStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode + pure $ CRGroupLinkCreated user gInfo cReq mRole + APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withGroupLock "groupLinkMemberRole" groupId $ do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId + (groupLinkId, groupLink, mRole) <- withFastStore $ \db -> getGroupLink db user gInfo + assertUserGroupRole gInfo GRAdmin + when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole' + when (mRole' /= mRole) $ withFastStore' $ \db -> setGroupLinkMemberRole db user groupLinkId mRole' + pure $ CRGroupLink user gInfo groupLink mRole' + APIDeleteGroupLink groupId -> withUser $ \user -> withGroupLock "deleteGroupLink" groupId $ do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId + deleteGroupLink' user gInfo + pure $ CRGroupLinkDeleted user gInfo + APIGetGroupLink groupId -> withUser $ \user -> do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId + (_, groupLink, mRole) <- withFastStore $ \db -> getGroupLink db user gInfo + pure $ CRGroupLink user gInfo groupLink mRole + APICreateMemberContact gId gMemberId -> withUser $ \user -> do + (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId + assertUserGroupRole g GRAuthor + unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwChatError $ CECommandError "direct messages not allowed" + case memberConn m of + Just mConn@Connection {peerChatVRange} -> do + unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible + when (isJust $ memberContactId m) $ throwChatError $ CECommandError "member contact already exists" + subMode <- chatReadVar subscriptionMode + -- TODO PQ should negotitate contact connection with PQSupportOn? + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode + -- [incognito] reuse membership incognito profile + ct <- withFastStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode + -- TODO not sure it is correct to set connections status here? + lift $ setContactNetworkStatus ct NSConnected + pure $ CRNewMemberContact user ct g m + _ -> throwChatError CEGroupMemberNotActive + APISendMemberContactInvitation contactId msgContent_ -> withUser $ \user -> do + (g@GroupInfo {groupId}, m, ct, cReq) <- withFastStore $ \db -> getMemberContact db vr user contactId + when (contactGrpInvSent ct) $ throwChatError $ CECommandError "x.grp.direct.inv already sent" + case memberConn m of + Just mConn -> do + let msg = XGrpDirectInv cReq msgContent_ + (sndMsg, _, _) <- sendDirectMemberMessage mConn msg groupId + withFastStore' $ \db -> setContactGrpInvSent db ct True + let ct' = ct {contactGrpInvSent = True} + forM_ msgContent_ $ \mc -> do + ci <- saveSndChatItem user (CDDirectSnd ct') sndMsg (CISndMsgContent mc) + toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci] + pure $ CRNewMemberContactSentInv user ct' g m + _ -> throwChatError CEGroupMemberNotActive + CreateGroupLink gName mRole -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APICreateGroupLink groupId mRole + GroupLinkMemberRole gName mRole -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIGroupLinkMemberRole groupId mRole + DeleteGroupLink gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIDeleteGroupLink groupId + ShowGroupLink gName -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + processChatCommand $ APIGetGroupLink groupId + SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do + groupId <- withFastStore $ \db -> getGroupIdByName db user gName + quotedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg + let mc = MCText msg + processChatCommand $ APISendMessages (ChatRef CTGroup groupId) False Nothing (ComposedMessage Nothing (Just quotedItemId) mc :| []) + ClearNoteFolder -> withUser $ \user -> do + folderId <- withFastStore (`getUserNoteFolderId` user) + processChatCommand $ APIClearChat (ChatRef CTLocal folderId) + LastChats count_ -> withUser' $ \user -> do + let count = fromMaybe 5000 count_ + (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user False (PTLast count) clqNoFilters) + unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs) + pure $ CRChats previews + LastMessages (Just chatName) count search -> withUser $ \user -> do + chatRef <- getChatRef user chatName + chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search + pure $ CRChatItems user (Just chatName) (aChatItems . chat $ chatResp) + LastMessages Nothing count search -> withUser $ \user -> do + chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast count) search + pure $ CRChatItems user Nothing chatItems + LastChatItemId (Just chatName) index -> withUser $ \user -> do + chatRef <- getChatRef user chatName + chatResp <- processChatCommand (APIGetChat chatRef (CPLast $ index + 1) Nothing) + pure $ CRChatItemId user (fmap aChatItemId . listToMaybe . aChatItems . chat $ chatResp) + LastChatItemId Nothing index -> withUser $ \user -> do + chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast $ index + 1) Nothing + pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems) + ShowChatItem (Just itemId) -> withUser $ \user -> do + chatItem <- withFastStore $ \db -> do + chatRef <- getChatRefViaItemId db user itemId + getAChatItem db vr user chatRef itemId + pure $ CRChatItems user Nothing ((: []) chatItem) + ShowChatItem Nothing -> withUser $ \user -> do + chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast 1) Nothing + pure $ CRChatItems user Nothing chatItems + ShowChatItemInfo chatName msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + itemId <- getChatItemIdByText user chatRef msg + processChatCommand $ APIGetChatItemInfo chatRef itemId + ShowLiveItems on -> withUser $ \_ -> + asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_ + SendFile chatName f -> withUser $ \user -> do + chatRef <- getChatRef user chatName + case chatRef of + ChatRef CTLocal folderId -> processChatCommand $ APICreateChatItems folderId (ComposedMessage (Just f) Nothing (MCFile "") :| []) + _ -> processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage (Just f) Nothing (MCFile "") :| []) + SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do + chatRef <- getChatRef user chatName + filePath <- lift $ toFSFilePath fPath + unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath} + fileSize <- getFileSize filePath + unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath} + -- TODO include file description for preview + processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview) :| []) + ForwardFile chatName fileId -> forwardFile chatName fileId SendFile + ForwardImage chatName fileId -> forwardFile chatName fileId SendImage + SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO" + -- TODO to use priority transactions we need a parameter that differentiates manual and automatic acceptance + ReceiveFile fileId userApprovedRelays encrypted_ rcvInline_ filePath_ -> withUser $ \_ -> + withFileLock "receiveFile" fileId . procCmd $ do + (user, ft@RcvFileTransfer {fileStatus}) <- withStore (`getRcvFileTransferById` fileId) + encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles + ft' <- (if encrypt && fileStatus == RFSNew then setFileToEncrypt else pure) ft + receiveFile' user ft' userApprovedRelays rcvInline_ filePath_ + SetFileToReceive fileId userApprovedRelays encrypted_ -> withUser $ \_ -> do + withFileLock "setFileToReceive" fileId . procCmd $ do + encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles + cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing + withStore' $ \db -> setRcvFileToReceive db fileId userApprovedRelays cfArgs + ok_ + CancelFile fileId -> withUser $ \user@User {userId} -> + withFileLock "cancelFile" fileId . procCmd $ + withFastStore (\db -> getFileTransfer db user fileId) >>= \case + FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts + | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" + | not (null fts) && all fileCancelledOrCompleteSMP fts -> + throwChatError $ CEFileCancel fileId "file transfer is complete" + | otherwise -> do + fileAgentConnIds <- cancelSndFile user ftm fts True + deleteAgentConnectionsAsync user fileAgentConnIds + withFastStore (\db -> liftIO $ lookupChatRefByFileId db user fileId) >>= \case + Nothing -> pure () + Just (ChatRef CTDirect contactId) -> do + (contact, sharedMsgId) <- withFastStore $ \db -> (,) <$> getContact db vr user contactId <*> getSharedMsgIdByFileId db userId fileId + void . sendDirectContactMessage user contact $ XFileCancel sharedMsgId + Just (ChatRef CTGroup groupId) -> do + (Group gInfo ms, sharedMsgId) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getSharedMsgIdByFileId db userId fileId + void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId + Just _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" + ci <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId + pure $ CRSndFileCancelled user ci ftm fts + where + fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} = + s == FSCancelled || (s == FSComplete && isNothing xftpSndFile) + FTRcv ftr@RcvFileTransfer {cancelled, fileStatus, xftpRcvFile} + | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" + | rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete" + | otherwise -> case xftpRcvFile of + Nothing -> do + cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) + ci <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId + pure $ CRRcvFileCancelled user ci ftr + Just XFTPRcvFile {agentRcvFileId} -> do + forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do + fsFilePath <- lift $ toFSFilePath filePath + liftIO $ removeFile fsFilePath `catchAll_` pure () + lift . forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) -> + withAgent' (`xftpDeleteRcvFile` aFileId) + aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation + pure $ CRRcvFileCancelled user aci_ ftr + FileStatus fileId -> withUser $ \user -> do + withFastStore (\db -> lookupChatItemByFileId db vr user fileId) >>= \case + Nothing -> do + fileStatus <- withFastStore $ \db -> getFileTransferProgress db user fileId + pure $ CRFileTransferStatus user fileStatus + Just ci@(AChatItem _ _ _ ChatItem {file}) -> case file of + Just CIFile {fileProtocol = FPLocal} -> + throwChatError $ CECommandError "not supported for local files" + Just CIFile {fileProtocol = FPXFTP} -> + pure $ CRFileTransferStatusXFTP user ci + _ -> do + fileStatus <- withFastStore $ \db -> getFileTransferProgress db user fileId + pure $ CRFileTransferStatus user fileStatus + ShowProfile -> withUser $ \user@User {profile} -> pure $ CRUserProfile user (fromLocalProfile profile) + UpdateProfile displayName fullName -> withUser $ \user@User {profile} -> do + let p = (fromLocalProfile profile :: Profile) {displayName = displayName, fullName = fullName} + updateProfile user p + UpdateProfileImage image -> withUser $ \user@User {profile} -> do + let p = (fromLocalProfile profile :: Profile) {image} + updateProfile user p + ShowProfileImage -> withUser $ \user@User {profile} -> pure $ CRUserProfileImage user $ fromLocalProfile profile + SetUserFeature (ACF f) allowed -> withUser $ \user@User {profile} -> do + let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user} + updateProfile user p + SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do + ct@Contact {userPreferences} <- withFastStore $ \db -> getContactByName db vr user cName + let prefs' = setPreference f allowed_ $ Just userPreferences + updateContactPrefs user ct prefs' + SetGroupFeature (AGFNR f) gName enabled -> + updateGroupProfileByName gName $ \p -> + p {groupPreferences = Just . setGroupPreference f enabled $ groupPreferences p} + SetGroupFeatureRole (AGFR f) gName enabled role -> + updateGroupProfileByName gName $ \p -> + p {groupPreferences = Just . setGroupPreferenceRole f enabled role $ groupPreferences p} + SetUserTimedMessages onOff -> withUser $ \user@User {profile} -> do + let allowed = if onOff then FAYes else FANo + pref = TimedMessagesPreference allowed Nothing + p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user} + updateProfile user p + SetContactTimedMessages cName timedMessagesEnabled_ -> withUser $ \user -> do + ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withFastStore $ \db -> getContactByName db vr user cName + let currentTTL = timedMessages >>= \TimedMessagesPreference {ttl} -> ttl + pref_ = tmeToPref currentTTL <$> timedMessagesEnabled_ + prefs' = setPreference' SCFTimedMessages pref_ $ Just userPreferences + updateContactPrefs user ct prefs' + SetGroupTimedMessages gName ttl_ -> do + let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_ + updateGroupProfileByName gName $ \p -> + p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p} + SetLocalDeviceName name -> chatWriteVar localDeviceName name >> ok_ + ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts + SwitchRemoteHost rh_ -> CRCurrentRemoteHost <$> switchRemoteHost rh_ + StartRemoteHost rh_ ca_ bp_ -> do + (localAddrs, remoteHost_, inv@RCSignedInvitation {invitation = RCInvitation {port}}) <- startRemoteHost rh_ ca_ bp_ + pure CRRemoteHostStarted {remoteHost_, invitation = decodeLatin1 $ strEncode inv, ctrlPort = show port, localAddrs} + StopRemoteHost rh_ -> closeRemoteHost rh_ >> ok_ + DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_ + StoreRemoteFile rh encrypted_ localPath -> CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath + GetRemoteFile rh rf -> getRemoteFile rh rf >> ok_ + ConnectRemoteCtrl inv -> withUser_ $ do + (remoteCtrl_, ctrlAppInfo) <- connectRemoteCtrlURI inv + pure CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion = currentAppVersion} + FindKnownRemoteCtrl -> withUser_ $ findKnownRemoteCtrl >> ok_ + ConfirmRemoteCtrl rcId -> withUser_ $ do + (rc, ctrlAppInfo) <- confirmRemoteCtrl rcId + pure CRRemoteCtrlConnecting {remoteCtrl_ = Just rc, ctrlAppInfo, appVersion = currentAppVersion} + VerifyRemoteCtrlSession sessId -> withUser_ $ CRRemoteCtrlConnected <$> verifyRemoteCtrlSession (execChatCommand Nothing) sessId + StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_ + ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls + DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_ + APIUploadStandaloneFile userId file@CryptoFile {filePath} -> withUserId userId $ \user -> do + fsFilePath <- lift $ toFSFilePath filePath + fileSize <- liftIO $ CF.getFileContentsSize file {filePath = fsFilePath} + when (fileSize > toInteger maxFileSizeHard) $ throwChatError $ CEFileSize filePath + (_, _, fileTransferMeta) <- xftpSndFileTransfer_ user file fileSize 1 Nothing + pure CRSndStandaloneFileCreated {user, fileTransferMeta} + APIStandaloneFileInfo FileDescriptionURI {clientData} -> pure . CRStandaloneFileInfo $ clientData >>= J.decodeStrict . encodeUtf8 + APIDownloadStandaloneFile userId uri file -> withUserId userId $ \user -> do + ft <- receiveViaURI user uri file + pure $ CRRcvStandaloneFileCreated user ft + QuitChat -> liftIO exitSuccess + ShowVersion -> do + -- simplexmqCommitQ makes iOS builds crash m( + let versionInfo = coreVersionInfo "" + chatMigrations <- map upMigration <$> withFastStore' (Migrations.getCurrent . DB.conn) + agentMigrations <- withAgent getAgentMigrations + pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations} + DebugLocks -> lift $ do + chatLockName <- atomically . tryReadTMVar =<< asks chatLock + chatEntityLocks <- getLocks =<< asks entityLocks + agentLocks <- withAgent' debugAgentLocks + pure CRDebugLocks {chatLockName, chatEntityLocks, agentLocks} + where + getLocks ls = atomically $ M.mapKeys enityLockString . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls) + enityLockString cle = case cle of + CLInvitation bs -> "Invitation " <> B.unpack bs + CLConnection connId -> "Connection " <> show connId + CLContact ctId -> "Contact " <> show ctId + CLGroup gId -> "Group " <> show gId + CLUserContact ucId -> "UserContact " <> show ucId + CLFile fId -> "File " <> show fId + DebugEvent event -> toView event >> ok_ + GetAgentSubsTotal userId -> withUserId userId $ \user -> do + users <- withStore' $ \db -> getUsers db + let userIds = map aUserId $ filter (\u -> isNothing (viewPwdHash u) || aUserId u == aUserId user) users + (subsTotal, hasSession) <- lift $ withAgent' $ \a -> getAgentSubsTotal a userIds + pure $ CRAgentSubsTotal user subsTotal hasSession + GetAgentServersSummary userId -> withUserId userId $ \user -> do + agentServersSummary <- lift $ withAgent' getAgentServersSummary + withStore' $ \db -> do + users <- getUsers db + smpServers <- getServers db user SPSMP + xftpServers <- getServers db user SPXFTP + let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers + pure $ CRAgentServersSummary user presentedServersSummary + where + getServers :: ProtocolTypeI p => DB.Connection -> User -> SProtocolType p -> IO [ProtocolServer p] + getServers db user p = map (\UserServer {server} -> protoServer server) <$> getProtocolServers db p user + ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_ + GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary + GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails + GetAgentSubs -> lift $ summary <$> withAgent' getAgentSubscriptions + where + summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} = + CRAgentSubs + { activeSubs = foldl' countSubs M.empty activeSubscriptions, + pendingSubs = foldl' countSubs M.empty pendingSubscriptions, + removedSubs = foldl' accSubErrors M.empty removedSubscriptions + } + where + countSubs m SubInfo {server} = M.alter (Just . maybe 1 (+ 1)) server m + accSubErrors m = \case + SubInfo {server, subError = Just e} -> M.alter (Just . maybe [e] (e :)) server m + _ -> m + GetAgentSubsDetails -> lift $ CRAgentSubsDetails <$> withAgent' getAgentSubscriptions + GetAgentQueuesInfo -> lift $ CRAgentQueuesInfo <$> withAgent' getAgentQueuesInfo + -- CustomChatCommand is unsupported, it can be processed in preCmdHook + -- in a modified CLI app or core - the hook should return Either ChatResponse ChatCommand + CustomChatCommand _cmd -> withUser $ \user -> pure $ chatCmdError (Just user) "not supported" + where + -- below code would make command responses asynchronous where they can be slow + -- in View.hs `r'` should be defined as `id` in this case + -- procCmd :: m ChatResponse -> m ChatResponse + -- procCmd action = do + -- ChatController {chatLock = l, smpAgent = a, outputQ = q, random = gVar} <- ask + -- corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8 + -- void . forkIO $ + -- withAgentLock a . withLock l name $ + -- (atomically . writeTBQueue q) . (Just corrId,) =<< (action `catchChatError` (pure . CRChatError)) + -- pure $ CRCmdAccepted corrId + -- use function below to make commands "synchronous" + procCmd :: CM ChatResponse -> CM ChatResponse + procCmd = id + ok_ = pure $ CRCmdOk Nothing + ok = pure . CRCmdOk . Just + getChatRef :: User -> ChatName -> CM ChatRef + getChatRef user (ChatName cType name) = + ChatRef cType <$> case cType of + CTDirect -> withFastStore $ \db -> getContactIdByName db user name + CTGroup -> withFastStore $ \db -> getGroupIdByName db user name + CTLocal + | name == "" -> withFastStore (`getUserNoteFolderId` user) + | otherwise -> throwChatError $ CECommandError "not supported" + _ -> throwChatError $ CECommandError "not supported" + checkChatStopped :: CM ChatResponse -> CM ChatResponse + checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped) + setStoreChanged :: CM () + setStoreChanged = asks chatStoreChanged >>= atomically . (`writeTVar` True) + withStoreChanged :: CM () -> CM ChatResponse + withStoreChanged a = checkChatStopped $ a >> setStoreChanged >> ok_ + checkStoreNotChanged :: CM ChatResponse -> CM ChatResponse + checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged) + withUserName :: UserName -> (UserId -> ChatCommand) -> CM ChatResponse + withUserName uName cmd = withFastStore (`getUserIdByName` uName) >>= processChatCommand . cmd + withContactName :: ContactName -> (ContactId -> ChatCommand) -> CM ChatResponse + withContactName cName cmd = withUser $ \user -> + withFastStore (\db -> getContactIdByName db user cName) >>= processChatCommand . cmd + withMemberName :: GroupName -> ContactName -> (GroupId -> GroupMemberId -> ChatCommand) -> CM ChatResponse + withMemberName gName mName cmd = withUser $ \user -> + getGroupAndMemberId user gName mName >>= processChatCommand . uncurry cmd + getConnectionCode :: ConnId -> CM Text + getConnectionCode connId = verificationCode <$> withAgent (`getConnectionRatchetAdHash` connId) + verifyConnectionCode :: User -> Connection -> Maybe Text -> CM ChatResponse + verifyConnectionCode user conn@Connection {connId} (Just code) = do + code' <- getConnectionCode $ aConnId conn + let verified = sameVerificationCode code code' + when verified . withFastStore' $ \db -> setConnectionVerified db user connId $ Just code' + pure $ CRConnectionVerified user verified code' + verifyConnectionCode user conn@Connection {connId} _ = do + code' <- getConnectionCode $ aConnId conn + withFastStore' $ \db -> setConnectionVerified db user connId Nothing + pure $ CRConnectionVerified user False code' + getSentChatItemIdByText :: User -> ChatRef -> Text -> CM Int64 + getSentChatItemIdByText user@User {userId, localDisplayName} (ChatRef cType cId) msg = case cType of + CTDirect -> withFastStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg + CTGroup -> withFastStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg + CTLocal -> withFastStore $ \db -> getLocalChatItemIdByText db user cId SMDSnd msg + _ -> throwChatError $ CECommandError "not supported" + getChatItemIdByText :: User -> ChatRef -> Text -> CM Int64 + getChatItemIdByText user (ChatRef cType cId) msg = case cType of + CTDirect -> withFastStore $ \db -> getDirectChatItemIdByText' db user cId msg + CTGroup -> withFastStore $ \db -> getGroupChatItemIdByText' db user cId msg + CTLocal -> withFastStore $ \db -> getLocalChatItemIdByText' db user cId msg + _ -> throwChatError $ CECommandError "not supported" + connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> CM ChatResponse + connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withInvitationLock "connectViaContact" (strEncode cReq) $ do + let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli + cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq + case groupLinkId of + -- contact address + Nothing -> + withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case + (Just contact, _) -> pure $ CRContactAlreadyExists user contact + (_, xContactId_) -> procCmd $ do + let randomXContactId = XContactId <$> drgRandomBytes 16 + xContactId <- maybe randomXContactId pure xContactId_ + connect' Nothing cReqHash xContactId False + -- group link + Just gLinkId -> + withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case + (Just _contact, _) -> procCmd $ do + -- allow repeat contact request + newXContactId <- XContactId <$> drgRandomBytes 16 + connect' (Just gLinkId) cReqHash newXContactId True + (_, xContactId_) -> procCmd $ do + let randomXContactId = XContactId <$> drgRandomBytes 16 + xContactId <- maybe randomXContactId pure xContactId_ + connect' (Just gLinkId) cReqHash xContactId True + where + connect' groupLinkId cReqHash xContactId inGroup = do + let pqSup = if inGroup then PQSupportOff else PQSupportOn + (connId, chatV) <- prepareContact user cReq pqSup + -- [incognito] generate profile to send + incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing + subMode <- chatReadVar subscriptionMode + conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup + joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV + pure $ CRSentInvitation user conn incognitoProfile + connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> CM ChatResponse + connectContactViaAddress user incognito ct cReq = + withInvitationLock "connectContactViaAddress" (strEncode cReq) $ do + newXContactId <- XContactId <$> drgRandomBytes 16 + let pqSup = PQSupportOn + (connId, chatV) <- prepareContact user cReq pqSup + let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq + -- [incognito] generate profile to send + incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing + subMode <- chatReadVar subscriptionMode + (pccConnId, ct') <- withFastStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup + joinContact user pccConnId connId cReq incognitoProfile newXContactId False pqSup chatV + pure $ CRSentInvitationToContact user ct' incognitoProfile + prepareContact :: User -> ConnectionRequestUri 'CMContact -> PQSupport -> CM (ConnId, VersionChat) + prepareContact user cReq pqSup = do + -- 0) toggle disabled - PQSupportOff + -- 1) toggle enabled, address supports PQ (connRequestPQSupport returns Just True) - PQSupportOn, enable support with compression + -- 2) toggle enabled, address doesn't support PQ - PQSupportOn but without compression, with version range indicating support + lift (withAgent' $ \a -> connRequestPQSupport a pqSup cReq) >>= \case + Nothing -> throwChatError CEInvalidConnReq + Just (agentV, _) -> do + let chatV = agentToChatVersion agentV + connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup + pure (connId, chatV) + joinContact :: User -> Int64 -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM () + joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV = do + let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup + dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId) + subMode <- chatReadVar subscriptionMode + joinPreparedAgentConnection user pccConnId connId cReq dm pqSup subMode + joinPreparedAgentConnection :: User -> Int64 -> ConnId -> ConnectionRequestUri m -> ByteString -> PQSupport -> SubscriptionMode -> CM () + joinPreparedAgentConnection user pccConnId connId cReq connInfo pqSup subMode = do + void (withAgent $ \a -> joinConnection a (aUserId user) connId True cReq connInfo pqSup subMode) + `catchChatError` \e -> do + withFastStore' $ \db -> deleteConnectionRecord db user pccConnId + withAgent $ \a -> deleteConnectionAsync a False connId + throwError e + contactMember :: Contact -> [GroupMember] -> Maybe GroupMember + contactMember Contact {contactId} = + find $ \GroupMember {memberContactId = cId, memberStatus = s} -> + cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft + checkSndFile :: CryptoFile -> CM Integer + checkSndFile (CryptoFile f cfArgs) = do + fsFilePath <- lift $ toFSFilePath f + unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f + fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs + when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f + pure fileSize + updateProfile :: User -> Profile -> CM ChatResponse + updateProfile user p' = updateProfile_ user p' $ withFastStore $ \db -> updateUserProfile db user p' + updateProfile_ :: User -> Profile -> CM User -> CM ChatResponse + updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser + | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user + | otherwise = do + when (n /= n') $ checkValidName n' + -- read contacts before user update to correctly merge preferences + contacts <- withFastStore' $ \db -> getUserContacts db vr user + user' <- updateUser + asks currentUser >>= atomically . (`writeTVar` Just user') + withChatLock "updateProfile" . procCmd $ do + let changedCts_ = L.nonEmpty $ foldr (addChangedProfileContact user') [] contacts + summary <- case changedCts_ of + Nothing -> pure $ UserProfileUpdateSummary 0 0 [] + Just changedCts -> do + let idsEvts = L.map ctSndEvent changedCts + msgReqs_ <- lift $ L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts + (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ + unless (null errs) $ toView $ CRChatErrors (Just user) errs + let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts + lift $ createContactsSndFeatureItems user' changedCts' + pure + UserProfileUpdateSummary + { updateSuccesses = length cts, + updateFailures = length errs, + changedContacts = map (\ChangedProfileContact {ct'} -> ct') changedCts' + } + pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary + where + -- [incognito] filter out contacts with whom user has incognito connections + addChangedProfileContact :: User -> Contact -> [ChangedProfileContact] -> [ChangedProfileContact] + addChangedProfileContact user' ct changedCts = case contactSendConn_ ct' of + Right conn + | not (connIncognito conn) && mergedProfile' /= mergedProfile -> + ChangedProfileContact ct ct' mergedProfile' conn : changedCts + _ -> changedCts + where + mergedProfile = userProfileToSend user Nothing (Just ct) False + ct' = updateMergedPreferences user' ct + mergedProfile' = userProfileToSend user' Nothing (Just ct') False + ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json) + ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile') + ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq + ctMsgReq ChangedProfileContact {conn} = + fmap $ \SndMessage {msgId, msgBody} -> + (conn, MsgFlags {notification = hasNotification XInfo_}, msgBody, [msgId]) + updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse + updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct + updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' + | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct + | otherwise = do + assertDirectAllowed user MDSnd ct XInfo_ + ct' <- withStore' $ \db -> updateContactUserPreferences db user ct contactUserPrefs' + incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId + let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) False + mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False + when (mergedProfile' /= mergedProfile) $ + withContactLock "updateProfile" (contactId' ct) $ do + void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) + lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' + pure $ CRContactPrefsUpdated user ct ct' + runUpdateGroupProfile :: User -> Group -> GroupProfile -> CM ChatResponse + runUpdateGroupProfile user (Group g@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} ms) p'@GroupProfile {displayName = n'} = do + assertUserGroupRole g GROwner + when (n /= n') $ checkValidName n' + g' <- withStore $ \db -> updateGroupProfile db user g p' + msg <- case businessChat of + Just BusinessChatInfo {businessId} -> do + let (newMs, oldMs) = partition (\m -> maxVersion (memberChatVRange m) >= businessChatPrefsVersion) ms + -- this is a fallback to send the members with the old version correct profile of the business when preferences change + unless (null oldMs) $ do + GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} <- + withStore $ \db -> getGroupMemberByMemberId db vr user g businessId + let p'' = p' {displayName, fullName, image} :: GroupProfile + void $ sendGroupMessage user g' oldMs (XGrpInfo p'') + let ps' = fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' + sendGroupMessage user g' newMs $ XGrpPrefs ps' + Nothing -> sendGroupMessage user g' ms (XGrpInfo p') + let cd = CDGroupSnd g' + unless (sameGroupProfileInfo p p') $ do + ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') + toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat g') ci] + createGroupFeatureChangedItems user cd CISndGroupFeature g g' + pure $ CRGroupUpdated user g g' Nothing + checkValidName :: GroupName -> CM () + checkValidName displayName = do + when (T.null displayName) $ throwChatError CEInvalidDisplayName {displayName, validName = ""} + let validName = T.pack $ mkValidName $ T.unpack displayName + when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName} + assertUserGroupRole :: GroupInfo -> GroupMemberRole -> CM () + assertUserGroupRole g@GroupInfo {membership} requiredRole = do + let GroupMember {memberRole = membershipMemRole} = membership + when (membershipMemRole < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole + when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) + when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved + unless (memberActive membership) $ throwChatError CEGroupMemberNotActive + delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> CM ChatResponse + delGroupChatItems user gInfo items byGroupMember = do + deletedTs <- liftIO getCurrentTime + if groupFeatureAllowed SGFFullDelete gInfo + then deleteGroupCIs user gInfo items True False byGroupMember deletedTs + else markGroupCIsDeleted user gInfo items True byGroupMember deletedTs + updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse + updateGroupProfileByName gName update = withUser $ \user -> do + g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db -> + getGroupIdByName db user gName >>= getGroup db vr user + runUpdateGroupProfile user g $ update p + withCurrentCall :: ContactId -> (User -> Contact -> Call -> CM (Maybe Call)) -> CM ChatResponse + withCurrentCall ctId action = do + (user, ct) <- withStore $ \db -> do + user <- getUserByContactId db ctId + (user,) <$> getContact db vr user ctId + calls <- asks currentCalls + withContactLock "currentCall" ctId $ + atomically (TM.lookup ctId calls) >>= \case + Nothing -> throwChatError CENoCurrentCall + Just call@Call {contactId} + | ctId == contactId -> do + call_ <- action user ct call + case call_ of + Just call' -> do + unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId + atomically $ TM.insert ctId call' calls + _ -> do + withStore' $ \db -> deleteCalls db user ctId + atomically $ TM.delete ctId calls + ok user + | otherwise -> throwChatError $ CECallContact contactId + withServerProtocol :: ProtocolTypeI p => SProtocolType p -> (UserProtocol p => CM a) -> CM a + withServerProtocol p action = case userProtocol p of + Just Dict -> action + _ -> throwChatError $ CEServerProtocol $ AProtocolType p + validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError] + validateAllUsersServers currUserId userServers = withFastStore $ \db -> do + users' <- filter (\User {userId} -> userId /= currUserId) <$> liftIO (getUsers db) + others <- mapM (getUserOperatorServers db) users' + pure $ validateUserServers userServers others + where + getUserOperatorServers :: DB.Connection -> User -> ExceptT StoreError IO (User, [UserOperatorServers]) + getUserOperatorServers db user = do + uss <- liftIO . groupByOperator =<< getUserServers db user + pure (user, map updatedUserSrvs uss) + updatedUserSrvs uss = uss {operator = updatedOp <$> operator' uss} :: UserOperatorServers + updatedOp op = fromMaybe op $ find matchingOp $ mapMaybe operator' userServers + where + matchingOp op' = operatorId op' == operatorId op + forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> CM ChatResponse + forwardFile chatName fileId sendCommand = withUser $ \user -> do + withStore (\db -> getFileTransfer db user fileId) >>= \case + FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}, cryptoArgs} -> forward filePath cryptoArgs + FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs + _ -> throwChatError CEFileNotReceived {fileId} + where + forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs + getGroupAndMemberId :: User -> GroupName -> ContactName -> CM (GroupId, GroupMemberId) + getGroupAndMemberId user gName groupMemberName = + withStore $ \db -> do + groupId <- getGroupIdByName db user gName + groupMemberId <- getGroupMemberIdByName db user groupId groupMemberName + pure (groupId, groupMemberId) + sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> CM () + sendGrpInvitation user ct@Contact {contactId, localDisplayName} gInfo@GroupInfo {groupId, groupProfile, membership, businessChat} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo + let GroupMember {memberRole = userRole, memberId = userMemberId} = membership + groupInv = + GroupInvitation + { fromMember = MemberIdRole userMemberId userRole, + invitedMember = MemberIdRole memberId memRole, + connRequest = cReq, + groupProfile, + business = businessChat, + groupLinkId = Nothing, + groupSize = Just currentMemCount + } + (msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv + let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole + timed_ <- contactCITimed ct + ci <- saveSndChatItem' user (CDDirectSnd ct) msg content Nothing Nothing Nothing timed_ False + toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] + forM_ (timed_ >>= timedDeleteAt') $ + startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) + drgRandomBytes :: Int -> CM ByteString + drgRandomBytes n = asks random >>= atomically . C.randomBytes n + privateGetUser :: UserId -> CM User + privateGetUser userId = + tryChatError (withStore (`getUser` userId)) >>= \case + Left _ -> throwChatError CEUserUnknown + Right user -> pure user + validateUserPassword :: User -> User -> Maybe UserPwd -> CM () + validateUserPassword = validateUserPassword_ . Just + validateUserPassword_ :: Maybe User -> User -> Maybe UserPwd -> CM () + validateUserPassword_ user_ User {userId = userId', viewPwdHash} viewPwd_ = + forM_ viewPwdHash $ \pwdHash -> + let userId_ = (\User {userId} -> userId) <$> user_ + pwdOk = case viewPwd_ of + Nothing -> userId_ == Just userId' + Just (UserPwd viewPwd) -> validPassword viewPwd pwdHash + in unless pwdOk $ throwChatError CEUserUnknown + validPassword :: Text -> UserPwdHash -> Bool + validPassword pwd UserPwdHash {hash = B64UrlByteString hash, salt = B64UrlByteString salt} = + hash == C.sha512Hash (encodeUtf8 pwd <> salt) + setUserNotifications :: UserId -> Bool -> CM ChatResponse + setUserNotifications userId' showNtfs = withUser $ \user -> do + user' <- privateGetUser userId' + case viewPwdHash user' of + Just _ -> throwChatError $ CEHiddenUserAlwaysMuted userId' + _ -> setUserPrivacy user user' {showNtfs} + setUserPrivacy :: User -> User -> CM ChatResponse + setUserPrivacy user@User {userId} user'@User {userId = userId'} + | userId == userId' = do + asks currentUser >>= atomically . (`writeTVar` Just user') + withFastStore' (`updateUserPrivacy` user') + pure $ CRUserPrivacy {user = user', updatedUser = user'} + | otherwise = do + withFastStore' (`updateUserPrivacy` user') + pure $ CRUserPrivacy {user, updatedUser = user'} + checkDeleteChatUser :: User -> CM () + checkDeleteChatUser user@User {userId} = do + users <- withFastStore' getUsers + let otherVisible = filter (\User {userId = userId', viewPwdHash} -> userId /= userId' && isNothing viewPwdHash) users + when (activeUser user && length otherVisible > 0) $ throwChatError (CECantDeleteActiveUser userId) + deleteChatUser :: User -> Bool -> CM ChatResponse + deleteChatUser user delSMPQueues = do + filesInfo <- withFastStore' (`getUserFileInfo` user) + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + withAgent (\a -> deleteUser a (aUserId user) delSMPQueues) + `catchChatError` \case + e@(ChatErrorAgent NO_USER _) -> toView $ CRChatError (Just user) e + e -> throwError e + withFastStore' (`deleteUserRecord` user) + when (activeUser user) $ chatWriteVar currentUser Nothing + ok_ + updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> CM ChatResponse + updateChatSettings (ChatName cType name) updateSettings = withUser $ \user -> do + (chatId, chatSettings) <- case cType of + CTDirect -> withFastStore $ \db -> do + ctId <- getContactIdByName db user name + Contact {chatSettings} <- getContact db vr user ctId + pure (ctId, chatSettings) + CTGroup -> + withFastStore $ \db -> do + gId <- getGroupIdByName db user name + GroupInfo {chatSettings} <- getGroupInfo db vr user gId + pure (gId, chatSettings) + _ -> throwChatError $ CECommandError "not supported" + processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings + connectPlan :: User -> AConnectionRequestUri -> CM ConnectionPlan + connectPlan user (ACR SCMInvitation (CRInvitationUri crData e2e)) = do + withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqSchemas) >>= \case + Nothing -> pure $ CPInvitationLink ILPOk + Just (RcvDirectMsgConnection Connection {connStatus = ConnPrepared} Nothing) -> + pure $ CPInvitationLink ILPOk + Just (RcvDirectMsgConnection conn ct_) -> do + let Connection {connStatus, contactConnInitiated} = conn + if + | connStatus == ConnNew && contactConnInitiated -> + pure $ CPInvitationLink ILPOwnLink + | not (connReady conn) -> + pure $ CPInvitationLink (ILPConnecting ct_) + | otherwise -> case ct_ of + Just ct -> pure $ CPInvitationLink (ILPKnown ct) + Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact" + Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" + where + cReqSchemas :: (ConnReqInvitation, ConnReqInvitation) + cReqSchemas = + ( CRInvitationUri crData {crScheme = SSSimplex} e2e, + CRInvitationUri crData {crScheme = simplexChat} e2e + ) + connectPlan user (ACR SCMContact (CRContactUri crData)) = do + let ConnReqUriData {crClientData} = crData + groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli + case groupLinkId of + -- contact address + Nothing -> + withFastStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case + Just _ -> pure $ CPContactAddress CAPOwnLink + Nothing -> + withFastStore' (\db -> getContactConnEntityByConnReqHash db vr user cReqHashes) >>= \case + Nothing -> + withFastStore' (\db -> getContactWithoutConnViaAddress db vr user cReqSchemas) >>= \case + Nothing -> pure $ CPContactAddress CAPOk + Just ct -> pure $ CPContactAddress (CAPContactViaAddress ct) + Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect + Just (RcvDirectMsgConnection _ (Just ct)) + | not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct) + | contactDeleted ct -> pure $ CPContactAddress CAPOk + | otherwise -> pure $ CPContactAddress (CAPKnown ct) + Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo + Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection" + -- group link + Just _ -> + withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db vr user cReqSchemas) >>= \case + Just g -> pure $ CPGroupLink (GLPOwnLink g) + Nothing -> do + connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db vr user cReqHashes + gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db vr user cReqHashes + case (gInfo_, connEnt_) of + (Nothing, Nothing) -> pure $ CPGroupLink GLPOk + (Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect + (Nothing, Just (RcvDirectMsgConnection _ (Just ct))) + | not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_) + | otherwise -> pure $ CPGroupLink GLPOk + (Nothing, Just _) -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" + (Just gInfo, _) -> groupPlan gInfo + where + groupPlan gInfo@GroupInfo {membership} + | not (memberActive membership) && not (memberRemoved membership) = + pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo) + | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo) + | otherwise = pure $ CPGroupLink GLPOk + cReqSchemas :: (ConnReqContact, ConnReqContact) + cReqSchemas = + ( CRContactUri crData {crScheme = SSSimplex}, + CRContactUri crData {crScheme = simplexChat} + ) + cReqHashes :: (ConnReqUriHash, ConnReqUriHash) + cReqHashes = bimap hash hash cReqSchemas + hash = ConnReqUriHash . C.sha256Hash . strEncode + updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do + AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db vr user groupId + case (cInfo, content) of + (DirectChat ct@Contact {contactId}, CIRcvGroupInvitation ciGroupInv@CIGroupInvitation {status} memRole) + | status == CIGISPending -> do + let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = newStatus} memRole + timed_ <- contactCITimed ct + updateDirectChatItemView user ct itemId aciContent False False timed_ Nothing + forM_ (timed_ >>= timedDeleteAt') $ + startProximateTimedItemThread user (ChatRef CTDirect contactId, itemId) + _ -> pure () -- prohibited + sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse + sendContactContentMessages user contactId live itemTTL cmrs = do + assertMultiSendable live cmrs + ct@Contact {contactUsed} <- withFastStore $ \db -> getContact db vr user contactId + assertDirectAllowed user MDSnd ct XMsgNew_ + assertVoiceAllowed ct + unless contactUsed $ withFastStore' $ \db -> updateContactUsed db user ct + processComposedMessages ct + where + assertVoiceAllowed :: Contact -> CM () + assertVoiceAllowed ct = + when (not (featureAllowed SCFVoice forUser ct) && any (\(ComposedMessage {msgContent}, _) -> isVoice msgContent) cmrs) $ + throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFVoice)) + processComposedMessages :: Contact -> CM ChatResponse + processComposedMessages ct = do + (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers + timed_ <- sndContactCITimed live ct itemTTL + (msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ + msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers + let itemsData = prepareSndItemsData msgs_ cmrs ciFiles_ quotedItems_ + when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch" + r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live + processSendErrs user r + forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> + forM_ cis $ \ci -> + startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) deleteAt + pure $ CRNewChatItems user (map (AChatItem SCTDirect SMDSnd (DirectChat ct)) cis) + where + setupSndFileTransfers :: CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))) + setupSndFileTransfers = + forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> case file_ of + Just file -> do + fileSize <- checkSndFile file + (fInv, ciFile) <- xftpSndFileTransfer user file fileSize 1 $ CGContact ct + pure (Just fInv, Just ciFile) + Nothing -> pure (Nothing, Nothing) + prepareMsgs :: NonEmpty (ComposeMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))) + prepareMsgs cmsFileInvs timed_ = + forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded), fInv_) -> + case (quotedItemId, itemForwarded) of + (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Just qiId, Nothing) -> do + CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- + withFastStore $ \db -> getDirectChatItem db user contactId qiId + (origQmc, qd, sent) <- quoteData qci + let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing} + qmc = quoteContent mc origQmc file + quotedItem = CIQuote {chatDir = qd, itemId = Just qiId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} + pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem) + (Just _, Just _) -> throwChatError CEInvalidQuote + where + quoteData :: ChatItem c d -> CM (MsgContent, CIQDirection 'CTDirect, Bool) + quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote + quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True) + quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) + quoteData _ = throwChatError CEInvalidQuote + sendGroupContentMessages :: User -> GroupId -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse + sendGroupContentMessages user groupId live itemTTL cmrs = do + assertMultiSendable live cmrs + g@(Group gInfo _) <- withFastStore $ \db -> getGroup db vr user groupId + assertUserGroupRole gInfo GRAuthor + assertGroupContentAllowed gInfo + processComposedMessages g + where + assertGroupContentAllowed :: GroupInfo -> CM () + assertGroupContentAllowed gInfo@GroupInfo {membership} = + case findProhibited (L.toList cmrs) of + Just f -> throwChatError (CECommandError $ "feature not allowed " <> T.unpack (groupFeatureNameText f)) + Nothing -> pure () + where + findProhibited :: [ComposeMessageReq] -> Maybe GroupFeature + findProhibited = + foldr' + (\(ComposedMessage {fileSource, msgContent = mc}, _) acc -> prohibitedGroupContent gInfo membership mc fileSource <|> acc) + Nothing + processComposedMessages :: Group -> CM ChatResponse + processComposedMessages g@(Group gInfo ms) = do + (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length $ filter memberCurrent ms) + timed_ <- sndGroupCITimed live gInfo itemTTL + (msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ + (msgs_, gsr) <- sendGroupMessages user gInfo ms $ L.map XMsgNew msgContainers + let itemsData = prepareSndItemsData (L.toList msgs_) cmrs ciFiles_ quotedItems_ + cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live + when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" + createMemberSndStatuses cis_ msgs_ gsr + let r@(_, cis) = partitionEithers cis_ + processSendErrs user r + forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> + forM_ cis $ \ci -> + startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) deleteAt + pure $ CRNewChatItems user (map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) cis) + where + setupSndFileTransfers :: Int -> CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))) + setupSndFileTransfers n = + forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> case file_ of + Just file -> do + fileSize <- checkSndFile file + (fInv, ciFile) <- xftpSndFileTransfer user file fileSize n $ CGGroup g + pure (Just fInv, Just ciFile) + Nothing -> pure (Nothing, Nothing) + prepareMsgs :: NonEmpty (ComposeMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTGroup))) + prepareMsgs cmsFileInvs timed_ = + forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded), fInv_) -> + prepareGroupMsg user gInfo mc quotedItemId itemForwarded fInv_ timed_ live + createMemberSndStatuses :: + [Either ChatError (ChatItem 'CTGroup 'MDSnd)] -> + NonEmpty (Either ChatError SndMessage) -> + GroupSndResult -> + CM () + createMemberSndStatuses cis_ msgs_ GroupSndResult {sentTo, pending, forwarded} = do + let msgToItem = mapMsgToItem + withFastStore' $ \db -> do + forM_ sentTo (processSentTo db msgToItem) + forM_ forwarded (processForwarded db) + forM_ pending (processPending db msgToItem) + where + mapMsgToItem :: Map MessageId ChatItemId + mapMsgToItem = foldr' addItem M.empty (zip (L.toList msgs_) cis_) + where + addItem (Right SndMessage {msgId}, Right ci) m = M.insert msgId (chatItemId' ci) m + addItem _ m = m + processSentTo :: DB.Connection -> Map MessageId ChatItemId -> (GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption)) -> IO () + processSentTo db msgToItem (mId, msgIds_, deliveryResult) = forM_ msgIds_ $ \msgIds -> do + let ciIds = mapMaybe (`M.lookup` msgToItem) msgIds + status = case deliveryResult of + Right _ -> GSSNew + Left e -> GSSError $ SndErrOther $ tshow e + forM_ ciIds $ \ciId -> createGroupSndStatus db ciId mId status + processForwarded :: DB.Connection -> GroupMember -> IO () + processForwarded db GroupMember {groupMemberId} = + forM_ cis_ $ \ci_ -> + forM_ ci_ $ \ci -> createGroupSndStatus db (chatItemId' ci) groupMemberId GSSForwarded + processPending :: DB.Connection -> Map MessageId ChatItemId -> (GroupMemberId, Either ChatError MessageId, Either ChatError ()) -> IO () + processPending db msgToItem (mId, msgId_, pendingResult) = forM_ msgId_ $ \msgId -> do + let ciId_ = M.lookup msgId msgToItem + status = case pendingResult of + Right _ -> GSSInactive + Left e -> GSSError $ SndErrOther $ tshow e + forM_ ciId_ $ \ciId -> createGroupSndStatus db ciId mId status + assertMultiSendable :: Bool -> NonEmpty ComposeMessageReq -> CM () + assertMultiSendable live cmrs + | length cmrs == 1 = pure () + | otherwise = + -- When sending multiple messages only single quote is allowed. + -- This is to support case of sending multiple attachments while also quoting another message. + -- UI doesn't allow composing with multiple quotes, so api prohibits it as well, and doesn't bother + -- batching retrieval of quoted messages (prepareMsgs). + when (live || length (L.filter (\(ComposedMessage {quotedItemId}, _) -> isJust quotedItemId) cmrs) > 1) $ + throwChatError (CECommandError "invalid multi send: live and more than one quote not supported") + xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd) + xftpSndFileTransfer user file fileSize n contactOrGroup = do + (fInv, ciFile, ft) <- xftpSndFileTransfer_ user file fileSize n $ Just contactOrGroup + case contactOrGroup of + CGContact Contact {activeConn} -> forM_ activeConn $ \conn -> + withFastStore' $ \db -> createSndFTDescrXFTP db user Nothing conn ft dummyFileDescr + CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CRChatError (Just user)) + where + -- we are not sending files to pending members, same as with inline files + saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} = + when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $ + withFastStore' $ + \db -> createSndFTDescrXFTP db user (Just m) conn ft dummyFileDescr + saveMemberFD _ = pure () + pure (fInv, ciFile) + prepareSndItemsData :: + [Either ChatError SndMessage] -> + NonEmpty ComposeMessageReq -> + NonEmpty (Maybe (CIFile 'MDSnd)) -> + NonEmpty (Maybe (CIQuote c)) -> + [Either ChatError (NewSndChatItemData c)] + prepareSndItemsData msgs_ cmrs' ciFiles_ quotedItems_ = + [ ( case msg_ of + Right msg -> Right $ NewSndChatItemData msg (CISndMsgContent msgContent) f q itemForwarded + Left e -> Left e -- step over original error + ) + | (msg_, (ComposedMessage {msgContent}, itemForwarded), f, q) <- + zipWith4 (,,,) msgs_ (L.toList cmrs') (L.toList ciFiles_) (L.toList quotedItems_) + ] + processSendErrs :: User -> ([ChatError], [ChatItem c d]) -> CM () + processSendErrs user = \case + -- no errors + ([], _) -> pure () + -- at least one item is successfully created + (errs, _ci : _) -> toView $ CRChatErrors (Just user) errs + -- single error + ([err], []) -> throwError err + -- multiple errors + (errs@(err : _), []) -> do + toView $ CRChatErrors (Just user) errs + throwError err + getCommandDirectChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (Contact, [CChatItem 'CTDirect]) + getCommandDirectChatItems user ctId itemIds = do + ct <- withFastStore $ \db -> getContact db vr user ctId + (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure (ct, items) + where + getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect)) + getDirectCI db itemId = runExceptT . withExceptT ChatErrorStore $ getDirectChatItem db user ctId itemId + getCommandGroupChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (GroupInfo, [CChatItem 'CTGroup]) + getCommandGroupChatItems user gId itemIds = do + gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId + (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure (gInfo, items) + where + getGroupCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup)) + getGroupCI db itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user gId itemId + getCommandLocalChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (NoteFolder, [CChatItem 'CTLocal]) + getCommandLocalChatItems user nfId itemIds = do + nf <- withStore $ \db -> getNoteFolder db user nfId + (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getLocalCI db) (L.toList itemIds)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure (nf, items) + where + getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal)) + getLocalCI db itemId = runExceptT . withExceptT ChatErrorStore $ getLocalChatItem db user nfId itemId + forwardMsgContent :: ChatItem c d -> CM (Maybe MsgContent) + forwardMsgContent ChatItem {meta = CIMeta {itemDeleted = Just _}} = pure Nothing -- this can be deleted after selection + forwardMsgContent ChatItem {content = CISndMsgContent fmc} = pure $ Just fmc + forwardMsgContent ChatItem {content = CIRcvMsgContent fmc} = pure $ Just fmc + forwardMsgContent _ = throwChatError CEInvalidForward + createNoteFolderContentItems :: User -> NoteFolderId -> NonEmpty ComposeMessageReq -> CM ChatResponse + createNoteFolderContentItems user folderId cmrs = do + assertNoQuotes + nf <- withFastStore $ \db -> getNoteFolder db user folderId + createdAt <- liftIO getCurrentTime + ciFiles_ <- createLocalFiles nf createdAt + let itemsData = prepareLocalItemsData cmrs ciFiles_ + cis <- createLocalChatItems user (CDLocalSnd nf) itemsData createdAt + pure $ CRNewChatItems user (map (AChatItem SCTLocal SMDSnd (LocalChat nf)) cis) + where + assertNoQuotes :: CM () + assertNoQuotes = + when (any (\(ComposedMessage {quotedItemId}, _) -> isJust quotedItemId) cmrs) $ + throwChatError (CECommandError "createNoteFolderContentItems: quotes not supported") + createLocalFiles :: NoteFolder -> UTCTime -> CM (NonEmpty (Maybe (CIFile 'MDSnd))) + createLocalFiles nf createdAt = + forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> + forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do + fsFilePath <- lift $ toFSFilePath filePath + fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs + chunkSize <- asks $ fileChunkSize . config + withFastStore' $ \db -> do + fileId <- createLocalFile CIFSSndStored db user nf createdAt cf fileSize chunkSize + pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndStored, fileProtocol = FPLocal} + prepareLocalItemsData :: + NonEmpty ComposeMessageReq -> + NonEmpty (Maybe (CIFile 'MDSnd)) -> + [(CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom)] + prepareLocalItemsData cmrs' ciFiles_ = + [ (CISndMsgContent mc, f, itemForwarded) + | ((ComposedMessage {msgContent = mc}, itemForwarded), f) <- zip (L.toList cmrs') (L.toList ciFiles_) + ] + getConnQueueInfo user Connection {connId, agentConnId = AgentConnId acId} = do + msgInfo <- withFastStore' (`getLastRcvMsgInfo` connId) + CRQueueInfo user msgInfo <$> withAgent (`getConnectionQueueInfo` acId) + +protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) +protocolServers p (operators, smpServers, xftpServers) = case p of + SPSMP -> (operators, smpServers, []) + SPXFTP -> (operators, [], xftpServers) + +-- disable preset and replace custom servers (groupByOperator always adds custom) +updatedServers :: forall p. UserProtocol p => SProtocolType p -> [AUserServer p] -> UserOperatorServers -> UpdatedUserOperatorServers +updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers} = case p' of + SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers) + SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers) + where + u = uncurry $ UpdatedUserOperatorServers operator + updateSrvs :: [UserServer p] -> [AUserServer p] + updateSrvs pSrvs = map disableSrv pSrvs <> maybe srvs (const []) operator + disableSrv srv@UserServer {preset} = + AUS SDBStored $ if preset then srv {enabled = False} else srv {deleted = True} + +type ComposeMessageReq = (ComposedMessage, Maybe CIForwardedFrom) + +data ChangedProfileContact = ChangedProfileContact + { ct :: Contact, + ct' :: Contact, + mergedProfile' :: Profile, + conn :: Connection + } + +createContactsSndFeatureItems :: User -> [ChangedProfileContact] -> CM' () +createContactsSndFeatureItems user cts = + createContactsFeatureItems user cts' CDDirectSnd CISndChatFeature CISndChatPreference getPref + where + cts' = map (\ChangedProfileContact {ct, ct'} -> (ct, ct')) cts + getPref ContactUserPreference {userPreference} = case userPreference of + CUPContact {preference} -> preference + CUPUser {preference} -> preference + +assertDirectAllowed :: User -> MsgDirection -> Contact -> CMEventTag e -> CM () +assertDirectAllowed user dir ct event = + unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $ + throwChatError (CEDirectMessagesProhibited dir ct) + where + directMessagesAllowed = any (uncurry $ groupFeatureMemberAllowed' SGFDirectMessages) <$> withStore' (\db -> getContactGroupPreferences db user ct) + allowedChatEvent = case event of + XMsgNew_ -> False + XMsgUpdate_ -> False + XMsgDel_ -> False + XFile_ -> False + XGrpInv_ -> False + XCallInv_ -> False + _ -> True + +startExpireCIThread :: User -> CM' () +startExpireCIThread user@User {userId} = do + expireThreads <- asks expireCIThreads + atomically (TM.lookup userId expireThreads) >>= \case + Nothing -> do + a <- Just <$> async runExpireCIs + atomically $ TM.insert userId a expireThreads + _ -> pure () + where + runExpireCIs = do + delay <- asks (initialCleanupManagerDelay . config) + liftIO $ threadDelay' delay + interval <- asks $ ciExpirationInterval . config + forever $ do + flip catchChatError' (toView' . CRChatError (Just user)) $ do + expireFlags <- asks expireCIFlags + atomically $ TM.lookup userId expireFlags >>= \b -> unless (b == Just True) retry + lift waitChatStartedAndActivated + ttl <- withStore' (`getChatItemTTL` user) + forM_ ttl $ \t -> expireChatItems user t False + liftIO $ threadDelay' interval + +setExpireCIFlag :: User -> Bool -> CM' () +setExpireCIFlag User {userId} b = do + expireFlags <- asks expireCIFlags + atomically $ TM.insert userId b expireFlags + +setAllExpireCIFlags :: Bool -> CM' () +setAllExpireCIFlags b = do + expireFlags <- asks expireCIFlags + atomically $ do + keys <- M.keys <$> readTVar expireFlags + forM_ keys $ \k -> TM.insert k b expireFlags + +agentSubscriber :: CM' () +agentSubscriber = do + q <- asks $ subQ . smpAgent + forever (atomically (readTBQueue q) >>= process) + `E.catchAny` \e -> do + toView' $ CRChatError Nothing $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) Nothing + E.throwIO e + where + process :: (ACorrId, AEntityId, AEvt) -> CM' () + process (corrId, entId, AEvt e msg) = run $ case e of + SAENone -> processAgentMessageNoConn msg + SAEConn -> processAgentMessage corrId entId msg + SAERcvFile -> processAgentMsgRcvFile corrId entId msg + SAESndFile -> processAgentMsgSndFile corrId entId msg + where + run action = action `catchChatError'` (toView' . CRChatError Nothing) + +type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType ())) + +subscribeUserConnections :: VersionRangeChat -> Bool -> AgentBatchSubscribe -> User -> CM () +subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do + -- get user connections + ce <- asks $ subscriptionEvents . config + (conns, cts, ucs, gs, ms, sfts, rfts, pcs) <- + if onlyNeeded + then do + (conns, entities) <- withStore' (`getConnectionsToSubscribe` vr) + let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity (M.empty, M.empty, M.empty, M.empty, M.empty, M.empty) entities + pure (conns, cts, ucs, [], ms, sfts, rfts, pcs) + else do + withStore' unsetConnectionToSubscribe + (ctConns, cts) <- getContactConns + (ucConns, ucs) <- getUserContactLinkConns + (gs, mConns, ms) <- getGroupMemberConns + (sftConns, sfts) <- getSndFileTransferConns + (rftConns, rfts) <- getRcvFileTransferConns + (pcConns, pcs) <- getPendingContactConns + let conns = concat ([ctConns, ucConns, mConns, sftConns, rftConns, pcConns] :: [[ConnId]]) + pure (conns, cts, ucs, gs, ms, sfts, rfts, pcs) + -- subscribe using batched commands + rs <- withAgent $ \a -> agentBatchSubscribe a conns + -- send connection events to view + contactSubsToView rs cts ce + -- TODO possibly, we could either disable these events or replace with less noisy for API + contactLinkSubsToView rs ucs + groupSubsToView rs gs ms ce + sndFileSubsToView rs sfts + rcvFileSubsToView rs rfts + pendingConnSubsToView rs pcs + where + addEntity (cts, ucs, ms, sfts, rfts, pcs) = \case + RcvDirectMsgConnection c (Just ct) -> let cts' = addConn c ct cts in (cts', ucs, ms, sfts, rfts, pcs) + RcvDirectMsgConnection c Nothing -> let pcs' = addConn c (toPCC c) pcs in (cts, ucs, ms, sfts, rfts, pcs') + RcvGroupMsgConnection c _g m -> let ms' = addConn c m ms in (cts, ucs, ms', sfts, rfts, pcs) + SndFileConnection c sft -> let sfts' = addConn c sft sfts in (cts, ucs, ms, sfts', rfts, pcs) + RcvFileConnection c rft -> let rfts' = addConn c rft rfts in (cts, ucs, ms, sfts, rfts', pcs) + UserContactConnection c uc -> let ucs' = addConn c uc ucs in (cts, ucs', ms, sfts, rfts, pcs) + addConn :: Connection -> a -> Map ConnId a -> Map ConnId a + addConn = M.insert . aConnId + toPCC Connection {connId, agentConnId, connStatus, viaUserContactLink, groupLinkId, customUserProfileId, localAlias, createdAt} = + PendingContactConnection + { pccConnId = connId, + pccAgentConnId = agentConnId, + pccConnStatus = connStatus, + viaContactUri = False, + viaUserContactLink, + groupLinkId, + customUserProfileId, + connReqInv = Nothing, + localAlias, + createdAt, + updatedAt = createdAt + } + getContactConns :: CM ([ConnId], Map ConnId Contact) + getContactConns = do + cts <- withStore_ (`getUserContacts` vr) + let cts' = mapMaybe (\ct -> (,ct) <$> contactConnId ct) $ filter contactActive cts + pure (map fst cts', M.fromList cts') + getUserContactLinkConns :: CM ([ConnId], Map ConnId UserContact) + getUserContactLinkConns = do + (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr) + let connIds = map aConnId cs + pure (connIds, M.fromList $ zip connIds ucs) + getGroupMemberConns :: CM ([Group], [ConnId], Map ConnId GroupMember) + getGroupMemberConns = do + gs <- withStore_ (`getUserGroups` vr) + let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs + pure (gs, map fst mPairs, M.fromList mPairs) + getSndFileTransferConns :: CM ([ConnId], Map ConnId SndFileTransfer) + getSndFileTransferConns = do + sfts <- withStore_ getLiveSndFileTransfers + let connIds = map sndFileTransferConnId sfts + pure (connIds, M.fromList $ zip connIds sfts) + getRcvFileTransferConns :: CM ([ConnId], Map ConnId RcvFileTransfer) + getRcvFileTransferConns = do + rfts <- withStore_ getLiveRcvFileTransfers + let rftPairs = mapMaybe (\ft -> (,ft) <$> liveRcvFileTransferConnId ft) rfts + pure (map fst rftPairs, M.fromList rftPairs) + getPendingContactConns :: CM ([ConnId], Map ConnId PendingContactConnection) + getPendingContactConns = do + pcs <- withStore_ getPendingContactConnections + let connIds = map aConnId' pcs + pure (connIds, M.fromList $ zip connIds pcs) + contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> CM () + contactSubsToView rs cts ce = do + chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses) + ifM (asks $ coreApi . config) (notifyAPI statuses) notifyCLI + where + notifyCLI = do + let cRs = resultsFor rs cts + cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs + toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs + when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors + notifyAPI = toView . CRNetworkStatuses (Just user) . map (uncurry ConnNetworkStatus) + statuses = M.foldrWithKey' addStatus [] cts + where + addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)] + addStatus _ Contact {activeConn = Nothing} nss = nss + addStatus connId Contact {activeConn = Just Connection {agentConnId}} nss = + let ns = (agentConnId, netStatus $ resultErr connId rs) + in ns : nss + netStatus :: Maybe ChatError -> NetworkStatus + netStatus = maybe NSConnected $ NSError . errorNetworkStatus + errorNetworkStatus :: ChatError -> String + errorNetworkStatus = \case + ChatErrorAgent (BROKER _ NETWORK) _ -> "network" + ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted" + e -> show e + -- TODO possibly below could be replaced with less noisy events for API + contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM () + contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs + groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> CM () + groupSubsToView rs gs ms ce = do + mapM_ groupSub $ + sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs + toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs + where + mRs = resultsFor rs ms + groupSub :: Group -> CM () + groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do + when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors + toView groupEvent + where + mErrors :: [(GroupMember, ChatError)] + mErrors = + sortOn (\(GroupMember {localDisplayName = n}, _) -> n) + . filterErrors + $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs + groupEvent :: ChatResponse + groupEvent + | memberStatus membership == GSMemInvited = CRGroupInvitation user g + | all (\GroupMember {activeConn} -> isNothing activeConn) members = + if memberActive membership + then CRGroupEmpty user g + else CRGroupRemoved user g + | otherwise = CRGroupSubscribed user g + sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> CM () + sndFileSubsToView rs sfts = do + let sftRs = resultsFor rs sfts + forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do + forM_ err_ $ toView . CRSndFileSubError user ft + void . forkIO $ do + threadDelay 1000000 + when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withChatLock "subscribe sendFileChunk" $ + sendFileChunk user ft + rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> CM () + rcvFileSubsToView rs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . filterErrors . resultsFor rs + pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> CM () + pendingConnSubsToView rs = toView . CRPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs + withStore_ :: (DB.Connection -> User -> IO [a]) -> CM [a] + withStore_ a = withStore' (`a` user) `catchChatError` \e -> toView (CRChatError (Just user) e) $> [] + filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)] + filterErrors = mapMaybe (\(a, e_) -> (a,) <$> e_) + resultsFor :: Map ConnId (Either AgentErrorType ()) -> Map ConnId a -> [(a, Maybe ChatError)] + resultsFor rs = M.foldrWithKey' addResult [] + where + addResult :: ConnId -> a -> [(a, Maybe ChatError)] -> [(a, Maybe ChatError)] + addResult connId = (:) . (,resultErr connId rs) + resultErr :: ConnId -> Map ConnId (Either AgentErrorType ()) -> Maybe ChatError + resultErr connId rs = case M.lookup connId rs of + Just (Left e) -> Just $ ChatErrorAgent e Nothing + Just _ -> Nothing + _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId + +cleanupManager :: CM () +cleanupManager = do + interval <- asks (cleanupManagerInterval . config) + runWithoutInitialDelay interval + initialDelay <- asks (initialCleanupManagerDelay . config) + liftIO $ threadDelay' initialDelay + stepDelay <- asks (cleanupManagerStepDelay . config) + forever $ do + flip catchChatError (toView . CRChatError Nothing) $ do + lift waitChatStartedAndActivated + users <- withStore' getUsers + let (us, us') = partition activeUser users + forM_ us $ cleanupUser interval stepDelay + forM_ us' $ cleanupUser interval stepDelay + cleanupMessages `catchChatError` (toView . CRChatError Nothing) + -- TODO possibly, also cleanup async commands + cleanupProbes `catchChatError` (toView . CRChatError Nothing) + liftIO $ threadDelay' $ diffToMicroseconds interval + where + runWithoutInitialDelay cleanupInterval = flip catchChatError (toView . CRChatError Nothing) $ do + lift waitChatStartedAndActivated + users <- withStore' getUsers + let (us, us') = partition activeUser users + forM_ us $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CRChatError (Just u)) + forM_ us' $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CRChatError (Just u)) + cleanupUser cleanupInterval stepDelay user = do + cleanupTimedItems cleanupInterval user `catchChatError` (toView . CRChatError (Just user)) + liftIO $ threadDelay' stepDelay + cleanupDeletedContacts user `catchChatError` (toView . CRChatError (Just user)) + liftIO $ threadDelay' stepDelay + cleanupTimedItems cleanupInterval user = do + ts <- liftIO getCurrentTime + let startTimedThreadCutoff = addUTCTime cleanupInterval ts + timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff + forM_ timedItems $ \(itemRef, deleteAt) -> startTimedItemThread user itemRef deleteAt `catchChatError` const (pure ()) + cleanupDeletedContacts user = do + vr <- chatVersionRange + contacts <- withStore' $ \db -> getDeletedContacts db vr user + forM_ contacts $ \ct -> + withStore (\db -> deleteContactWithoutGroups db user ct) + `catchChatError` (toView . CRChatError (Just user)) + cleanupMessages = do + ts <- liftIO getCurrentTime + let cutoffTs = addUTCTime (-(30 * nominalDay)) ts + withStore' (`deleteOldMessages` cutoffTs) + cleanupProbes = do + ts <- liftIO getCurrentTime + let cutoffTs = addUTCTime (-(14 * nominalDay)) ts + withStore' (`deleteOldProbes` cutoffTs) + +expireChatItems :: User -> Int64 -> Bool -> CM () +expireChatItems user@User {userId} ttl sync = do + currentTs <- liftIO getCurrentTime + vr <- chatVersionRange + let expirationDate = addUTCTime (-1 * fromIntegral ttl) currentTs + -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts + createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs + lift waitChatStartedAndActivated + contacts <- withStore' $ \db -> getUserContacts db vr user + loop contacts $ processContact expirationDate + lift waitChatStartedAndActivated + groups <- withStore' $ \db -> getUserGroupDetails db vr user Nothing Nothing + loop groups $ processGroup vr expirationDate createdAtCutoff + where + loop :: [a] -> (a -> CM ()) -> CM () + loop [] _ = pure () + loop (a : as) process = continue $ do + process a `catchChatError` (toView . CRChatError (Just user)) + loop as process + continue :: CM () -> CM () + continue a = + if sync + then a + else do + expireFlags <- asks expireCIFlags + expire <- atomically $ TM.lookup userId expireFlags + when (expire == Just True) $ threadDelay 100000 >> a + processContact :: UTCTime -> Contact -> CM () + processContact expirationDate ct = do + lift waitChatStartedAndActivated + filesInfo <- withStore' $ \db -> getContactExpiredFileInfo db user ct expirationDate + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + withStore' $ \db -> deleteContactExpiredCIs db user ct expirationDate + processGroup :: VersionRangeChat -> UTCTime -> UTCTime -> GroupInfo -> CM () + processGroup vr expirationDate createdAtCutoff gInfo = do + lift waitChatStartedAndActivated + filesInfo <- withStore' $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + withStore' $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff + membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db vr user gInfo + forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m + +chatCommandP :: Parser ChatCommand +chatCommandP = + choice + [ "/mute " *> ((`SetShowMessages` MFNone) <$> chatNameP), + "/unmute " *> ((`SetShowMessages` MFAll) <$> chatNameP), + "/unmute mentions " *> ((`SetShowMessages` MFMentions) <$> chatNameP), + "/receipts " *> (SetSendReceipts <$> chatNameP <* " " <*> ((Just <$> onOffP) <|> ("default" $> Nothing))), + "/block #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False), + "/unblock #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True), + "/_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 contacts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings), + "/set receipts contacts " *> (SetUserContactReceipts <$> receiptSettings), + "/_set receipts groups " *> (APISetUserGroupReceipts <$> A.decimal <* A.space <*> receiptSettings), + "/set receipts groups " *> (SetUserGroupReceipts <$> receiptSettings), + "/_hide user " *> (APIHideUser <$> A.decimal <* A.space <*> jsonP), + "/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP), + "/_mute user " *> (APIMuteUser <$> A.decimal), + "/_unmute user " *> (APIUnmuteUser <$> A.decimal), + "/hide user " *> (HideUser <$> pwdP), + "/unhide user " *> (UnhideUser <$> pwdP), + "/mute user" $> MuteUser, + "/unmute user" $> UnmuteUser, + "/_delete user " *> (APIDeleteUser <$> A.decimal <* " del_smp=" <*> onOffP <*> optional (A.space *> jsonP)), + "/delete user " *> (DeleteUser <$> displayName <*> pure True <*> optional (A.space *> pwdP)), + ("/user" <|> "/u") $> ShowActiveUser, + "/_start " *> do + mainApp <- "main=" *> onOffP + enableSndFiles <- " snd_files=" *> onOffP <|> pure mainApp + pure StartChat {mainApp, enableSndFiles}, + "/_start" $> StartChat True True, + "/_check running" $> CheckChatRunning, + "/_stop" $> APIStopChat, + "/_app activate restore=" *> (APIActivateChat <$> onOffP), + "/_app activate" $> APIActivateChat True, + "/_app suspend " *> (APISuspendChat <$> A.decimal), + "/_resubscribe all" $> ResubscribeAllConnections, + -- deprecated, use /set file paths + "/_temp_folder " *> (SetTempFolder <$> filePath), + -- /_files_folder deprecated, use /set file paths + ("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath), + -- deprecated, use /set file paths + "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath), + "/set file paths " *> (APISetAppFilePaths <$> jsonP), + "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), + "/contact_merge " *> (SetContactMergeEnabled <$> onOffP), + "/_db export " *> (APIExportArchive <$> jsonP), + "/db export" $> ExportArchive, + "/_db import " *> (APIImportArchive <$> jsonP), + "/_db delete" $> APIDeleteStorage, + "/_db encryption " *> (APIStorageEncryption <$> jsonP), + "/db encrypt " *> (APIStorageEncryption . dbEncryptionConfig "" <$> dbKeyP), + "/db key " *> (APIStorageEncryption <$> (dbEncryptionConfig <$> dbKeyP <* A.space <*> dbKeyP)), + "/db decrypt " *> (APIStorageEncryption . (`dbEncryptionConfig` "") <$> dbKeyP), + "/db test key " *> (TestStorageEncryption <$> dbKeyP), + "/_save app settings" *> (APISaveAppSettings <$> jsonP), + "/_get app settings" *> (APIGetAppSettings <$> optional (A.space *> jsonP)), + "/sql chat " *> (ExecChatStoreSQL <$> textP), + "/sql agent " *> (ExecAgentStoreSQL <$> textP), + "/sql slow" $> SlowSQLQueries, + "/_get tags " *> (APIGetChatTags <$> A.decimal), + "/_get chats " + *> ( APIGetChats + <$> A.decimal + <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False) + <*> (A.space *> paginationByTimeP <|> pure (PTLast 5000)) + <*> (A.space *> jsonP <|> pure clqNoFilters) + ), + "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)), + "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)), + "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal), + "/_send " *> (APISendMessages <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), + "/_create tag " *> (APICreateChatTag <$> jsonP), + "/_tags " *> (APISetChatTags <$> chatRefP <*> optional _strP), + "/_delete tag " *> (APIDeleteChatTag <$> A.decimal), + "/_update tag " *> (APIUpdateChatTag <$> A.decimal <* A.space <*> jsonP), + "/_reorder tags " *> (APIReorderChatTags <$> strP), + "/_create *" *> (APICreateChatItems <$> A.decimal <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)), + "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), + "/_delete item " *> (APIDeleteChatItem <$> chatRefP <*> _strP <* A.space <*> ciDeleteMode), + "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <*> _strP), + "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP), + "/_reaction members " *> (APIGetReactionMembers <$> A.decimal <* " #" <*> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP), + "/_forward plan " *> (APIPlanForwardChatItems <$> chatRefP <*> _strP), + "/_forward " *> (APIForwardChatItems <$> chatRefP <* A.space <*> chatRefP <*> _strP <*> sendMessageTTLP), + "/_read user " *> (APIUserRead <$> A.decimal), + "/read user" $> UserRead, + "/_read chat " *> (APIChatRead <$> chatRefP), + "/_read chat items " *> (APIChatItemsRead <$> chatRefP <*> _strP), + "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), + "/_delete " *> (APIDeleteChat <$> chatRefP <*> chatDeleteMode), + "/_clear chat " *> (APIClearChat <$> chatRefP), + "/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal), + "/_reject " *> (APIRejectContact <$> A.decimal), + "/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP), + "/call " *> char_ '@' *> (SendCallInvitation <$> displayName <*> pure defaultCallType), + "/_call reject @" *> (APIRejectCall <$> A.decimal), + "/_call offer @" *> (APISendCallOffer <$> A.decimal <* A.space <*> jsonP), + "/_call answer @" *> (APISendCallAnswer <$> A.decimal <* A.space <*> jsonP), + "/_call extra @" *> (APISendCallExtraInfo <$> A.decimal <* A.space <*> jsonP), + "/_call end @" *> (APIEndCall <$> A.decimal), + "/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP), + "/_call get" $> APIGetCallInvitations, + "/_network_statuses" $> APIGetNetworkStatuses, + "/_profile " *> (APIUpdateProfile <$> A.decimal <* A.space <*> jsonP), + "/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")), + "/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")), + "/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP), + "/_set theme user " *> (APISetUserUIThemes <$> A.decimal <*> optional (A.space *> jsonP)), + "/_set theme " *> (APISetChatUIThemes <$> chatRefP <*> optional (A.space *> jsonP)), + "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString), + "/_ntf get" $> APIGetNtfToken, + "/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP), + "/_ntf verify " *> (APIVerifyToken <$> strP <* A.space <*> strP <* A.space <*> strP), + "/_ntf delete " *> (APIDeleteToken <$> strP), + "/_ntf conns " *> (APIGetNtfConns <$> strP <* A.space <*> strP), + "/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP), + "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), + "/_join #" *> (APIJoinGroup <$> A.decimal), + "/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole), + "/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP), + "/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal), + "/_leave #" *> (APILeaveGroup <$> A.decimal), + "/_members #" *> (APIListMembers <$> A.decimal), + "/_server test " *> (APITestProtoServer <$> A.decimal <* A.space <*> strP), + "/smp test " *> (TestProtoServer . AProtoServerWithAuth SPSMP <$> strP), + "/xftp test " *> (TestProtoServer . AProtoServerWithAuth SPXFTP <$> strP), + "/ntf test " *> (TestProtoServer . AProtoServerWithAuth SPNTF <$> strP), + "/smp " *> (SetUserProtoServers (AProtocolType SPSMP) . map (AProtoServerWithAuth SPSMP) <$> protocolServersP), + "/xftp " *> (SetUserProtoServers (AProtocolType SPXFTP) . map (AProtoServerWithAuth SPXFTP) <$> protocolServersP), + "/smp" $> GetUserProtoServers (AProtocolType SPSMP), + "/xftp" $> GetUserProtoServers (AProtocolType SPXFTP), + "/_operators" $> APIGetServerOperators, + "/_operators " *> (APISetServerOperators <$> jsonP), + "/operators " *> (SetServerOperators . L.fromList <$> operatorRolesP `A.sepBy1` A.char ','), + "/_servers " *> (APIGetUserServers <$> A.decimal), + "/_servers " *> (APISetUserServers <$> A.decimal <* A.space <*> jsonP), + "/_validate_servers " *> (APIValidateServers <$> A.decimal <* A.space <*> jsonP), + "/_conditions" $> APIGetUsageConditions, + "/_conditions_notified " *> (APISetConditionsNotified <$> A.decimal), + "/_accept_conditions " *> (APIAcceptConditions <$> A.decimal <*> _strP), + "/_ttl " *> (APISetChatItemTTL <$> A.decimal <* A.space <*> ciTTLDecimal), + "/ttl " *> (SetChatItemTTL <$> ciTTL), + "/_ttl " *> (APIGetChatItemTTL <$> A.decimal), + "/ttl" $> GetChatItemTTL, + "/_network info " *> (APISetNetworkInfo <$> jsonP), + "/_network " *> (APISetNetworkConfig <$> jsonP), + ("/network " <|> "/net ") *> (SetNetworkConfig <$> netCfgP), + ("/network" <|> "/net") $> APIGetNetworkConfig, + "/reconnect " *> (ReconnectServer <$> A.decimal <* A.space <*> strP), + "/reconnect" $> ReconnectAllServers, + "/_settings " *> (APISetChatSettings <$> chatRefP <* A.space <*> jsonP), + "/_member settings #" *> (APISetMemberSettings <$> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP), + "/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal), + "/_info #" *> (APIGroupInfo <$> A.decimal), + "/_info @" *> (APIContactInfo <$> A.decimal), + ("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* char_ '@' <*> displayName), + ("/info #" <|> "/i #") *> (ShowGroupInfo <$> displayName), + ("/info " <|> "/i ") *> char_ '@' *> (ContactInfo <$> displayName), + "/_queue info #" *> (APIGroupMemberQueueInfo <$> A.decimal <* A.space <*> A.decimal), + "/_queue info @" *> (APIContactQueueInfo <$> A.decimal), + ("/queue info #" <|> "/qi #") *> (GroupMemberQueueInfo <$> displayName <* A.space <* char_ '@' <*> displayName), + ("/queue info " <|> "/qi ") *> char_ '@' *> (ContactQueueInfo <$> displayName), + "/_switch #" *> (APISwitchGroupMember <$> A.decimal <* A.space <*> A.decimal), + "/_switch @" *> (APISwitchContact <$> A.decimal), + "/_abort switch #" *> (APIAbortSwitchGroupMember <$> A.decimal <* A.space <*> A.decimal), + "/_abort switch @" *> (APIAbortSwitchContact <$> A.decimal), + "/_sync #" *> (APISyncGroupMemberRatchet <$> A.decimal <* A.space <*> A.decimal <*> (" force=on" $> True <|> pure False)), + "/_sync @" *> (APISyncContactRatchet <$> A.decimal <*> (" force=on" $> True <|> pure False)), + "/switch #" *> (SwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName), + "/switch " *> char_ '@' *> (SwitchContact <$> displayName), + "/abort switch #" *> (AbortSwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName), + "/abort switch " *> char_ '@' *> (AbortSwitchContact <$> displayName), + "/sync #" *> (SyncGroupMemberRatchet <$> displayName <* A.space <* char_ '@' <*> displayName <*> (" force=on" $> True <|> pure False)), + "/sync " *> char_ '@' *> (SyncContactRatchet <$> displayName <*> (" force=on" $> True <|> pure False)), + "/_get code @" *> (APIGetContactCode <$> A.decimal), + "/_get code #" *> (APIGetGroupMemberCode <$> A.decimal <* A.space <*> A.decimal), + "/_verify code @" *> (APIVerifyContact <$> A.decimal <*> optional (A.space *> verifyCodeP)), + "/_verify code #" *> (APIVerifyGroupMember <$> A.decimal <* A.space <*> A.decimal <*> optional (A.space *> verifyCodeP)), + "/_enable @" *> (APIEnableContact <$> A.decimal), + "/_enable #" *> (APIEnableGroupMember <$> A.decimal <* A.space <*> A.decimal), + "/code " *> char_ '@' *> (GetContactCode <$> displayName), + "/code #" *> (GetGroupMemberCode <$> displayName <* A.space <* char_ '@' <*> displayName), + "/verify " *> char_ '@' *> (VerifyContact <$> displayName <*> optional (A.space *> verifyCodeP)), + "/verify #" *> (VerifyGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> optional (A.space *> verifyCodeP)), + "/enable " *> char_ '@' *> (EnableContact <$> displayName), + "/enable #" *> (EnableGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName), + ("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles, + ("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups, + ("/help contacts" <|> "/help contact" <|> "/hc") $> ChatHelp HSContacts, + ("/help address" <|> "/ha") $> ChatHelp HSMyAddress, + ("/help incognito" <|> "/hi") $> ChatHelp HSIncognito, + ("/help messages" <|> "/hm") $> ChatHelp HSMessages, + ("/help remote" <|> "/hr") $> ChatHelp HSRemote, + ("/help settings" <|> "/hs") $> ChatHelp HSSettings, + ("/help db" <|> "/hd") $> ChatHelp HSDatabase, + ("/help" <|> "/h") $> ChatHelp HSMain, + ("/group" <|> "/g") *> (NewGroup <$> incognitoP <* A.space <* char_ '#' <*> groupProfile), + "/_group " *> (APINewGroup <$> A.decimal <*> incognitoOnOffP <* A.space <*> jsonP), + ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> (memberRole <|> pure GRMember)), + ("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName), + ("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole), + "/block for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True), + "/unblock for all #" *> (BlockForAll <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False), + ("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayName <* A.space <* char_ '@' <*> displayName), + ("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayName), + ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName), + ("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayName <*> chatDeleteMode), + "/clear *" $> ClearNoteFolder, + "/clear #" *> (ClearGroup <$> displayName), + "/clear " *> char_ '@' *> (ClearContact <$> displayName), + ("/members " <|> "/ms ") *> char_ '#' *> (ListMembers <$> displayName), + "/_groups" *> (APIListGroups <$> A.decimal <*> optional (" @" *> A.decimal) <*> optional (A.space *> stringP)), + ("/groups" <|> "/gs") *> (ListGroups <$> optional (" @" *> displayName) <*> optional (A.space *> stringP)), + "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP), + ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayName <* A.space <*> groupProfile), + ("/group_profile " <|> "/gp ") *> char_ '#' *> (ShowGroupProfile <$> displayName), + "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> optional (A.space *> msgTextP)), + "/set welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayName <* A.space <*> (Just <$> msgTextP)), + "/delete welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> pure Nothing), + "/show welcome " *> char_ '#' *> (ShowGroupDescription <$> displayName), + "/_create link #" *> (APICreateGroupLink <$> A.decimal <*> (memberRole <|> pure GRMember)), + "/_set link role #" *> (APIGroupLinkMemberRole <$> A.decimal <*> memberRole), + "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal), + "/_get link #" *> (APIGetGroupLink <$> A.decimal), + "/create link #" *> (CreateGroupLink <$> displayName <*> (memberRole <|> pure GRMember)), + "/set link role #" *> (GroupLinkMemberRole <$> displayName <*> memberRole), + "/delete link #" *> (DeleteGroupLink <$> displayName), + "/show link #" *> (ShowGroupLink <$> displayName), + "/_create member contact #" *> (APICreateMemberContact <$> A.decimal <* A.space <*> A.decimal), + "/_invite member contact @" *> (APISendMemberContactInvitation <$> A.decimal <*> optional (A.space *> msgContentP)), + (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP), + (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP), + "/_contacts " *> (APIListContacts <$> A.decimal), + "/contacts" $> ListContacts, + "/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP), + "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), + "/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP), + "/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP), + "/_set conn user :" *> (APIChangeConnectionUser <$> A.decimal <* A.space <*> A.decimal), + ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeTill isSpace $> Nothing)), + ("/connect" <|> "/c") *> (AddContact <$> incognitoP), + ForwardMessage <$> chatNameP <* " <- @" <*> displayName <* A.space <*> msgTextP, + ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayName <* A.space <* A.char '@' <*> (Just <$> displayName) <* A.space <*> msgTextP, + ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayName <*> pure Nothing <* A.space <*> msgTextP, + ForwardLocalMessage <$> chatNameP <* " <- * " <*> msgTextP, + SendMessage <$> chatNameP <* A.space <*> msgTextP, + "/* " *> (SendMessage (ChatName CTLocal "") <$> msgTextP), + "@#" *> (SendMemberContactMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> msgTextP), + "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), + (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), + (">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd), + ("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> textP), + ("\\\\ #" <|> "\\\\#") *> (DeleteMemberMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> textP), + ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> msgTextP), + ReactToMessage <$> (("+" $> True) <|> ("-" $> False)) <*> reactionP <* A.space <*> chatNameP' <* A.space <*> textP, + "/feed " *> (SendMessageBroadcast <$> msgTextP), + ("/chats" <|> "/cs") *> (LastChats <$> (" all" $> Nothing <|> Just <$> (A.space *> A.decimal <|> pure 20))), + ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing), + ("/search" <|> "/?") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> (Just <$> (A.space *> stringP))), + "/last_item_id" *> (LastChatItemId <$> optional (A.space *> chatNameP) <*> (A.space *> A.decimal <|> pure 0)), + "/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)), + "/show " *> (ShowChatItem . Just <$> A.decimal), + "/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP), + ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> cryptoFileP), + ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> cryptoFileP), + ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal), + ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal), + ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath), + ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> (" approved_relays=" *> onOffP <|> pure False) <*> optional (" encrypt=" *> onOffP) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)), + "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> (" approved_relays=" *> onOffP <|> pure False) <*> optional (" encrypt=" *> onOffP)), + ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal), + ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal), + "/_connect contact " *> (APIConnectContactViaAddress <$> A.decimal <*> incognitoOnOffP <* A.space <*> A.decimal), + "/simplex" *> (ConnectSimplex <$> incognitoP), + "/_address " *> (APICreateMyAddress <$> A.decimal), + ("/address" <|> "/ad") $> CreateMyAddress, + "/_delete_address " *> (APIDeleteMyAddress <$> A.decimal), + ("/delete_address" <|> "/da") $> DeleteMyAddress, + "/_show_address " *> (APIShowMyAddress <$> A.decimal), + ("/show_address" <|> "/sa") $> ShowMyAddress, + "/_profile_address " *> (APISetProfileAddress <$> A.decimal <* A.space <*> onOffP), + ("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP), + "/_auto_accept " *> (APIAddressAutoAccept <$> A.decimal <* A.space <*> autoAcceptP), + "/auto_accept " *> (AddressAutoAccept <$> autoAcceptP), + ("/accept" <|> "/ac") *> (AcceptContact <$> incognitoP <* A.space <* char_ '@' <*> displayName), + ("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName), + ("/markdown" <|> "/m") $> ChatHelp HSMarkdown, + ("/welcome" <|> "/w") $> Welcome, + "/set profile image " *> (UpdateProfileImage . Just . ImageData <$> imageP), + "/delete profile image" $> UpdateProfileImage Nothing, + "/show profile image" $> ShowProfileImage, + ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> profileNames), + ("/profile" <|> "/p") $> ShowProfile, + "/set voice #" *> (SetGroupFeatureRole (AGFR SGFVoice) <$> displayName <*> _strP <*> optional memberRole), + "/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)), + "/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP), + "/set files #" *> (SetGroupFeatureRole (AGFR SGFFiles) <$> displayName <*> _strP <*> optional memberRole), + "/set history #" *> (SetGroupFeature (AGFNR SGFHistory) <$> displayName <*> (A.space *> strP)), + "/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayName <*> (A.space *> strP)), + "/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)), + "/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP), + "/set delete #" *> (SetGroupFeature (AGFNR SGFFullDelete) <$> displayName <*> (A.space *> strP)), + "/set delete @" *> (SetContactFeature (ACF SCFFullDelete) <$> displayName <*> optional (A.space *> strP)), + "/set delete " *> (SetUserFeature (ACF SCFFullDelete) <$> strP), + "/set direct #" *> (SetGroupFeatureRole (AGFR SGFDirectMessages) <$> displayName <*> _strP <*> optional memberRole), + "/set disappear #" *> (SetGroupTimedMessages <$> displayName <*> (A.space *> timedTTLOnOffP)), + "/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)), + "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))), + "/set links #" *> (SetGroupFeatureRole (AGFR SGFSimplexLinks) <$> displayName <*> _strP <*> optional memberRole), + ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito, + "/set device name " *> (SetLocalDeviceName <$> textP), + "/list remote hosts" $> ListRemoteHosts, + "/switch remote host " *> (SwitchRemoteHost <$> ("local" $> Nothing <|> (Just <$> A.decimal))), + "/start remote host " *> (StartRemoteHost <$> ("new" $> Nothing <|> (Just <$> ((,) <$> A.decimal <*> (" multicast=" *> onOffP <|> pure False)))) <*> optional (A.space *> rcCtrlAddressP) <*> optional (" port=" *> A.decimal)), + "/stop remote host " *> (StopRemoteHost <$> ("new" $> RHNew <|> RHId <$> A.decimal)), + "/delete remote host " *> (DeleteRemoteHost <$> A.decimal), + "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath), + "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP), + ("/connect remote ctrl " <|> "/crc ") *> (ConnectRemoteCtrl <$> strP), + "/find remote ctrl" $> FindKnownRemoteCtrl, + "/confirm remote ctrl " *> (ConfirmRemoteCtrl <$> A.decimal), + "/verify remote ctrl " *> (VerifyRemoteCtrlSession <$> textP), + "/list remote ctrls" $> ListRemoteCtrls, + "/stop remote ctrl" $> StopRemoteCtrl, + "/delete remote ctrl " *> (DeleteRemoteCtrl <$> A.decimal), + "/_upload " *> (APIUploadStandaloneFile <$> A.decimal <* A.space <*> cryptoFileP), + "/_download info " *> (APIStandaloneFileInfo <$> strP), + "/_download " *> (APIDownloadStandaloneFile <$> A.decimal <* A.space <*> strP_ <*> cryptoFileP), + ("/quit" <|> "/q" <|> "/exit") $> QuitChat, + ("/version" <|> "/v") $> ShowVersion, + "/debug locks" $> DebugLocks, + "/debug event " *> (DebugEvent <$> jsonP), + "/get subs total " *> (GetAgentSubsTotal <$> A.decimal), + "/get servers summary " *> (GetAgentServersSummary <$> A.decimal), + "/reset servers stats" $> ResetAgentServersStats, + "/get subs" $> GetAgentSubs, + "/get subs details" $> GetAgentSubsDetails, + "/get workers" $> GetAgentWorkers, + "/get workers details" $> GetAgentWorkersDetails, + "/get queues" $> GetAgentQueuesInfo, + "//" *> (CustomChatCommand <$> A.takeByteString) + ] + where + choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput) + incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False + incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False + imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,") + imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P)) + chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char '*' $> CTLocal <|> A.char ':' $> CTContactConnection + chatPaginationP = + (CPLast <$ "count=" <*> A.decimal) + <|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) + <|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) + <|> (CPAround <$ "around=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) + <|> (CPInitial <$ "initial=" <*> A.decimal) + paginationByTimeP = + (PTLast <$ "count=" <*> A.decimal) + <|> (PTAfter <$ "after=" <*> strP <* A.space <* "count=" <*> A.decimal) + <|> (PTBefore <$ "before=" <*> strP <* A.space <* "count=" <*> A.decimal) + mcTextP = MCText . safeDecodeUtf8 <$> A.takeByteString + msgContentP = "text " *> mcTextP <|> "json " *> jsonP + ciDeleteMode = "broadcast" $> CIDMBroadcast <|> "internal" $> CIDMInternal + chatDeleteMode = + A.choice + [ " full" *> (CDMFull <$> notifyP), + " entity" *> (CDMEntity <$> notifyP), + " messages" $> CDMMessages, + CDMFull <$> notifyP -- backwards compatible + ] + where + notifyP = " notify=" *> onOffP <|> pure True + displayName = safeDecodeUtf8 <$> (quoted "'" <|> takeNameTill isSpace) + where + takeNameTill p = + A.peekChar' >>= \c -> + if refChar c then A.takeTill p else fail "invalid first character in display name" + quoted cs = A.choice [A.char c *> takeNameTill (== c) <* A.char c | c <- cs] + refChar c = c > ' ' && c /= '#' && c /= '@' + sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> msgTextP + quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space + reactionP = MREmoji <$> (mrEmojiChar <$?> (toEmoji <$> A.anyChar)) + toEmoji = \case + '1' -> '👍' + '+' -> '👍' + '-' -> '👎' + ')' -> '😀' + ',' -> '😢' + '*' -> head "❤️" + '^' -> '🚀' + c -> c + composedMessagesTextP = do + text <- mcTextP + pure $ (ComposedMessage Nothing Nothing text) :| [] + 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 + (cName, fullName) <- profileNames + let profile = Just Profile {displayName = cName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing} + pure NewUser {profile, pastTimestamp = False} + jsonP :: J.FromJSON a => Parser a + jsonP = J.eitherDecodeStrict' <$?> A.takeByteString + groupProfile = do + (gName, fullName) <- profileNames + let groupPreferences = + Just + (emptyGroupPrefs :: GroupPreferences) + { directMessages = Just DirectMessagesGroupPreference {enable = FEOn, role = Nothing}, + history = Just HistoryGroupPreference {enable = FEOn} + } + pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences} + fullNameP = A.space *> textP <|> pure "" + textP = safeDecodeUtf8 <$> A.takeByteString + pwdP = jsonP <|> (UserPwd . safeDecodeUtf8 <$> A.takeTill (== ' ')) + verifyCodeP = safeDecodeUtf8 <$> A.takeWhile (\c -> isDigit c || c == ' ') + msgTextP = jsonP <|> textP + stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString + filePath = stringP + cryptoFileP = do + cfArgs <- optional $ CFArgs <$> (" key=" *> strP <* A.space) <*> (" nonce=" *> strP) + path <- filePath + pure $ CryptoFile path cfArgs + memberRole = + A.choice + [ " owner" $> GROwner, + " admin" $> GRAdmin, + " member" $> GRMember, + " observer" $> GRObserver + ] + chatNameP = + chatTypeP >>= \case + CTLocal -> pure $ ChatName CTLocal "" + ct -> ChatName ct <$> displayName + chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName + chatRefP = ChatRef <$> chatTypeP <*> A.decimal + msgCountP = A.space *> A.decimal <|> pure 10 + ciTTLDecimal = ("none" $> Nothing) <|> (Just <$> A.decimal) + ciTTL = + ("day" $> Just 86400) + <|> ("week" $> Just (7 * 86400)) + <|> ("month" $> Just (30 * 86400)) + <|> ("none" $> Nothing) + timedTTLP = + ("30s" $> 30) + <|> ("5min" $> 300) + <|> ("1h" $> 3600) + <|> ("8h" $> (8 * 3600)) + <|> ("day" $> 86400) + <|> ("week" $> (7 * 86400)) + <|> ("month" $> (30 * 86400)) + <|> A.decimal + timedTTLOnOffP = + optional ("on" *> A.space) *> (Just <$> timedTTLP) + <|> ("off" $> Nothing) + timedMessagesEnabledP = + optional ("yes" *> A.space) *> (TMEEnableSetTTL <$> timedTTLP) + <|> ("yes" $> TMEEnableKeepTTL) + <|> ("no" $> TMEDisableKeepTTL) + operatorRolesP = do + operatorId' <- A.decimal + enabled' <- A.char ':' *> onOffP + smpRoles' <- (":smp=" *> srvRolesP) <|> pure allRoles + xftpRoles' <- (":xftp=" *> srvRolesP) <|> pure allRoles + pure ServerOperatorRoles {operatorId', enabled', smpRoles', xftpRoles'} + srvRolesP = srvRoles <$?> A.takeTill (\c -> c == ':' || c == ',') + where + srvRoles = \case + "off" -> Right $ ServerRoles False False + "proxy" -> Right ServerRoles {storage = False, proxy = True} + "storage" -> Right ServerRoles {storage = True, proxy = False} + "on" -> Right allRoles + _ -> Left "bad ServerRoles" + netCfgP = do + socksProxy <- "socks=" *> ("off" $> Nothing <|> "on" $> Just defaultSocksProxyWithAuth <|> Just <$> strP) + socksMode <- " socks-mode=" *> strP <|> pure SMAlways + hostMode <- " host-mode=" *> (textToHostMode . safeDecodeUtf8 <$?> A.takeTill (== ' ')) <|> pure (defaultHostMode socksProxy) + requiredHostMode <- (" required-host-mode" $> True) <|> pure False + smpProxyMode_ <- optional $ " smp-proxy=" *> strP + smpProxyFallback_ <- optional $ " smp-proxy-fallback=" *> strP + smpWebPort <- (" smp-web-port" $> True) <|> pure False + t_ <- optional $ " timeout=" *> A.decimal + logTLSErrors <- " log=" *> onOffP <|> pure False + let tcpTimeout_ = (1000000 *) <$> t_ + pure $ SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} + dbKeyP = nonEmptyKey <$?> strP + nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k + dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False} + autoAcceptP = ifM onOffP (Just <$> (businessAA <|> addressAA)) (pure Nothing) + where + addressAA = AutoAccept False <$> (" incognito=" *> onOffP <|> pure False) <*> autoReply + businessAA = AutoAccept True <$> (" business" *> pure False) <*> autoReply + autoReply = optional (A.space *> msgContentP) + rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (jsonP <|> text1P)) + text1P = safeDecodeUtf8 <$> A.takeTill (== ' ') + char_ = optional . A.char + +mkValidName :: String -> String +mkValidName = reverse . dropWhile isSpace . fst3 . foldl' addChar ("", '\NUL', 0 :: Int) + where + fst3 (x, _, _) = x + addChar (r, prev, punct) c = if validChar then (c' : r, c', punct') else (r, prev, punct) + where + c' = if isSpace c then ' ' else c + punct' + | isPunctuation c = punct + 1 + | isSpace c = punct + | otherwise = 0 + validChar + | c == '\'' = False + | prev == '\NUL' = c > ' ' && c /= '#' && c /= '@' && validFirstChar + | isSpace prev = validFirstChar || (punct == 0 && isPunctuation c) + | isPunctuation prev = validFirstChar || isSpace c || (punct < 3 && isPunctuation c) + | otherwise = validFirstChar || isSpace c || isMark c || isPunctuation c + validFirstChar = isLetter c || isNumber c || isSymbol c diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs new file mode 100644 index 0000000000..cfb15daca4 --- /dev/null +++ b/src/Simplex/Chat/Library/Internal.hs @@ -0,0 +1,1919 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + +module Simplex.Chat.Library.Internal where + +import Control.Applicative ((<|>)) +import Control.Concurrent.STM (retry) +import Control.Logger.Simple +import Control.Monad +import Control.Monad.Except +import Control.Monad.IO.Unlift +import Control.Monad.Reader +import Crypto.Random (ChaChaDRG) +import Data.Bifunctor (first) +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.Either (partitionEithers, rights) +import Data.Fixed (div') +import Data.Foldable (foldr') +import Data.Functor (($>)) +import Data.Functor.Identity +import Data.Int (Int64) +import Data.List (find, mapAccumL, partition) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as L +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Time (addUTCTime) +import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds) +import Simplex.Chat.Call +import Simplex.Chat.Controller +import Simplex.Chat.Files +import Simplex.Chat.Markdown +import Simplex.Chat.Messages +import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages) +import Simplex.Chat.Messages.CIContent +import Simplex.Chat.Messages.CIContent.Events +import Simplex.Chat.Operators +import Simplex.Chat.ProfileGenerator (generateRandomProfile) +import Simplex.Chat.Protocol +import Simplex.Chat.Store +import Simplex.Chat.Store.Direct +import Simplex.Chat.Store.Files +import Simplex.Chat.Store.Groups +import Simplex.Chat.Store.Messages +import Simplex.Chat.Store.Profiles +import Simplex.Chat.Store.Shared +import Simplex.Chat.Types +import Simplex.Chat.Types.Preferences +import Simplex.Chat.Types.Shared +import Simplex.Chat.Util (encryptFile, shuffle) +import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription) +import qualified Simplex.FileTransfer.Description as FD +import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI) +import Simplex.FileTransfer.Types (RcvFileId, SndFileId) +import Simplex.Messaging.Agent as Agent +import Simplex.Messaging.Agent.Client (getFastNetworkConfig, ipAddressProtected, withLockMap) +import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..)) +import Simplex.Messaging.Agent.Lock (withLock) +import Simplex.Messaging.Agent.Protocol +import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..)) +import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import Simplex.Messaging.Client (NetworkConfig (..)) +import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) +import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) +import qualified Simplex.Messaging.Crypto.Ratchet as CR +import Simplex.Messaging.Encoding +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Protocol (MsgBody, MsgFlags (..), ProtoServerWithAuth (..), ProtocolServer, ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer) +import qualified Simplex.Messaging.Protocol as SMP +import qualified Simplex.Messaging.TMap as TM +import Simplex.Messaging.Util +import Simplex.Messaging.Version +import System.FilePath (takeFileName, ()) +import System.IO (Handle, IOMode (..), SeekMode (..), hFlush) +import UnliftIO.Concurrent (forkFinally, mkWeakThreadId) +import UnliftIO.Directory +import UnliftIO.IO (hClose, hSeek, hTell, openFile) +import UnliftIO.STM + +maxMsgReactions :: Int +maxMsgReactions = 3 + +withChatLock :: String -> CM a -> CM a +withChatLock name action = asks chatLock >>= \l -> withLock l name action + +withEntityLock :: String -> ChatLockEntity -> CM a -> CM a +withEntityLock name entity action = do + chatLock <- asks chatLock + ls <- asks entityLocks + atomically $ unlessM (isEmptyTMVar chatLock) retry + withLockMap ls entity name action + +withInvitationLock :: String -> ByteString -> CM a -> CM a +withInvitationLock name = withEntityLock name . CLInvitation +{-# INLINE withInvitationLock #-} + +withConnectionLock :: String -> Int64 -> CM a -> CM a +withConnectionLock name = withEntityLock name . CLConnection +{-# INLINE withConnectionLock #-} + +withContactLock :: String -> ContactId -> CM a -> CM a +withContactLock name = withEntityLock name . CLContact +{-# INLINE withContactLock #-} + +withGroupLock :: String -> GroupId -> CM a -> CM a +withGroupLock name = withEntityLock name . CLGroup +{-# INLINE withGroupLock #-} + +withUserContactLock :: String -> Int64 -> CM a -> CM a +withUserContactLock name = withEntityLock name . CLUserContact +{-# INLINE withUserContactLock #-} + +withFileLock :: String -> Int64 -> CM a -> CM a +withFileLock name = withEntityLock name . CLFile +{-# INLINE withFileLock #-} + +useServerCfgs :: forall p. UserProtocol p => SProtocolType p -> RandomAgentServers -> [(Text, ServerOperator)] -> [UserServer p] -> NonEmpty (ServerCfg p) +useServerCfgs p RandomAgentServers {smpServers, xftpServers} opDomains = + fromMaybe (rndAgentServers p) . L.nonEmpty . agentServerCfgs p opDomains + where + rndAgentServers :: SProtocolType p -> NonEmpty (ServerCfg p) + rndAgentServers = \case + SPSMP -> smpServers + SPXFTP -> xftpServers + +contactCITimed :: Contact -> CM (Maybe CITimed) +contactCITimed ct = sndContactCITimed False ct Nothing + +sndContactCITimed :: Bool -> Contact -> Maybe Int -> CM (Maybe CITimed) +sndContactCITimed live = sndCITimed_ live . contactTimedTTL + +sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> CM (Maybe CITimed) +sndGroupCITimed live = sndCITimed_ live . groupTimedTTL + +sndCITimed_ :: Bool -> Maybe (Maybe Int) -> Maybe Int -> CM (Maybe CITimed) +sndCITimed_ live chatTTL itemTTL = + forM (chatTTL >>= (itemTTL <|>)) $ \ttl -> + CITimed ttl + <$> if live + then pure Nothing + else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime + +callTimed :: Contact -> ACIContent -> CM (Maybe CITimed) +callTimed ct aciContent = + case aciContentCallStatus aciContent of + Just callStatus + | callComplete callStatus -> do + contactCITimed ct + _ -> pure Nothing + where + aciContentCallStatus :: ACIContent -> Maybe CICallStatus + aciContentCallStatus (ACIContent _ (CISndCall st _)) = Just st + aciContentCallStatus (ACIContent _ (CIRcvCall st _)) = Just st + aciContentCallStatus _ = Nothing + +toggleNtf :: User -> GroupMember -> Bool -> CM () +toggleNtf user m ntfOn = + when (memberActive m) $ + forM_ (memberConnId m) $ \connId -> + withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user)) + +prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup)) +prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of + (Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) + (Just quotedItemId, Nothing) -> do + CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <- + withStore $ \db -> getGroupChatItem db user groupId quotedItemId + (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership + let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId} + qmc = quoteContent mc origQmc file + quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} + pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem) + (Just _, Just _) -> throwChatError CEInvalidQuote + where + quoteData :: ChatItem c d -> GroupMember -> CM (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember) + quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote + quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership') + quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m) + quoteData _ _ = throwChatError CEInvalidQuote + +quoteContent :: forall d. MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent +quoteContent mc qmc ciFile_ + | replaceContent = MCText qTextOrFile + | otherwise = case qmc of + MCImage _ image -> MCImage qTextOrFile image + MCFile _ -> MCFile qTextOrFile + -- consider same for voice messages + -- MCVoice _ voice -> MCVoice qTextOrFile voice + _ -> qmc + where + -- if the message we're quoting with is one of the "large" MsgContents + -- we replace the quote's content with MCText + replaceContent = case mc of + MCText _ -> False + MCFile _ -> False + MCLink {} -> True + MCImage {} -> True + MCVideo {} -> True + MCVoice {} -> False + MCUnknown {} -> True + qText = msgContentText qmc + getFileName :: CIFile d -> String + getFileName CIFile {fileName} = fileName + qFileName = maybe qText (T.pack . getFileName) ciFile_ + qTextOrFile = if T.null qText then qFileName else qText + +prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe f -> Maybe GroupFeature +prohibitedGroupContent gInfo m mc file_ + | isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) = Just GFVoice + | not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles + | prohibitedSimplexLinks gInfo m mc = Just GFSimplexLinks + | otherwise = Nothing + +prohibitedSimplexLinks :: GroupInfo -> GroupMember -> MsgContent -> Bool +prohibitedSimplexLinks gInfo m mc = + not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo) + && maybe False (any ftIsSimplexLink) (parseMaybeMarkdownList $ msgContentText mc) + where + ftIsSimplexLink :: FormattedText -> Bool + ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format + +roundedFDCount :: Int -> Int +roundedFDCount n + | n <= 0 = 4 + | otherwise = max 4 $ fromIntegral $ (2 :: Integer) ^ (ceiling (logBase 2 (fromIntegral n) :: Double) :: Integer) + +xftpSndFileTransfer_ :: User -> CryptoFile -> Integer -> Int -> Maybe ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta) +xftpSndFileTransfer_ user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup_ = do + let fileName = takeFileName filePath + fInv = xftpFileInvitation fileName fileSize dummyFileDescr + fsFilePath <- lift $ toFSFilePath filePath + let srcFile = CryptoFile fsFilePath cfArgs + aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) srcFile (roundedFDCount n) + -- TODO CRSndFileStart event for XFTP + chSize <- asks $ fileChunkSize . config + ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup_ file fInv (AgentSndFileId aFileId) Nothing chSize + let fileSource = Just $ CryptoFile filePath cfArgs + ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP} + pure (fInv, ciFile, ft) + +xftpSndFileRedirect :: User -> FileTransferId -> ValidFileDescription 'FRecipient -> CM FileTransferMeta +xftpSndFileRedirect user ftId vfd = do + let fileName = "redirect.yaml" + file = CryptoFile fileName Nothing + fInv = xftpFileInvitation fileName (fromIntegral $ B.length $ strEncode vfd) dummyFileDescr + aFileId <- withAgent $ \a -> xftpSendDescription a (aUserId user) vfd (roundedFDCount 1) + chSize <- asks $ fileChunkSize . config + withStore' $ \db -> createSndFileTransferXFTP db user Nothing file fInv (AgentSndFileId aFileId) (Just ftId) chSize + +dummyFileDescr :: FileDescr +dummyFileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} + +cancelFilesInProgress :: User -> [CIFileInfo] -> CM () +cancelFilesInProgress user filesInfo = do + let filesInfo' = filter (not . fileEnded) filesInfo + (sfs, rfs) <- lift $ splitFTTypes <$> withStoreBatch (\db -> map (getFT db) filesInfo') + forM_ rfs $ \RcvFileTransfer {fileId} -> lift (closeFileHandle fileId rcvFiles) `catchChatError` \_ -> pure () + lift . void . withStoreBatch' $ \db -> map (updateSndFileCancelled db) sfs + lift . void . withStoreBatch' $ \db -> map (updateRcvFileCancelled db) rfs + let xsfIds = mapMaybe (\(FileTransferMeta {fileId, xftpSndFile}, _) -> (,fileId) <$> xftpSndFile) sfs + xrfIds = mapMaybe (\RcvFileTransfer {fileId, xftpRcvFile} -> (,fileId) <$> xftpRcvFile) rfs + lift $ agentXFTPDeleteSndFilesRemote user xsfIds + lift $ agentXFTPDeleteRcvFiles xrfIds + let smpSFConnIds = concatMap (\(ft, sfts) -> mapMaybe (smpSndFileConnId ft) sfts) sfs + smpRFConnIds = mapMaybe smpRcvFileConnId rfs + deleteAgentConnectionsAsync user smpSFConnIds + deleteAgentConnectionsAsync user smpRFConnIds + where + fileEnded CIFileInfo {fileStatus} = case fileStatus of + Just (AFS _ status) -> ciFileEnded status + Nothing -> True + getFT :: DB.Connection -> CIFileInfo -> IO (Either ChatError FileTransfer) + getFT db CIFileInfo {fileId} = runExceptT . withExceptT ChatErrorStore $ getFileTransfer db user fileId + updateSndFileCancelled :: DB.Connection -> (FileTransferMeta, [SndFileTransfer]) -> IO () + updateSndFileCancelled db (FileTransferMeta {fileId}, sfts) = do + updateFileCancelled db user fileId CIFSSndCancelled + forM_ sfts updateSndFTCancelled + where + updateSndFTCancelled :: SndFileTransfer -> IO () + updateSndFTCancelled ft = unless (sndFTEnded ft) $ do + updateSndFileStatus db ft FSCancelled + deleteSndFileChunks db ft + updateRcvFileCancelled :: DB.Connection -> RcvFileTransfer -> IO () + updateRcvFileCancelled db ft@RcvFileTransfer {fileId} = do + updateFileCancelled db user fileId CIFSRcvCancelled + updateRcvFileStatus db fileId FSCancelled + deleteRcvFileChunks db ft + splitFTTypes :: [Either ChatError FileTransfer] -> ([(FileTransferMeta, [SndFileTransfer])], [RcvFileTransfer]) + splitFTTypes = foldr addFT ([], []) . rights + where + addFT f (sfs, rfs) = case f of + FTSnd ft@FileTransferMeta {cancelled} sfts | not cancelled -> ((ft, sfts) : sfs, rfs) + FTRcv ft@RcvFileTransfer {cancelled} | not cancelled -> (sfs, ft : rfs) + _ -> (sfs, rfs) + smpSndFileConnId :: FileTransferMeta -> SndFileTransfer -> Maybe ConnId + smpSndFileConnId FileTransferMeta {xftpSndFile} sft@SndFileTransfer {agentConnId = AgentConnId acId, fileInline} + | isNothing xftpSndFile && isNothing fileInline && not (sndFTEnded sft) = Just acId + | otherwise = Nothing + smpRcvFileConnId :: RcvFileTransfer -> Maybe ConnId + smpRcvFileConnId ft@RcvFileTransfer {xftpRcvFile, rcvFileInline} + | isNothing xftpRcvFile && isNothing rcvFileInline = liveRcvFileTransferConnId ft + | otherwise = Nothing + sndFTEnded SndFileTransfer {fileStatus} = fileStatus == FSCancelled || fileStatus == FSComplete + +deleteFilesLocally :: [CIFileInfo] -> CM () +deleteFilesLocally files = + withFilesFolder $ \filesFolder -> + liftIO . forM_ files $ \CIFileInfo {filePath} -> + mapM_ (delete . (filesFolder )) filePath + where + delete :: FilePath -> IO () + delete fPath = + removeFile fPath `catchAll` \_ -> + removePathForcibly fPath `catchAll_` pure () + -- perform an action only if filesFolder is set (i.e. on mobile devices) + withFilesFolder :: (FilePath -> CM ()) -> CM () + withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action + +deleteDirectCIs :: User -> Contact -> [CChatItem 'CTDirect] -> Bool -> Bool -> CM ChatResponse +deleteDirectCIs user ct items byUser timed = do + let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items + deleteCIFiles user ciFilesInfo + (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure $ CRChatItemsDeleted user deletions byUser timed + where + deleteItem db (CChatItem md ci) = do + deleteDirectChatItem db user ct ci + pure $ contactDeletion md ct ci Nothing + +deleteGroupCIs :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> CM ChatResponse +deleteGroupCIs user gInfo items byUser timed byGroupMember_ deletedTs = do + let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items + deleteCIFiles user ciFilesInfo + (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure $ CRChatItemsDeleted user deletions byUser timed + where + deleteItem :: DB.Connection -> CChatItem 'CTGroup -> IO ChatItemDeletion + deleteItem db (CChatItem md ci) = do + ci' <- case byGroupMember_ of + Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs + Nothing -> Nothing <$ deleteGroupChatItem db user gInfo ci + pure $ groupDeletion md gInfo ci ci' + +deleteLocalCIs :: User -> NoteFolder -> [CChatItem 'CTLocal] -> Bool -> Bool -> CM ChatResponse +deleteLocalCIs user nf items byUser timed = do + let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items + deleteFilesLocally ciFilesInfo + (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (deleteItem db) items) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure $ CRChatItemsDeleted user deletions byUser timed + where + deleteItem db (CChatItem md ci) = do + deleteLocalChatItem db user nf ci + pure $ ChatItemDeletion (nfItem md ci) Nothing + nfItem :: MsgDirectionI d => SMsgDirection d -> ChatItem 'CTLocal d -> AChatItem + nfItem md = AChatItem SCTLocal md (LocalChat nf) + +deleteCIFiles :: User -> [CIFileInfo] -> CM () +deleteCIFiles user filesInfo = do + cancelFilesInProgress user filesInfo + deleteFilesLocally filesInfo + +markDirectCIsDeleted :: User -> Contact -> [CChatItem 'CTDirect] -> Bool -> UTCTime -> CM ChatResponse +markDirectCIsDeleted user ct items byUser deletedTs = do + let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items + cancelFilesInProgress user ciFilesInfo + (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (markDeleted db) items) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure $ CRChatItemsDeleted user deletions byUser False + where + markDeleted db (CChatItem md ci) = do + ci' <- markDirectChatItemDeleted db user ct ci deletedTs + pure $ contactDeletion md ct ci (Just ci') + +markGroupCIsDeleted :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> Maybe GroupMember -> UTCTime -> CM ChatResponse +markGroupCIsDeleted user gInfo items byUser byGroupMember_ deletedTs = do + let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items + cancelFilesInProgress user ciFilesInfo + (errs, deletions) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (markDeleted db) items) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure $ CRChatItemsDeleted user deletions byUser False + where + markDeleted db (CChatItem md ci) = do + ci' <- markGroupChatItemDeleted db user gInfo ci byGroupMember_ deletedTs + pure $ groupDeletion md gInfo ci (Just ci') + +groupDeletion :: MsgDirectionI d => SMsgDirection d -> GroupInfo -> ChatItem 'CTGroup d -> Maybe (ChatItem 'CTGroup d) -> ChatItemDeletion +groupDeletion md g ci ci' = ChatItemDeletion (gItem ci) (gItem <$> ci') + where + gItem = AChatItem SCTGroup md (GroupChat g) + +contactDeletion :: MsgDirectionI d => SMsgDirection d -> Contact -> ChatItem 'CTDirect d -> Maybe (ChatItem 'CTDirect d) -> ChatItemDeletion +contactDeletion md ct ci ci' = ChatItemDeletion (ctItem ci) (ctItem <$> ci') + where + ctItem = AChatItem SCTDirect md (DirectChat ct) + +updateCallItemStatus :: User -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> CM () +updateCallItemStatus user ct@Contact {contactId} Call {chatItemId} receivedStatus msgId_ = do + aciContent_ <- callStatusItemContent user ct chatItemId receivedStatus + forM_ aciContent_ $ \aciContent -> do + timed_ <- callTimed ct aciContent + updateDirectChatItemView user ct chatItemId aciContent False False timed_ msgId_ + forM_ (timed_ >>= timedDeleteAt') $ + startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId) + +updateDirectChatItemView :: User -> Contact -> ChatItemId -> ACIContent -> Bool -> Bool -> Maybe CITimed -> Maybe MessageId -> CM () +updateDirectChatItemView user ct chatItemId (ACIContent msgDir ciContent) edited live timed_ msgId_ = do + ci' <- withStore $ \db -> updateDirectChatItem db user ct chatItemId ciContent edited live timed_ msgId_ + toView $ CRChatItemUpdated user (AChatItem SCTDirect msgDir (DirectChat ct) ci') + +callStatusItemContent :: User -> Contact -> ChatItemId -> WebRTCCallStatus -> CM (Maybe ACIContent) +callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do + CChatItem msgDir ChatItem {meta = CIMeta {updatedAt}, content} <- + withStore $ \db -> getDirectChatItem db user contactId chatItemId + ts <- liftIO getCurrentTime + let callDuration :: Int = nominalDiffTimeToSeconds (ts `diffUTCTime` updatedAt) `div'` 1 + callStatus = case content of + CISndCall st _ -> Just st + CIRcvCall st _ -> Just st + _ -> Nothing + newState_ = case (callStatus, receivedStatus) of + (Just CISCallProgress, WCSConnected) -> Nothing -- if call in-progress received connected -> no change + (Just CISCallProgress, WCSDisconnected) -> Just (CISCallEnded, callDuration) -- calculate in-progress duration + (Just CISCallProgress, WCSFailed) -> Just (CISCallEnded, callDuration) -- whether call disconnected or failed + (Just CISCallPending, WCSDisconnected) -> Just (CISCallMissed, 0) + (Just CISCallEnded, _) -> Nothing -- if call already ended or failed -> no change + (Just CISCallError, _) -> Nothing + (Just _, WCSConnecting) -> Just (CISCallNegotiated, 0) + (Just _, WCSConnected) -> Just (CISCallProgress, 0) -- if call ended that was never connected, duration = 0 + (Just _, WCSDisconnected) -> Just (CISCallEnded, 0) + (Just _, WCSFailed) -> Just (CISCallError, 0) + (Nothing, _) -> Nothing -- some other content - we should never get here, but no exception is thrown + pure $ aciContent msgDir <$> newState_ + where + aciContent :: forall d. SMsgDirection d -> (CICallStatus, Int) -> ACIContent + aciContent msgDir (callStatus', duration) = case msgDir of + SMDSnd -> ACIContent SMDSnd $ CISndCall callStatus' duration + SMDRcv -> ACIContent SMDRcv $ CIRcvCall callStatus' duration + +-- mobile clients use file paths relative to app directory (e.g. for the reason ios app directory changes on updates), +-- so we have to differentiate between the file path stored in db and communicated with frontend, and the file path +-- used during file transfer for actual operations with file system +toFSFilePath :: FilePath -> CM' FilePath +toFSFilePath f = + maybe f ( f) <$> (chatReadVar' filesFolder) + +setFileToEncrypt :: RcvFileTransfer -> CM RcvFileTransfer +setFileToEncrypt ft@RcvFileTransfer {fileId} = do + cfArgs <- atomically . CF.randomArgs =<< asks random + withStore' $ \db -> setFileCryptoArgs db fileId cfArgs + pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs} + +receiveFile' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatResponse +receiveFile' user ft userApprovedRelays rcvInline_ filePath_ = do + (CRRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchChatError` processError + where + processError = \case + -- TODO AChatItem in Cancelled events + ChatErrorAgent (SMP _ SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft + ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft + e -> throwError e + +acceptFileReceive :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM AChatItem +acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} userApprovedRelays rcvInline_ filePath_ = do + unless (fileStatus == RFSNew) $ case fileStatus of + RFSCancelled _ -> throwChatError $ CEFileCancelled fName + _ -> throwChatError $ CEFileAlreadyReceiving fName + vr <- chatVersionRange + case (xftpRcvFile, fileConnReq) of + -- direct file protocol + (Nothing, Just connReq) -> do + subMode <- chatReadVar subscriptionMode + dm <- encodeConnInfo $ XFileAcpt fName + connIds <- joinAgentConnectionAsync user True connReq dm subMode + filePath <- getRcvFilePath fileId filePath_ fName True + withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode + -- XFTP + (Just XFTPRcvFile {userApprovedRelays = approvedBeforeReady}, _) -> do + let userApproved = approvedBeforeReady || userApprovedRelays + filePath <- getRcvFilePath fileId filePath_ fName False + (ci, rfd) <- withStore $ \db -> do + -- marking file as accepted and reading description in the same transaction + -- to prevent race condition with appending description + ci <- xftpAcceptRcvFT db vr user fileId filePath userApproved + rfd <- getRcvFileDescrByRcvFileId db fileId + pure (ci, rfd) + receiveViaCompleteFD user fileId rfd userApproved cryptoArgs + pure ci + -- group & direct file protocol + _ -> do + chatRef <- withStore $ \db -> getChatRefByFileId db user fileId + case (chatRef, grpMemberId) of + (ChatRef CTDirect contactId, Nothing) -> do + ct <- withStore $ \db -> getContact db vr user contactId + acceptFile CFCreateConnFileInvDirect $ \msg -> void $ sendDirectContactMessage user ct msg + (ChatRef CTGroup groupId, Just memId) -> do + GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user groupId memId + case activeConn of + Just conn -> do + acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMemberMessage conn msg groupId + _ -> throwChatError $ CEFileInternal "member connection not active" + _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" + where + acceptFile :: CommandFunction -> (ChatMsgEvent 'Json -> CM ()) -> CM AChatItem + acceptFile cmdFunction send = do + filePath <- getRcvFilePath fileId filePath_ fName True + inline <- receiveInline + vr <- chatVersionRange + if + | inline -> do + -- accepting inline + ci <- withStore $ \db -> acceptRcvInlineFT db vr user fileId filePath + sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId + send $ XFileAcptInv sharedMsgId Nothing fName + pure ci + | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName + | otherwise -> do + -- accepting via a new connection + subMode <- chatReadVar subscriptionMode + connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode + withStore $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnNew filePath subMode + receiveInline :: CM Bool + receiveInline = do + ChatConfig {fileChunkSize, inlineFiles = InlineFilesConfig {receiveChunks, offerChunks}} <- asks config + pure $ + rcvInline_ /= Just False + && fileInline == Just IFMOffer + && ( fileSize <= fileChunkSize * receiveChunks + || (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks) + ) + +receiveViaCompleteFD :: User -> FileTransferId -> RcvFileDescr -> Bool -> Maybe CryptoFileArgs -> CM () +receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} userApprovedRelays cfArgs = + when fileDescrComplete $ do + rd <- parseFileDescription fileDescrText + if userApprovedRelays + then receive' rd True + else do + let srvs = fileServers rd + unknownSrvs <- getUnknownSrvs srvs + let approved = null unknownSrvs + ifM + ((approved ||) <$> ipProtectedForSrvs srvs) + (receive' rd approved) + (relaysNotApproved unknownSrvs) + where + receive' :: ValidFileDescription 'FRecipient -> Bool -> CM () + receive' rd approved = do + aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs approved + startReceivingFile user fileId + withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) + fileServers :: ValidFileDescription 'FRecipient -> [XFTPServer] + fileServers (FD.ValidFileDescription FD.FileDescription {chunks}) = + S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks + getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer] + getUnknownSrvs srvs = do + knownSrvs <- L.map protoServer' <$> getKnownAgentServers SPXFTP user + pure $ filter (`notElem` knownSrvs) srvs + ipProtectedForSrvs :: [XFTPServer] -> CM Bool + ipProtectedForSrvs srvs = do + netCfg <- lift getNetworkConfig + pure $ all (ipAddressProtected netCfg) srvs + relaysNotApproved :: [XFTPServer] -> CM () + relaysNotApproved unknownSrvs = do + aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation + forM_ aci_ $ \aci -> do + cleanupACIFile aci + toView $ CRChatItemUpdated user aci + throwChatError $ CEFileNotApproved fileId unknownSrvs + +cleanupACIFile :: AChatItem -> CM () +cleanupACIFile (AChatItem _ _ _ ChatItem {file = Just CIFile {fileSource = Just CryptoFile {filePath}}}) = do + fsFilePath <- lift $ toFSFilePath filePath + removeFile fsFilePath `catchChatError` \_ -> pure () +cleanupACIFile _ = pure () + +getKnownAgentServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> User -> CM (NonEmpty (ServerCfg p)) +getKnownAgentServers p user = do + as <- asks randomAgentServers + withStore $ \db -> do + opDomains <- operatorDomains . serverOperators <$> getServerOperators db + srvs <- liftIO $ getProtocolServers db p user + pure $ useServerCfgs p as opDomains srvs + +protoServer' :: ServerCfg p -> ProtocolServer p +protoServer' ServerCfg {server} = protoServer server + +getNetworkConfig :: CM' NetworkConfig +getNetworkConfig = withAgent' $ liftIO . getFastNetworkConfig + +resetRcvCIFileStatus :: User -> FileTransferId -> CIFileStatus 'MDRcv -> CM (Maybe AChatItem) +resetRcvCIFileStatus user fileId ciFileStatus = do + vr <- chatVersionRange + withStore $ \db -> do + liftIO $ do + updateCIFileStatus db user fileId ciFileStatus + updateRcvFileStatus db fileId FSNew + updateRcvFileAgentId db fileId Nothing + lookupChatItemByFileId db vr user fileId + +receiveViaURI :: User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer +receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile {cryptoArgs} = do + fileId <- withStore $ \db -> createRcvStandaloneFileTransfer db userId cf fileSize chunkSize + -- currently the only use case is user migrating via their configured servers, so we pass approvedRelays = True + aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) description cryptoArgs True + withStore $ \db -> do + liftIO $ do + updateRcvFileStatus db fileId FSConnected + updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 + updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) + getRcvFileTransfer db user fileId + where + FD.ValidFileDescription FD.FileDescription {size = FD.FileSize fileSize, chunkSize = FD.FileSize chunkSize} = description + +startReceivingFile :: User -> FileTransferId -> CM () +startReceivingFile user fileId = do + vr <- chatVersionRange + ci <- withStore $ \db -> do + liftIO $ updateRcvFileStatus db fileId FSConnected + liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 + getChatItemByFileId db vr user fileId + toView $ CRRcvFileStart user ci + +getRcvFilePath :: FileTransferId -> Maybe FilePath -> String -> Bool -> CM FilePath +getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of + Nothing -> + chatReadVar filesFolder >>= \case + Nothing -> do + defaultFolder <- lift getDefaultFilesFolder + fPath <- liftIO $ defaultFolder `uniqueCombine` fn + createEmptyFile fPath $> fPath + Just filesFolder -> do + fPath <- liftIO $ filesFolder `uniqueCombine` fn + createEmptyFile fPath + pure $ takeFileName fPath + Just fPath -> + ifM + (doesDirectoryExist fPath) + (createInPassedDirectory fPath) + $ ifM + (doesFileExist fPath) + (throwChatError $ CEFileAlreadyExists fPath) + (createEmptyFile fPath $> fPath) + where + createInPassedDirectory :: FilePath -> CM FilePath + createInPassedDirectory fPathDir = do + fPath <- liftIO $ fPathDir `uniqueCombine` fn + createEmptyFile fPath $> fPath + createEmptyFile :: FilePath -> CM () + createEmptyFile fPath = emptyFile `catchThrow` (ChatError . CEFileWrite fPath . show) + where + emptyFile :: CM () + emptyFile + | keepHandle = do + h <- getFileHandle fileId fPath rcvFiles AppendMode + liftIO $ B.hPut h "" >> hFlush h + | otherwise = liftIO $ B.writeFile fPath "" + +acceptContactRequest :: User -> UserContactRequest -> IncognitoEnabled -> CM (Contact, Connection, SndQueueSecured) +acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, contactId_, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId, pqSupport} incognito = do + subMode <- chatReadVar subscriptionMode + let pqSup = PQSupportOn + pqSup' = pqSup `CR.pqSupportAnd` pqSupport + vr <- chatVersionRange + let chatV = vr `peerConnChatVersion` cReqChatVRange + (ct, conn, incognitoProfile) <- case contactId_ of + Nothing -> do + incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing + connId <- withAgent $ \a -> prepareConnectionToAccept a True invId pqSup' + (ct, conn) <- withStore' $ \db -> createAcceptedContact db user connId chatV cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' False + pure (ct, conn, incognitoProfile) + Just contactId -> do + ct <- withFastStore $ \db -> getContact db vr user contactId + case contactConn ct of + Nothing -> throwChatError $ CECommandError "contact has no connection" + Just conn@Connection {customUserProfileId} -> do + incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId + pure (ct, conn, ExistingIncognito <$> incognitoProfile) + let profileToSend = profileToSendOnAccept user incognitoProfile False + dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend + (ct,conn,) <$> withAgent (\a -> acceptContact a (aConnId conn) True invId dm pqSup' subMode) + +acceptContactRequestAsync :: User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQSupport -> CM Contact +acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqSup = do + subMode <- chatReadVar subscriptionMode + let profileToSend = profileToSendOnAccept user incognitoProfile False + vr <- chatVersionRange + let chatV = vr `peerConnChatVersion` cReqChatVRange + (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode pqSup chatV + withStore' $ \db -> do + (ct, Connection {connId}) <- createAcceptedContact db user acId chatV cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed + deleteContactRequestRec db user cReq + setCommandConnId db user cmdId connId + pure ct + +acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember +acceptGroupJoinRequestAsync + user + gInfo@GroupInfo {groupProfile, membership, businessChat} + ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange} + gLinkMemRole + incognitoProfile = do + gVar <- asks random + (groupMemberId, memberId) <- withStore $ \db -> do + liftIO $ deleteContactRequestRec db user ucr + createAcceptedMember db gVar user gInfo ucr gLinkMemRole + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo + let Profile {displayName} = profileToSendOnAccept user incognitoProfile True + GroupMember {memberRole = userRole, memberId = userMemberId} = membership + msg = + XGrpLinkInv $ + GroupLinkInvitation + { fromMember = MemberIdRole userMemberId userRole, + fromMemberName = displayName, + invitedMember = MemberIdRole memberId gLinkMemRole, + groupProfile, + business = businessChat, + groupSize = Just currentMemCount + } + subMode <- chatReadVar subscriptionMode + vr <- chatVersionRange + let chatV = vr `peerConnChatVersion` cReqChatVRange + connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV + withStore $ \db -> do + liftIO $ createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode + getGroupMemberById db vr user groupMemberId + +acceptBusinessJoinRequestAsync :: User -> UserContactRequest -> CM GroupInfo +acceptBusinessJoinRequestAsync + user + ucr@UserContactRequest {contactRequestId, agentInvitationId = AgentInvId invId, cReqChatVRange} = do + vr <- chatVersionRange + gVar <- asks random + let userProfile@Profile {displayName, preferences} = profileToSendOnAccept user Nothing True + groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences + (gInfo, clientMember) <- withStore $ \db -> do + liftIO $ deleteContactRequest db user contactRequestId + createBusinessRequestGroup db vr gVar user ucr groupPreferences + let GroupInfo {membership} = gInfo + GroupMember {memberRole = userRole, memberId = userMemberId} = membership + GroupMember {groupMemberId, memberId} = clientMember + msg = + XGrpLinkInv $ + GroupLinkInvitation + { fromMember = MemberIdRole userMemberId userRole, + fromMemberName = displayName, + invitedMember = MemberIdRole memberId GRMember, + groupProfile = businessGroupProfile userProfile groupPreferences, + -- This refers to the "title member" that defines the group name and profile. + -- This coincides with fromMember to be current user when accepting the connecting user, + -- but it will be different when inviting somebody else. + business = Just $ BusinessChatInfo {chatType = BCBusiness, businessId = userMemberId, customerId = memberId}, + groupSize = Just 1 + } + subMode <- chatReadVar subscriptionMode + let chatV = vr `peerConnChatVersion` cReqChatVRange + connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV + withStore' $ \db -> createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode + let cd = CDGroupSnd gInfo + createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing + createGroupFeatureItems user cd CISndGroupFeature gInfo + pure gInfo + where + businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile + businessGroupProfile Profile {displayName, fullName, image} groupPreferences = + GroupProfile {displayName, fullName, description = Nothing, image, groupPreferences = Just groupPreferences} + +profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Bool -> Profile +profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing + where + getIncognitoProfile = \case + NewIncognito p -> p + ExistingIncognito lp -> fromLocalProfile lp + +deleteGroupLink' :: User -> GroupInfo -> CM () +deleteGroupLink' user gInfo = do + vr <- chatVersionRange + conn <- withStore $ \db -> getGroupLinkConnection db vr user gInfo + deleteGroupLink_ user gInfo conn + +deleteGroupLinkIfExists :: User -> GroupInfo -> CM () +deleteGroupLinkIfExists user gInfo = do + vr <- chatVersionRange + conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db vr user gInfo) + mapM_ (deleteGroupLink_ user gInfo) conn_ + +deleteGroupLink_ :: User -> GroupInfo -> Connection -> CM () +deleteGroupLink_ user gInfo conn = do + deleteAgentConnectionAsync user $ aConnId conn + withStore' $ \db -> deleteGroupLink db user gInfo + +startProximateTimedItemThread :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM () +startProximateTimedItemThread user itemRef deleteAt = do + interval <- asks (cleanupManagerInterval . config) + ts <- liftIO getCurrentTime + when (diffUTCTime deleteAt ts <= interval) $ + startTimedItemThread user itemRef deleteAt + +startTimedItemThread :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM () +startTimedItemThread user itemRef deleteAt = do + itemThreads <- asks timedItemThreads + threadTVar_ <- atomically $ do + exists <- TM.member itemRef itemThreads + if not exists + then do + threadTVar <- newTVar Nothing + TM.insert itemRef threadTVar itemThreads + pure $ Just threadTVar + else pure Nothing + forM_ threadTVar_ $ \threadTVar -> do + tId <- mkWeakThreadId =<< deleteTimedItem user itemRef deleteAt `forkFinally` const (atomically $ TM.delete itemRef itemThreads) + atomically $ writeTVar threadTVar (Just tId) + +deleteTimedItem :: User -> (ChatRef, ChatItemId) -> UTCTime -> CM () +deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do + ts <- liftIO getCurrentTime + liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts + lift waitChatStartedAndActivated + vr <- chatVersionRange + case cType of + CTDirect -> do + (ct, ci) <- withStore $ \db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId + deleteDirectCIs user ct [ci] True True >>= toView + CTGroup -> do + (gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db vr user chatId <*> getGroupChatItem db user chatId itemId + deletedTs <- liftIO getCurrentTime + deleteGroupCIs user gInfo [ci] True True Nothing deletedTs >>= toView + _ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType" + +startUpdatedTimedItemThread :: User -> ChatRef -> ChatItem c d -> ChatItem c d -> CM () +startUpdatedTimedItemThread user chatRef ci ci' = + case (chatItemTimed ci >>= timedDeleteAt', chatItemTimed ci' >>= timedDeleteAt') of + (Nothing, Just deleteAt') -> + startProximateTimedItemThread user (chatRef, chatItemId' ci') deleteAt' + _ -> pure () + +metaBrokerTs :: MsgMeta -> UTCTime +metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs + +sameMemberId :: MemberId -> GroupMember -> Bool +sameMemberId memId GroupMember {memberId} = memId == memberId + +createContactPQSndItem :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection) +createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' = + flip catchChatError (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of + (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled') + (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (E2EInfo pqSndEnabled') + _ -> pure (ct, conn) + where + createPQItem ciContent = do + let conn' = conn {pqSndEnabled = Just pqSndEnabled'} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + when (contactPQEnabled ct /= contactPQEnabled ct') $ do + createInternalChatItem user (CDDirectSnd ct') ciContent Nothing + toView $ CRContactPQEnabled user ct' pqSndEnabled' + pure (ct', conn') + +updateContactPQRcv :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection) +updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' = + flip catchChatError (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of + (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled') + (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (E2EInfo pqRcvEnabled') + _ -> pure (ct, conn) + where + updatePQ ciContent = do + withStore' $ \db -> updateConnPQRcvEnabled db connId pqRcvEnabled' + let conn' = conn {pqRcvEnabled = Just pqRcvEnabled'} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + when (contactPQEnabled ct /= contactPQEnabled ct') $ do + createInternalChatItem user (CDDirectRcv ct') ciContent Nothing + toView $ CRContactPQEnabled user ct' pqRcvEnabled' + pure (ct', conn') + +updatePeerChatVRange :: Connection -> VersionRangeChat -> CM Connection +updatePeerChatVRange conn@Connection {connId, connChatVersion = v, peerChatVRange, connType, pqSupport, pqEncryption} msgVRange = do + v' <- lift $ upgradedConnVersion v msgVRange + conn' <- + if msgVRange /= peerChatVRange || v' /= v + then do + withStore' $ \db -> setPeerChatVRange db connId v' msgVRange + pure conn {connChatVersion = v', peerChatVRange = msgVRange} + else pure conn + -- TODO v6.0 remove/review: for contacts only version upgrade should trigger enabling PQ support/encryption + if connType == ConnContact && v' >= pqEncryptionCompressionVersion && (pqSupport /= PQSupportOn || pqEncryption /= PQEncOn) + then do + withStore' $ \db -> updateConnSupportPQ db connId PQSupportOn PQEncOn + pure conn' {pqSupport = PQSupportOn, pqEncryption = PQEncOn} + else pure conn' + +updateMemberChatVRange :: GroupMember -> Connection -> VersionRangeChat -> CM (GroupMember, Connection) +updateMemberChatVRange mem@GroupMember {groupMemberId} conn@Connection {connId, connChatVersion = v, peerChatVRange} msgVRange = do + v' <- lift $ upgradedConnVersion v msgVRange + if msgVRange /= peerChatVRange || v' /= v + then do + withStore' $ \db -> do + setPeerChatVRange db connId v' msgVRange + setMemberChatVRange db groupMemberId msgVRange + let conn' = conn {connChatVersion = v', peerChatVRange = msgVRange} + pure (mem {memberChatVRange = msgVRange, activeConn = Just conn'}, conn') + else pure (mem, conn) + +upgradedConnVersion :: VersionChat -> VersionRangeChat -> CM' VersionChat +upgradedConnVersion v peerVR = do + vr <- chatVersionRange' + -- don't allow reducing agreed connection version + pure $ maybe v (\(Compatible v') -> max v v') $ vr `compatibleVersion` peerVR + +parseFileDescription :: FilePartyI p => Text -> CM (ValidFileDescription p) +parseFileDescription = + liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8) + +sendDirectFileInline :: User -> Contact -> FileTransferMeta -> SharedMsgId -> CM () +sendDirectFileInline user ct ft sharedMsgId = do + msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage user ct + withStore $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId + +sendMemberFileInline :: GroupMember -> Connection -> FileTransferMeta -> SharedMsgId -> CM () +sendMemberFileInline m@GroupMember {groupId} conn ft sharedMsgId = do + msgDeliveryId <- sendFileInline_ ft sharedMsgId $ \msg -> do + (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg groupId + pure (sndMsg, msgDeliveryId) + withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId + +sendFileInline_ :: FileTransferMeta -> SharedMsgId -> (ChatMsgEvent 'Binary -> CM (SndMessage, Int64)) -> CM Int64 +sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg = + sendChunks 1 =<< liftIO . B.readFile =<< lift (toFSFilePath filePath) + where + sendChunks chunkNo bytes = do + let (chunk, rest) = B.splitAt chSize bytes + (_, msgDeliveryId) <- sendMsg $ BFileChunk sharedMsgId $ FileChunk chunkNo chunk + if B.null rest + then pure msgDeliveryId + else sendChunks (chunkNo + 1) rest + chSize = fromIntegral chunkSize + +parseChatMessage :: Connection -> ByteString -> CM (ChatMessage 'Json) +parseChatMessage conn s = do + case parseChatMessages s of + [msg] -> liftEither . first (ChatError . errType) $ (\(ACMsg _ m) -> checkEncoding m) =<< msg + _ -> throwChatError $ CEException "parseChatMessage: single message is expected" + where + errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s) +{-# INLINE parseChatMessage #-} + +sendFileChunk :: User -> SndFileTransfer -> CM () +sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} = + unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ do + vr <- chatVersionRange + withStore' (`createSndFileChunk` ft) >>= \case + Just chunkNo -> sendFileChunkNo ft chunkNo + Nothing -> do + ci <- withStore $ \db -> do + liftIO $ updateSndFileStatus db ft FSComplete + liftIO $ deleteSndFileChunks db ft + updateDirectCIFileStatus db vr user fileId CIFSSndComplete + toView $ CRSndFileComplete user ci ft + lift $ closeFileHandle fileId sndFiles + deleteAgentConnectionAsync user acId + +sendFileChunkNo :: SndFileTransfer -> Integer -> CM () +sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do + chunkBytes <- readFileChunk ft chunkNo + (msgId, _) <- withAgent $ \a -> sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} + withStore' $ \db -> updateSndFileChunkMsg db ft chunkNo msgId + +readFileChunk :: SndFileTransfer -> Integer -> CM ByteString +readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo = do + fsFilePath <- lift $ toFSFilePath filePath + read_ fsFilePath `catchThrow` (ChatError . CEFileRead filePath . show) + where + read_ fsFilePath = do + h <- getFileHandle fileId fsFilePath sndFiles ReadMode + pos <- hTell h + let pos' = (chunkNo - 1) * chunkSize + when (pos /= pos') $ hSeek h AbsoluteSeek pos' + liftIO . B.hGet h $ fromInteger chunkSize + +parseFileChunk :: ByteString -> CM FileChunk +parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode + +appendFileChunk :: RcvFileTransfer -> Integer -> ByteString -> Bool -> CM () +appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs, fileInvitation = FileInvitation {fileName}} chunkNo chunk final = + case fileStatus of + RFSConnected RcvFileInfo {filePath} -> append_ filePath + -- sometimes update of file transfer status to FSConnected + -- doesn't complete in time before MSG with first file chunk + RFSAccepted RcvFileInfo {filePath} -> append_ filePath + RFSCancelled _ -> pure () + _ -> throwChatError $ CEFileInternal "receiving file transfer not in progress" + where + append_ :: FilePath -> CM () + append_ filePath = do + fsFilePath <- lift $ toFSFilePath filePath + h <- getFileHandle fileId fsFilePath rcvFiles AppendMode + liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (fileErr . show) + withStore' $ \db -> updatedRcvFileChunkStored db ft chunkNo + when final $ do + lift $ closeFileHandle fileId rcvFiles + forM_ cryptoArgs $ \cfArgs -> do + tmpFile <- lift getChatTempDirectory >>= liftIO . (`uniqueCombine` fileName) + tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case + Right () -> do + removeFile fsFilePath `catchChatError` \_ -> pure () + renameFile tmpFile fsFilePath + Left e -> do + toView $ CRChatError Nothing e + removeFile tmpFile `catchChatError` \_ -> pure () + withStore' (`removeFileCryptoArgs` fileId) + where + encryptErr e = fileErr $ e <> ", received file not encrypted" + fileErr = ChatError . CEFileWrite filePath + +getFileHandle :: Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> CM Handle +getFileHandle fileId filePath files ioMode = do + fs <- asks files + h_ <- M.lookup fileId <$> readTVarIO fs + maybe (newHandle fs) pure h_ + where + newHandle fs = do + h <- openFile filePath ioMode `catchThrow` (ChatError . CEFileInternal . show) + atomically . modifyTVar fs $ M.insert fileId h + pure h + +isFileActive :: Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> CM Bool +isFileActive fileId files = do + fs <- asks files + isJust . M.lookup fileId <$> readTVarIO fs + +cancelRcvFileTransfer :: User -> RcvFileTransfer -> CM (Maybe ConnId) +cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} = + cancel' `catchChatError` (\e -> toView (CRChatError (Just user) e) $> fileConnId) + where + cancel' = do + lift $ closeFileHandle fileId rcvFiles + withStore' $ \db -> do + updateFileCancelled db user fileId CIFSRcvCancelled + updateRcvFileStatus db fileId FSCancelled + deleteRcvFileChunks db ft + case xftpRcvFile of + Just XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId), agentRcvFileDeleted} -> + unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile aFileId fileId + _ -> pure () + pure fileConnId + fileConnId = if isNothing xftpRcvFile && isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing + +cancelSndFile :: User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> CM [ConnId] +cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do + withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled) + `catchChatError` (toView . CRChatError (Just user)) + case xftpSndFile of + Nothing -> + catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel) + Just xsf -> do + forM_ fts (\ft -> cancelSndFileTransfer user ft False) + lift (agentXFTPDeleteSndFileRemote user xsf fileId) `catchChatError` (toView . CRChatError (Just user)) + pure [] + +-- TODO v6.0 remove +cancelSndFileTransfer :: User -> SndFileTransfer -> Bool -> CM (Maybe ConnId) +cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel = + if fileStatus == FSCancelled || fileStatus == FSComplete + then pure Nothing + else cancel' `catchChatError` (\e -> toView (CRChatError (Just user) e) $> fileConnId) + where + cancel' = do + withStore' $ \db -> do + updateSndFileStatus db ft FSCancelled + deleteSndFileChunks db ft + when sendCancel $ case fileInline of + Just _ -> do + vr <- chatVersionRange + (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db vr user connId + void $ sendDirectMessage_ conn (BFileChunk sharedMsgId FileChunkCancel) (ConnectionId connId) + _ -> withAgent $ \a -> void . sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunkCancel + pure fileConnId + fileConnId = if isNothing fileInline then Just acId else Nothing + +closeFileHandle :: Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> CM' () +closeFileHandle fileId files = do + fs <- asks files + h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m) + liftIO $ mapM_ hClose h_ `catchAll_` pure () + +deleteMembersConnections :: User -> [GroupMember] -> CM () +deleteMembersConnections user members = deleteMembersConnections' user members False + +deleteMembersConnections' :: User -> [GroupMember] -> Bool -> CM () +deleteMembersConnections' user members waitDelivery = do + let memberConns = + filter (\Connection {connStatus} -> connStatus /= ConnDeleted) $ + mapMaybe (\GroupMember {activeConn} -> activeConn) members + deleteAgentConnectionsAsync' user (map aConnId memberConns) waitDelivery + lift . void . withStoreBatch' $ \db -> map (\conn -> updateConnectionStatus db conn ConnDeleted) memberConns + +deleteMemberConnection :: User -> GroupMember -> CM () +deleteMemberConnection user mem = deleteMemberConnection' user mem False + +deleteMemberConnection' :: User -> GroupMember -> Bool -> CM () +deleteMemberConnection' user GroupMember {activeConn} waitDelivery = do + forM_ activeConn $ \conn -> do + deleteAgentConnectionAsync' user (aConnId conn) waitDelivery + withStore' $ \db -> updateConnectionStatus db conn ConnDeleted + +deleteOrUpdateMemberRecord :: User -> GroupMember -> CM () +deleteOrUpdateMemberRecord user@User {userId} member = + withStore' $ \db -> + checkGroupMemberHasItems db user member >>= \case + Just _ -> updateGroupMemberStatus db userId member GSMemRemoved + Nothing -> deleteGroupMember db user member + +sendDirectContactMessages :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage] +sendDirectContactMessages user ct events = do + Connection {connChatVersion = v} <- liftEither $ contactSendConn_ ct + if v >= batchSend2Version + then sendDirectContactMessages' user ct events + else forM (L.toList events) $ \evt -> + (Right . fst <$> sendDirectContactMessage user ct evt) `catchChatError` \e -> pure (Left e) + +sendDirectContactMessages' :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage] +sendDirectContactMessages' user ct events = do + conn@Connection {connId} <- liftEither $ contactSendConn_ ct + let idsEvts = L.map (ConnectionId connId,) events + msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} + sndMsgs_ <- lift $ createSndMessages idsEvts + (sndMsgs', pqEnc_) <- batchSendConnMessagesB user conn msgFlags sndMsgs_ + forM_ pqEnc_ $ \pqEnc' -> void $ createContactPQSndItem user ct conn pqEnc' + pure sndMsgs' + +sendDirectContactMessage :: MsgEncodingI e => User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64) +sendDirectContactMessage user ct chatMsgEvent = do + conn@Connection {connId} <- liftEither $ contactSendConn_ ct + r <- sendDirectMessage_ conn chatMsgEvent (ConnectionId connId) + let (sndMessage, msgDeliveryId, pqEnc') = r + void $ createContactPQSndItem user ct conn pqEnc' + pure (sndMessage, msgDeliveryId) + +contactSendConn_ :: Contact -> Either ChatError Connection +contactSendConn_ ct@Contact {activeConn} = case activeConn of + Nothing -> err $ CEContactNotReady ct + Just conn + | not (connReady conn) -> err $ CEContactNotReady ct + | not (contactActive ct) -> err $ CEContactNotActive ct + | connDisabled conn -> err $ CEContactDisabled ct + | otherwise -> Right conn + where + err = Left . ChatError + +-- unlike sendGroupMemberMessage, this function will not store message as pending +-- TODO v5.8 we could remove pending messages once all clients support forwarding +sendDirectMemberMessage :: MsgEncodingI e => Connection -> ChatMsgEvent e -> GroupId -> CM (SndMessage, Int64, PQEncryption) +sendDirectMemberMessage conn chatMsgEvent groupId = sendDirectMessage_ conn chatMsgEvent (GroupId groupId) + +sendDirectMessage_ :: MsgEncodingI e => Connection -> ChatMsgEvent e -> ConnOrGroupId -> CM (SndMessage, Int64, PQEncryption) +sendDirectMessage_ conn chatMsgEvent connOrGroupId = do + when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) + msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId + -- TODO move compressed body to SndMessage and compress in createSndMessage + (msgDeliveryId, pqEnc') <- deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId + pure (msg, msgDeliveryId, pqEnc') + +createSndMessage :: MsgEncodingI e => ChatMsgEvent e -> ConnOrGroupId -> CM SndMessage +createSndMessage chatMsgEvent connOrGroupId = + liftEither . runIdentity =<< lift (createSndMessages $ Identity (connOrGroupId, chatMsgEvent)) + +createSndMessages :: forall e t. (MsgEncodingI e, Traversable t) => t (ConnOrGroupId, ChatMsgEvent e) -> CM' (t (Either ChatError SndMessage)) +createSndMessages idsEvents = do + g <- asks random + vr <- chatVersionRange' + withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents + where + createMsg :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, ChatMsgEvent e) -> IO (Either ChatError SndMessage) + createMsg db g vr (connOrGroupId, evnt) = runExceptT $ do + withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage + where + encodeMessage sharedMsgId = + encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr, msgId = Just sharedMsgId, chatMsgEvent = evnt} + +sendGroupMemberMessages :: forall e. MsgEncodingI e => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> CM () +sendGroupMemberMessages user conn events groupId = do + when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) + let idsEvts = L.map (GroupId groupId,) events + (errs, msgs) <- lift $ partitionEithers . L.toList <$> createSndMessages idsEvts + unless (null errs) $ toView $ CRChatErrors (Just user) errs + forM_ (L.nonEmpty msgs) $ \msgs' -> + batchSendConnMessages user conn MsgFlags {notification = True} msgs' + +batchSendConnMessages :: User -> Connection -> MsgFlags -> NonEmpty SndMessage -> CM ([Either ChatError SndMessage], Maybe PQEncryption) +batchSendConnMessages user conn msgFlags msgs = + batchSendConnMessagesB user conn msgFlags $ L.map Right msgs + +batchSendConnMessagesB :: User -> Connection -> MsgFlags -> NonEmpty (Either ChatError SndMessage) -> CM ([Either ChatError SndMessage], Maybe PQEncryption) +batchSendConnMessagesB _user conn msgFlags msgs_ = do + let batched_ = batchSndMessagesJSON msgs_ + case L.nonEmpty batched_ of + Just batched' -> do + let msgReqs = L.map (fmap (msgBatchReq conn msgFlags)) batched' + delivered <- deliverMessagesB msgReqs + let msgs' = concat $ L.zipWith flattenMsgs batched' delivered + pqEnc = findLastPQEnc delivered + when (length msgs' /= length msgs_) $ logError "batchSendConnMessagesB: msgs_ and msgs' length mismatch" + pure (msgs', pqEnc) + Nothing -> pure ([], Nothing) + where + flattenMsgs :: Either ChatError MsgBatch -> Either ChatError ([Int64], PQEncryption) -> [Either ChatError SndMessage] + flattenMsgs (Right (MsgBatch _ sndMsgs)) (Right _) = map Right sndMsgs + flattenMsgs (Right (MsgBatch _ sndMsgs)) (Left ce) = replicate (length sndMsgs) (Left ce) + flattenMsgs (Left ce) _ = [Left ce] -- restore original ChatError + findLastPQEnc :: NonEmpty (Either ChatError ([Int64], PQEncryption)) -> Maybe PQEncryption + findLastPQEnc = foldr' (\x acc -> case x of Right (_, pqEnc) -> Just pqEnc; Left _ -> acc) Nothing + +batchSndMessagesJSON :: NonEmpty (Either ChatError SndMessage) -> [Either ChatError MsgBatch] +batchSndMessagesJSON = batchMessages maxEncodedMsgLength . L.toList + +msgBatchReq :: Connection -> MsgFlags -> MsgBatch -> ChatMsgReq +msgBatchReq conn msgFlags (MsgBatch batchBody sndMsgs) = (conn, msgFlags, batchBody, map (\SndMessage {msgId} -> msgId) sndMsgs) + +encodeConnInfo :: MsgEncodingI e => ChatMsgEvent e -> CM ByteString +encodeConnInfo chatMsgEvent = do + vr <- chatVersionRange + encodeConnInfoPQ PQSupportOff (maxVersion vr) chatMsgEvent + +encodeConnInfoPQ :: MsgEncodingI e => PQSupport -> VersionChat -> ChatMsgEvent e -> CM ByteString +encodeConnInfoPQ pqSup v chatMsgEvent = do + vr <- chatVersionRange + let info = ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent} + case encodeChatMessage maxEncodedInfoLength info of + ECMEncoded connInfo -> case pqSup of + PQSupportOn | v >= pqEncryptionCompressionVersion && B.length connInfo > maxCompressedInfoLength -> do + let connInfo' = compressedBatchMsgBody_ connInfo + when (B.length connInfo' > maxCompressedInfoLength) $ throwChatError $ CEException "large compressed info" + pure connInfo' + _ -> pure connInfo + ECMLarge -> throwChatError $ CEException "large info" + +deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption) +deliverMessage conn cmEventTag msgBody msgId = do + let msgFlags = MsgFlags {notification = hasNotification cmEventTag} + deliverMessage' conn msgFlags msgBody msgId + +deliverMessage' :: Connection -> MsgFlags -> MsgBody -> MessageId -> CM (Int64, PQEncryption) +deliverMessage' conn msgFlags msgBody msgId = + deliverMessages ((conn, msgFlags, msgBody, [msgId]) :| []) >>= \case + r :| [] -> case r of + Right ([deliveryId], pqEnc) -> pure (deliveryId, pqEnc) + Right (deliveryIds, _) -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 delivery id, got " <> show (length deliveryIds) + Left e -> throwError e + rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs) + +-- [MessageId] - SndMessage ids inside MsgBatch, or single message id +type ChatMsgReq = (Connection, MsgFlags, MsgBody, [MessageId]) + +deliverMessages :: NonEmpty ChatMsgReq -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption))) +deliverMessages msgs = deliverMessagesB $ L.map Right msgs + +deliverMessagesB :: NonEmpty (Either ChatError ChatMsgReq) -> CM (NonEmpty (Either ChatError ([Int64], PQEncryption))) +deliverMessagesB msgReqs = do + msgReqs' <- liftIO compressBodies + sent <- L.zipWith prepareBatch msgReqs' <$> withAgent (`sendMessagesB` snd (mapAccumL toAgent Nothing msgReqs')) + lift . void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent) + lift . withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent + where + compressBodies = + forME msgReqs $ \mr@(conn@Connection {pqSupport, connChatVersion = v}, msgFlags, msgBody, msgIds) -> + runExceptT $ case pqSupport of + -- we only compress messages when: + -- 1) PQ support is enabled + -- 2) version is compatible with compression + -- 3) message is longer than max compressed size (as this function is not used for batched messages anyway) + PQSupportOn | v >= pqEncryptionCompressionVersion && B.length msgBody > maxCompressedMsgLength -> do + let msgBody' = compressedBatchMsgBody_ msgBody + when (B.length msgBody' > maxCompressedMsgLength) $ throwError $ ChatError $ CEException "large compressed message" + pure (conn, msgFlags, msgBody', msgIds) + _ -> pure mr + toAgent prev = \case + Right (conn@Connection {connId, pqEncryption}, msgFlags, msgBody, _msgIds) -> + let cId = case prev of + Just prevId | prevId == connId -> "" + _ -> aConnId conn + in (Just connId, Right (cId, pqEncryption, msgFlags, msgBody)) + Left _ce -> (prev, Left (AP.INTERNAL "ChatError, skip")) -- as long as it is Left, the agent batchers should just step over it + prepareBatch (Right req) (Right ar) = Right (req, ar) + prepareBatch (Left ce) _ = Left ce -- restore original ChatError + prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae Nothing + createDelivery :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO (Either ChatError ([Int64], PQEncryption)) + createDelivery db ((Connection {connId}, _, _, msgIds), (agentMsgId, pqEnc')) = do + Right . (,pqEnc') <$> mapM (createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId})) msgIds + updatePQSndEnabled :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO () + updatePQSndEnabled db ((Connection {connId, pqSndEnabled}, _, _, _), (_, pqSndEnabled')) = + case (pqSndEnabled, pqSndEnabled') of + (Just b, b') | b' /= b -> updatePQ + (Nothing, PQEncOn) -> updatePQ + _ -> pure () + where + updatePQ = updateConnPQSndEnabled db connId pqSndEnabled' + +sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage +sendGroupMessage user gInfo members chatMsgEvent = do + sendGroupMessages user gInfo members (chatMsgEvent :| []) >>= \case + ((Right msg) :| [], _) -> pure msg + _ -> throwChatError $ CEInternalError "sendGroupMessage: expected 1 message" + +sendGroupMessage' :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage +sendGroupMessage' user gInfo members chatMsgEvent = + sendGroupMessages_ user gInfo members (chatMsgEvent :| []) >>= \case + ((Right msg) :| [], _) -> pure msg + _ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message" + +sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) +sendGroupMessages user gInfo members events = do + when shouldSendProfileUpdate $ + sendProfileUpdate `catchChatError` (toView . CRChatError (Just user)) + sendGroupMessages_ user gInfo members events + where + User {profile = p, userMemberProfileUpdatedAt} = user + GroupInfo {userMemberProfileSentAt} = gInfo + shouldSendProfileUpdate + | incognitoMembership gInfo = False + | otherwise = + case (userMemberProfileSentAt, userMemberProfileUpdatedAt) of + (Just lastSentTs, Just lastUpdateTs) -> lastSentTs < lastUpdateTs + (Nothing, Just _) -> True + _ -> False + sendProfileUpdate = do + let members' = filter (`supportsVersion` memberProfileUpdateVersion) members + profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p + void $ sendGroupMessage' user gInfo members' profileUpdateEvent + currentTs <- liftIO getCurrentTime + withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs + +data GroupSndResult = GroupSndResult + { sentTo :: [(GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption))], + pending :: [(GroupMemberId, Either ChatError MessageId, Either ChatError ())], + forwarded :: [GroupMember] + } + +sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) +sendGroupMessages_ _user gInfo@GroupInfo {groupId} members events = do + let idsEvts = L.map (GroupId groupId,) events + sndMsgs_ <- lift $ createSndMessages idsEvts + recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) + let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} + (toSendSeparate, toSendBatched, toPending, forwarded, _, dups) = + foldr' addMember ([], [], [], [], S.empty, 0 :: Int) recipientMembers + when (dups /= 0) $ logError $ "sendGroupMessages_: " <> tshow dups <> " duplicate members" + -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here + -- Deliver to toSend members + let (sendToMemIds, msgReqs) = prepareMsgReqs msgFlags sndMsgs_ toSendSeparate toSendBatched + delivered <- maybe (pure []) (fmap L.toList . deliverMessagesB) $ L.nonEmpty msgReqs + when (length delivered /= length sendToMemIds) $ logError "sendGroupMessages_: sendToMemIds and delivered length mismatch" + -- Save as pending for toPending members + let (pendingMemIds, pendingReqs) = preparePending sndMsgs_ toPending + stored <- lift $ withStoreBatch (\db -> map (bindRight $ createPendingMsg db) pendingReqs) + when (length stored /= length pendingMemIds) $ logError "sendGroupMessages_: pendingMemIds and stored length mismatch" + -- Zip for easier access to results + let sentTo = zipWith3 (\mId mReq r -> (mId, fmap (\(_, _, _, msgIds) -> msgIds) mReq, r)) sendToMemIds msgReqs delivered + pending = zipWith3 (\mId pReq r -> (mId, fmap snd pReq, r)) pendingMemIds pendingReqs stored + pure (sndMsgs_, GroupSndResult {sentTo, pending, forwarded}) + where + shuffleMembers :: [GroupMember] -> IO [GroupMember] + shuffleMembers ms = do + let (adminMs, otherMs) = partition isAdmin ms + liftM2 (<>) (shuffle adminMs) (shuffle otherMs) + where + isAdmin GroupMember {memberRole} = memberRole >= GRAdmin + addMember m acc@(toSendSeparate, toSendBatched, pending, forwarded, !mIds, !dups) = + case memberSendAction gInfo events members m of + Just a + | mId `S.member` mIds -> (toSendSeparate, toSendBatched, pending, forwarded, mIds, dups + 1) + | otherwise -> case a of + MSASend conn -> ((m, conn) : toSendSeparate, toSendBatched, pending, forwarded, mIds', dups) + MSASendBatched conn -> (toSendSeparate, (m, conn) : toSendBatched, pending, forwarded, mIds', dups) + MSAPending -> (toSendSeparate, toSendBatched, m : pending, forwarded, mIds', dups) + MSAForwarded -> (toSendSeparate, toSendBatched, pending, m : forwarded, mIds', dups) + Nothing -> acc + where + mId = groupMemberId' m + mIds' = S.insert mId mIds + prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> [(GroupMember, Connection)] -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq]) + prepareMsgReqs msgFlags msgs_ toSendSeparate toSendBatched = do + let batched_ = batchSndMessagesJSON msgs_ + case L.nonEmpty batched_ of + Just batched' -> do + let (memsSep, mreqsSep) = foldr' foldMsgs ([], []) toSendSeparate + (memsBtch, mreqsBtch) = foldr' (foldBatches batched') ([], []) toSendBatched + (memsSep <> memsBtch, mreqsSep <> mreqsBtch) + Nothing -> ([], []) + where + foldMsgs :: (GroupMember, Connection) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) + foldMsgs (GroupMember {groupMemberId}, conn) memIdsReqs = + foldr' (\msg_ (memIds, reqs) -> (groupMemberId : memIds, fmap sndMessageReq msg_ : reqs)) memIdsReqs msgs_ + where + sndMessageReq :: SndMessage -> ChatMsgReq + sndMessageReq SndMessage {msgId, msgBody} = (conn, msgFlags, msgBody, [msgId]) + foldBatches :: NonEmpty (Either ChatError MsgBatch) -> (GroupMember, Connection) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) + foldBatches batched' (GroupMember {groupMemberId}, conn) memIdsReqs = + foldr' (\batch_ (memIds, reqs) -> (groupMemberId : memIds, fmap (msgBatchReq conn msgFlags) batch_ : reqs)) memIdsReqs batched' + preparePending :: NonEmpty (Either ChatError SndMessage) -> [GroupMember] -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) + preparePending msgs_ = + foldr' foldMsgs ([], []) + where + foldMsgs :: GroupMember -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) -> ([GroupMemberId], [Either ChatError (GroupMemberId, MessageId)]) + foldMsgs GroupMember {groupMemberId} memIdsReqs = + foldr' (\msg_ (memIds, reqs) -> (groupMemberId : memIds, fmap pendingReq msg_ : reqs)) memIdsReqs msgs_ + where + pendingReq :: SndMessage -> (GroupMemberId, MessageId) + pendingReq SndMessage {msgId} = (groupMemberId, msgId) + createPendingMsg :: DB.Connection -> (GroupMemberId, MessageId) -> IO (Either ChatError ()) + createPendingMsg db (groupMemberId, msgId) = + createPendingGroupMessage db groupMemberId msgId Nothing $> Right () + +data MemberSendAction = MSASend Connection | MSASendBatched Connection | MSAPending | MSAForwarded + +memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction +memberSendAction gInfo events members m@GroupMember {memberRole} = case memberConn m of + Nothing -> pendingOrForwarded + Just conn@Connection {connStatus} + | connDisabled conn || connStatus == ConnDeleted -> Nothing + | connInactive conn -> Just MSAPending + | connStatus == ConnSndReady || connStatus == ConnReady -> sendBatchedOrSeparate conn + | otherwise -> pendingOrForwarded + where + sendBatchedOrSeparate conn + -- admin doesn't support batch forwarding - send messages separately so that admin can forward one by one + | memberRole >= GRAdmin && not (m `supportsVersion` batchSend2Version) = Just (MSASend conn) + -- either member is not admin, or admin supports batched forwarding + | otherwise = Just (MSASendBatched conn) + pendingOrForwarded = case memberCategory m of + GCUserMember -> Nothing -- shouldn't happen + GCInviteeMember -> Just MSAPending + GCHostMember -> Just MSAPending + GCPreMember -> forwardSupportedOrPending (invitedByGroupMemberId $ membership gInfo) + GCPostMember -> forwardSupportedOrPending (invitedByGroupMemberId m) + where + forwardSupportedOrPending invitingMemberId_ + | membersSupport && all isForwardedGroupMsg events = Just MSAForwarded + | any isXGrpMsgForward events = Nothing + | otherwise = Just MSAPending + where + membersSupport = + m `supportsVersion` groupForwardVersion && invitingMemberSupportsForward + invitingMemberSupportsForward = case invitingMemberId_ of + Just invMemberId -> + -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember + case find (\m' -> groupMemberId' m' == invMemberId) members of + Just invitingMember -> invitingMember `supportsVersion` groupForwardVersion + Nothing -> False + Nothing -> False + isXGrpMsgForward event = case event of + XGrpMsgForward {} -> True + _ -> False + +sendGroupMemberMessage :: MsgEncodingI e => User -> GroupInfo -> GroupMember -> ChatMsgEvent e -> Maybe Int64 -> CM () -> CM () +sendGroupMemberMessage user gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} chatMsgEvent introId_ postDeliver = do + msg <- createSndMessage chatMsgEvent (GroupId groupId) + messageMember msg `catchChatError` (toView . CRChatError (Just user)) + where + messageMember :: SndMessage -> CM () + messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case + MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver + MSASendBatched conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver + MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_ + MSAForwarded -> pure () + +-- TODO ensure order - pending messages interleave with user input messages +sendPendingGroupMessages :: User -> GroupMember -> Connection -> CM () +sendPendingGroupMessages user GroupMember {groupMemberId} conn = do + pgms <- withStore' $ \db -> getPendingGroupMessages db groupMemberId + forM_ (L.nonEmpty pgms) $ \pgms' -> do + let msgs = L.map (\(sndMsg, _, _) -> sndMsg) pgms' + void $ batchSendConnMessages user conn MsgFlags {notification = True} msgs + lift . void . withStoreBatch' $ \db -> L.map (\SndMessage {msgId} -> deletePendingGroupMessage db groupMemberId msgId) msgs + lift . void . withStoreBatch' $ \db -> L.map (\(_, tag, introId_) -> updateIntro_ db tag introId_) pgms' + where + updateIntro_ :: DB.Connection -> ACMEventTag -> Maybe Int64 -> IO () + updateIntro_ db tag introId_ = case (tag, introId_) of + (ACMEventTag _ XGrpMemFwd_, Just introId) -> updateIntroStatus db introId GMIntroInvForwarded + _ -> pure () + +saveDirectRcvMSG :: MsgEncodingI e => Connection -> MsgMeta -> MsgBody -> ChatMessage e -> CM (Connection, RcvMessage) +saveDirectRcvMSG conn@Connection {connId} agentMsgMeta msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do + conn' <- updatePeerChatVRange conn chatVRange + let agentMsgId = fst $ recipient agentMsgMeta + newMsg = NewRcvMessage {chatMsgEvent, msgBody} + rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} + msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing + pure (conn', msg) + +saveGroupRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> MsgBody -> ChatMessage e -> CM (GroupMember, Connection, RcvMessage) +saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do + (am'@GroupMember {memberId = amMemId, groupMemberId = amGroupMemId}, conn') <- updateMemberChatVRange authorMember conn chatVRange + let agentMsgId = fst $ recipient agentMsgMeta + newMsg = NewRcvMessage {chatMsgEvent, msgBody} + rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} + msg <- + withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery $ Just amGroupMemId) + `catchChatError` \e -> case e of + ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do + vr <- chatVersionRange + fm <- withStore $ \db -> getGroupMember db vr user groupId forwardedByGroupMemberId + forM_ (memberConn fm) $ \fmConn -> + void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemId) groupId + throwError e + _ -> throwError e + pure (am', conn', msg) + +saveGroupFwdRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> GroupMember -> MsgBody -> ChatMessage e -> CM RcvMessage +saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {memberId = refMemberId} msgBody ChatMessage {msgId = sharedMsgId_, chatMsgEvent} = do + let newMsg = NewRcvMessage {chatMsgEvent, msgBody} + fwdMemberId = Just $ groupMemberId' forwardingMember + refAuthorId = Just $ groupMemberId' refAuthorMember + withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId) + `catchChatError` \e -> case e of + ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do + vr <- chatVersionRange + am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db vr user groupId authorGroupMemberId + if sameMemberId refMemberId am + then forM_ (memberConn forwardingMember) $ \fmConn -> + void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemberId) groupId + else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id" + throwError e + _ -> throwError e + +saveSndChatItem :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> CM (ChatItem c 'MDSnd) +saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing Nothing False + +saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd) +saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live = + saveSndChatItems user cd [Right NewSndChatItemData {msg, content, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case + [Right ci] -> pure ci + _ -> throwChatError $ CEInternalError "saveSndChatItem': expected 1 item" + +data NewSndChatItemData c = NewSndChatItemData + { msg :: SndMessage, + content :: CIContent 'MDSnd, + ciFile :: Maybe (CIFile 'MDSnd), + quotedItem :: Maybe (CIQuote c), + itemForwarded :: Maybe CIForwardedFrom + } + +saveSndChatItems :: + forall c. + ChatTypeI c => + User -> + ChatDirection c 'MDSnd -> + [Either ChatError (NewSndChatItemData c)] -> + Maybe CITimed -> + Bool -> + CM [Either ChatError (ChatItem c 'MDSnd)] +saveSndChatItems user cd itemsData itemTimed live = do + createdAt <- liftIO getCurrentTime + when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $ + withStore' (\db -> updateChatTs db user cd createdAt) + lift $ withStoreBatch (\db -> map (bindRight $ createItem db createdAt) itemsData) + where + createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd)) + createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, ciFile, quotedItem, itemForwarded} = do + ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt + forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt + pure $ Right $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live createdAt Nothing createdAt + +saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> CM (ChatItem c 'MDRcv) +saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content = + saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False + +saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDRcv) +saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do + createdAt <- liftIO getCurrentTime + (ciId, quotedItem, itemForwarded) <- withStore' $ \db -> do + when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt + r@(ciId, _, _) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt + forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt + pure r + pure $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live brokerTs forwardedByMember createdAt + +mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d +mkChatItem cd ciId content file quotedItem sharedMsgId itemForwarded itemTimed live itemTs forwardedByMember currentTs = + let itemText = ciContentToText content + itemStatus = ciCreateStatus content + meta = mkCIMeta ciId content itemText itemStatus Nothing sharedMsgId itemForwarded Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByMember currentTs currentTs + in ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} + +createAgentConnectionAsync :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> CM (CommandId, ConnId) +createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do + cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction + connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode + pure (cmdId, connId) + +joinAgentConnectionAsync :: User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId) +joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do + cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn + connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo PQSupportOff subMode + pure (cmdId, connId) + +allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM () +allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersion} confId msg = do + cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn + dm <- encodeConnInfoPQ pqSupport connChatVersion msg + withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm + withStore' $ \db -> updateConnectionStatus db conn ConnAccepted + +agentAcceptContactAsync :: MsgEncodingI e => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> PQSupport -> VersionChat -> CM (CommandId, ConnId) +agentAcceptContactAsync user enableNtfs invId msg subMode pqSup chatV = do + cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact + dm <- encodeConnInfoPQ pqSup chatV msg + connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pqSup subMode + pure (cmdId, connId) + +deleteAgentConnectionAsync :: User -> ConnId -> CM () +deleteAgentConnectionAsync user acId = deleteAgentConnectionAsync' user acId False + +deleteAgentConnectionAsync' :: User -> ConnId -> Bool -> CM () +deleteAgentConnectionAsync' user acId waitDelivery = do + withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchChatError` (toView . CRChatError (Just user)) + +deleteAgentConnectionsAsync :: User -> [ConnId] -> CM () +deleteAgentConnectionsAsync user acIds = deleteAgentConnectionsAsync' user acIds False + +deleteAgentConnectionsAsync' :: User -> [ConnId] -> Bool -> CM () +deleteAgentConnectionsAsync' _ [] _ = pure () +deleteAgentConnectionsAsync' user acIds waitDelivery = do + withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchChatError` (toView . CRChatError (Just user)) + +agentXFTPDeleteRcvFile :: RcvFileId -> FileTransferId -> CM () +agentXFTPDeleteRcvFile aFileId fileId = do + lift $ withAgent' (`xftpDeleteRcvFile` aFileId) + withStore' $ \db -> setRcvFTAgentDeleted db fileId + +agentXFTPDeleteRcvFiles :: [(XFTPRcvFile, FileTransferId)] -> CM' () +agentXFTPDeleteRcvFiles rcvFiles = do + let rcvFiles' = filter (not . agentRcvFileDeleted . fst) rcvFiles + rfIds = mapMaybe fileIds rcvFiles' + withAgent' $ \a -> xftpDeleteRcvFiles a (map fst rfIds) + void . withStoreBatch' $ \db -> map (setRcvFTAgentDeleted db . snd) rfIds + where + fileIds :: (XFTPRcvFile, FileTransferId) -> Maybe (RcvFileId, FileTransferId) + fileIds (XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId)}, fileId) = Just (aFileId, fileId) + fileIds _ = Nothing + +agentXFTPDeleteSndFileRemote :: User -> XFTPSndFile -> FileTransferId -> CM' () +agentXFTPDeleteSndFileRemote user xsf fileId = + agentXFTPDeleteSndFilesRemote user [(xsf, fileId)] + +agentXFTPDeleteSndFilesRemote :: User -> [(XFTPSndFile, FileTransferId)] -> CM' () +agentXFTPDeleteSndFilesRemote user sndFiles = do + (_errs, redirects) <- partitionEithers <$> withStoreBatch' (\db -> map (lookupFileTransferRedirectMeta db user . snd) sndFiles) + let redirects' = mapMaybe mapRedirectMeta $ concat redirects + sndFilesAll = redirects' <> sndFiles + sndFilesAll' = filter (not . agentSndFileDeleted . fst) sndFilesAll + -- while file is being prepared and uploaded, it would not have description available; + -- this partitions files into those with and without descriptions - + -- files with description are deleted remotely, files without description are deleted internally + (sfsNoDescr, sfsWithDescr) <- partitionSndDescr sndFilesAll' [] [] + withAgent' $ \a -> xftpDeleteSndFilesInternal a sfsNoDescr + withAgent' $ \a -> xftpDeleteSndFilesRemote a (aUserId user) sfsWithDescr + void . withStoreBatch' $ \db -> map (setSndFTAgentDeleted db user . snd) sndFilesAll' + where + mapRedirectMeta :: FileTransferMeta -> Maybe (XFTPSndFile, FileTransferId) + mapRedirectMeta FileTransferMeta {fileId = fileId, xftpSndFile = Just sndFileRedirect} = Just (sndFileRedirect, fileId) + mapRedirectMeta _ = Nothing + partitionSndDescr :: + [(XFTPSndFile, FileTransferId)] -> + [SndFileId] -> + [(SndFileId, ValidFileDescription 'FSender)] -> + CM' ([SndFileId], [(SndFileId, ValidFileDescription 'FSender)]) + partitionSndDescr [] filesWithoutDescr filesWithDescr = pure (filesWithoutDescr, filesWithDescr) + partitionSndDescr ((XFTPSndFile {agentSndFileId = AgentSndFileId aFileId, privateSndFileDescr}, _) : xsfs) filesWithoutDescr filesWithDescr = + case privateSndFileDescr of + Nothing -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr + Just sfdText -> + tryChatError' (parseFileDescription sfdText) >>= \case + Left _ -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr + Right sfd -> partitionSndDescr xsfs filesWithoutDescr ((aFileId, sfd) : filesWithDescr) + +userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Bool -> Profile +userProfileToSend user@User {profile = p} incognitoProfile ct inGroup = do + let p' = fromMaybe (fromLocalProfile p) incognitoProfile + if inGroup + then redactedMemberProfile p' + else + let userPrefs = maybe (preferences' user) (const Nothing) incognitoProfile + in (p' :: Profile) {preferences = Just . toChatPrefs $ mergePreferences (userPreferences <$> ct) userPrefs} + +createRcvFeatureItems :: User -> Contact -> Contact -> CM' () +createRcvFeatureItems user ct ct' = + createFeatureItems user ct ct' CDDirectRcv CIRcvChatFeature CIRcvChatPreference contactPreference + +createSndFeatureItems :: User -> Contact -> Contact -> CM' () +createSndFeatureItems user ct ct' = + createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref + where + getPref ContactUserPreference {userPreference} = case userPreference of + CUPContact {preference} -> preference + CUPUser {preference} -> preference + +type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d + +createFeatureItems :: + MsgDirectionI d => + User -> + Contact -> + Contact -> + (Contact -> ChatDirection 'CTDirect d) -> + FeatureContent PrefEnabled d -> + FeatureContent FeatureAllowed d -> + (forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) -> + CM' () +createFeatureItems user ct ct' = createContactsFeatureItems user [(ct, ct')] + +createContactsFeatureItems :: + forall d. + MsgDirectionI d => + User -> + [(Contact, Contact)] -> + (Contact -> ChatDirection 'CTDirect d) -> + FeatureContent PrefEnabled d -> + FeatureContent FeatureAllowed d -> + (forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) -> + CM' () +createContactsFeatureItems user cts chatDir ciFeature ciOffer getPref = do + let dirsCIContents = map contactChangedFeatures cts + (errs, acis) <- partitionEithers <$> createInternalItemsForChats user Nothing dirsCIContents + unless (null errs) $ toView' $ CRChatErrors (Just user) errs + toView' $ CRNewChatItems user acis + where + contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, [CIContent d]) + contactChangedFeatures (Contact {mergedPreferences = cups}, ct'@Contact {mergedPreferences = cups'}) = do + let contents = mapMaybe (\(ACF f) -> featureCIContent_ f) allChatFeatures + (chatDir ct', contents) + where + featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d) + featureCIContent_ f + | state /= state' = Just $ fContent ciFeature state' + | prefState /= prefState' = Just $ fContent ciOffer prefState' + | otherwise = Nothing + where + fContent :: FeatureContent a d -> (a, Maybe Int) -> CIContent d + fContent ci (s, param) = ci f' s param + f' = chatFeature f + state = featureState cup + state' = featureState cup' + prefState = preferenceState $ getPref cup + prefState' = preferenceState $ getPref cup' + cup = getContactUserPreference f cups + cup' = getContactUserPreference f cups' + +createGroupFeatureChangedItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> GroupInfo -> CM () +createGroupFeatureChangedItems user cd ciContent GroupInfo {fullGroupPreferences = gps} GroupInfo {fullGroupPreferences = gps'} = + forM_ allGroupFeatures $ \(AGF f) -> do + let state = groupFeatureState $ getGroupPreference f gps + pref' = getGroupPreference f gps' + state'@(_, param', role') = groupFeatureState pref' + when (state /= state') $ + createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref') param' role') Nothing + +sameGroupProfileInfo :: GroupProfile -> GroupProfile -> Bool +sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferences = Nothing} + +createGroupFeatureItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> CM () +createGroupFeatureItems user cd ciContent GroupInfo {fullGroupPreferences} = + forM_ allGroupFeatures $ \(AGF f) -> do + let p = getGroupPreference f fullGroupPreferences + (_, param, role) = groupFeatureState p + createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing + +createInternalChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> CM () +createInternalChatItem user cd content itemTs_ = + lift (createInternalItemsForChats user itemTs_ [(cd, [content])]) >>= \case + [Right aci] -> toView $ CRNewChatItems user [aci] + [Left e] -> throwError e + rs -> throwChatError $ CEInternalError $ "createInternalChatItem: expected 1 result, got " <> show (length rs) + +createInternalItemsForChats :: + forall c d. + (ChatTypeI c, MsgDirectionI d) => + User -> + Maybe UTCTime -> + [(ChatDirection c d, [CIContent d])] -> + CM' [Either ChatError AChatItem] +createInternalItemsForChats user itemTs_ dirsCIContents = do + createdAt <- liftIO getCurrentTime + let itemTs = fromMaybe createdAt itemTs_ + void . withStoreBatch' $ \db -> map (uncurry $ updateChat db createdAt) dirsCIContents + withStoreBatch' $ \db -> concatMap (uncurry $ createACIs db itemTs createdAt) dirsCIContents + where + updateChat :: DB.Connection -> UTCTime -> ChatDirection c d -> [CIContent d] -> IO () + updateChat db createdAt cd contents + | any ciRequiresAttention contents || contactChatDeleted cd = updateChatTs db user cd createdAt + | otherwise = pure () + createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem] + createACIs db itemTs createdAt cd = map $ \content -> do + ciId <- createNewChatItemNoMsg db user cd content itemTs createdAt + let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False itemTs Nothing createdAt + pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci + +createLocalChatItems :: + User -> + ChatDirection 'CTLocal 'MDSnd -> + [(CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom)] -> + UTCTime -> + CM [ChatItem 'CTLocal 'MDSnd] +createLocalChatItems user cd itemsData createdAt = do + withStore' $ \db -> updateChatTs db user cd createdAt + (errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) itemsData) + unless (null errs) $ toView $ CRChatErrors (Just user) errs + pure items + where + createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom) -> IO (ChatItem 'CTLocal 'MDSnd) + createItem db (content, ciFile, itemForwarded) = do + ciId <- createNewChatItem_ db user cd Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False createdAt Nothing createdAt + forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt + pure $ mkChatItem cd ciId content ciFile Nothing Nothing itemForwarded Nothing False createdAt Nothing createdAt + +withUser' :: (User -> CM ChatResponse) -> CM ChatResponse +withUser' action = + asks currentUser + >>= readTVarIO + >>= maybe (throwChatError CENoActiveUser) run + where + run u = action u `catchChatError` (pure . CRChatCmdError (Just u)) + +withUser :: (User -> CM ChatResponse) -> CM ChatResponse +withUser action = withUser' $ \user -> + ifM (lift chatStarted) (action user) (throwChatError CEChatNotStarted) + +withUser_ :: CM ChatResponse -> CM ChatResponse +withUser_ = withUser . const + +withUserId' :: UserId -> (User -> CM ChatResponse) -> CM ChatResponse +withUserId' userId action = withUser' $ \user -> do + checkSameUser userId user + action user + +withUserId :: UserId -> (User -> CM ChatResponse) -> CM ChatResponse +withUserId userId action = withUser $ \user -> do + checkSameUser userId user + action user + +checkSameUser :: UserId -> User -> CM () +checkSameUser userId User {userId = activeUserId} = when (userId /= activeUserId) $ throwChatError (CEDifferentActiveUser userId activeUserId) + +chatStarted :: CM' Bool +chatStarted = fmap isJust . readTVarIO =<< asks agentAsync + +waitChatStartedAndActivated :: CM' () +waitChatStartedAndActivated = do + agentStarted <- asks agentAsync + chatActivated <- asks chatActivated + atomically $ do + started <- readTVar agentStarted + activated <- readTVar chatActivated + unless (isJust started && activated) retry + +chatVersionRange :: CM VersionRangeChat +chatVersionRange = lift chatVersionRange' +{-# INLINE chatVersionRange #-} + +chatVersionRange' :: CM' VersionRangeChat +chatVersionRange' = do + ChatConfig {chatVRange} <- asks config + pure chatVRange +{-# INLINE chatVersionRange' #-} + +adminContactReq :: ConnReqContact +adminContactReq = + either error id $ strDecode "simplex:/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D" + +simplexTeamContactProfile :: Profile +simplexTeamContactProfile = + Profile + { displayName = "SimpleX Chat team", + fullName = "", + image = Just (ImageData "data:image/jpg;base64,/9j/4AAQSkZJRgABAgAAAQABAAD/2wBDAAUDBAQEAwUEBAQFBQUGBwwIBwcHBw8KCwkMEQ8SEhEPERATFhwXExQaFRARGCEYGhwdHx8fExciJCIeJBweHx7/2wBDAQUFBQcGBw4ICA4eFBEUHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh7/wAARCAETARMDASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwD7LooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiivP/iF4yFvv0rSpAZek0yn7v+yPeunC4WpiqihBf8A8rOc5w2UYZ4jEPTourfZDvH3jL7MW03SpR53SWUfw+w96veA/F0erRLY3zKl6owD2k/8Ar15EWLEljknqadDK8MqyxMUdTlWB5Br66WS0Hh/ZLfv1ufiNLj7Mo5m8ZJ3g9OTpy+Xn5/pofRdFcd4B8XR6tEthfMEvVHyk9JB/jXY18fiMPUw9R06i1P3PK80w2aYaOIw8rxf3p9n5hRRRWB6AUUVDe3UFlavc3MixxIMsxppNuyJnOMIuUnZIL26gsrV7m5kWOJBlmNeU+I/Gd9e6sk1hI8FvA2Y1z973NVPGnimfXLoxRFo7JD8if3vc1zefevr8syiNKPtKyvJ9Ox+F8Ycb1cdU+rYCTjTi/iWjk1+nbue3eEPEdtrtoMER3SD95Hn9R7Vu18+6bf3On3kd1aSmOVDkEd/Y17J4P8SW2vWY6R3aD97F/Ue1eVmmVPDP2lP4fyPtODeMoZrBYXFO1Zf+Tf8AB7r5o3qKKK8Q/QgooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAqavbTXmmz20Fw1vJIhVZB1FeDa3p15pWoSWl6hWQHr2YeoNfQlY3izw9Z6/YGGZQky8xSgcqf8K9jKcyWEnyzXuv8D4njLhZ51RVSi7VYLRdGu3k+z+88HzRuq1rWmXmkX8lnexFHU8Hsw9RVLNfcxlGcVKLumfgFahUozdOorSWjT6E0M0kMqyxOyOpyrKcEGvXPAPjCPVolsb9wl6owGPAkH+NeO5p8M0kMqyxOyOpyrA4INcWPy+njKfLLfoz2+HuIMTkmI9pT1i/ij0a/wA+zPpGiuM+H/jCPV4lsL91S+QfKTwJR/jXW3t1BZWslzcyLHFGMsxNfB4jC1aFX2U1r+fof0Rl2bYXMMKsVRl7vXy7p9rBfXVvZWr3NzKscSDLMTXjnjbxVPrtyYoiY7JD8if3vc0zxv4ruNeujFEWjsoz8if3vc1zOa+synKFh0qtVe9+X/BPxvjLjKWZSeEwjtSW7/m/4H5kmaM1HmlB54r3bH51YkzXo3wz8MXMc0es3ZeED/VR5wW9z7VB8O/BpnMerarEREDuhhb+L3Pt7V6cAAAAAAOgFfL5xmqs6FH5v9D9a4H4MlzQzHGq1tYR/KT/AEXzCiiivlj9hCiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAxfFvh208QWBhmASdRmKUdVP+FeH63pl5pGoSWV5EUdTwezD1HtX0VWL4t8O2fiHTzBONk6g+TKByp/wr28pzZ4WXs6msH+B8NxdwhTzeDxGHVqy/8m8n59n954FmjNW9b0y80fUHsr2MpIp4PZh6iqWfevuYyjOKlF3TPwetQnRm6dRWktGmSwzSQyrLE7I6nKsDgg1teIPFOqa3a29vdy4jiUAheN7f3jWBmjNROhTnJTkrtbGtLF4ijSnRpzajPddHbuP3e9Lmo80ua0scth+a9E+HXgw3Hl6tqsZEX3oYmH3vc+1J8OPBZnKavq0eIhzDCw+9/tH29q9SAAAAGAOgr5bOM35b0KD16v8ARH6twXwXz8uPx0dN4xfXzf6IFAUAAAAdBRRRXyZ+wBRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFB4GTXyj+1p+0ONJjufA3ga6DX7qU1DUY24gB4McZH8Xqe38tqFCdefLETaSufQ3h/4geEde8Uah4a0rWra51Ow/wBfCrD8ceuO+OldRX5I+GfEWseG/ENvr2j30ttqFvJ5iSqxyT3z6g96/RH9nD41aT8U9AWGcx2fiK1QC7tC33/+mieqn07V14zL3QXNHVEQnc9dooorzjQKKKKACiis7xHrel+HdGudY1m8is7K2QvLLI2AAP600m3ZAYfxUg8Pr4VutT1+7isYbSMuLp/4Pb3z6V8++HNd0zxDpq6hpVys8DHGRwVPoR2NeIftJ/G7VPifrbWVk8lp4btZD9mtwcGU/wDPR/c9h2rgfh34z1LwdrAurV2ktZCBcW5PyyD/AB9DX2WTyqYWny1Ho+nY+C4t4Wp5tF16CtVX/k3k/Ps/vPr/ADRmsjwx4g07xFpMWpaZOJInHI/iQ9wR61qbq+mVmro/D6tCdGbp1FZrdEma6/4XafpWoa7jUpV3oA0MLdJD/ntXG5p8E0kMqyxOyOhyrKcEGsMTRlWpShGVm+p1ZbiYYPFQr1IKai72fU+nFAUAKAAOABRXEfDnxpFrMK6fqDhL9BhSeko9frXb1+a4rDVMNUdOotT+k8szLD5lh44jDu8X968n5hRRRXOegFFFFABUGoXlvYWkl1dSrHFGMliaL+7t7C0kuruVYoYxlmNeI+OvFtx4huzHFuisYz+7jz97/aNenluW1MbU00it2fM8S8SUMkoXetR/DH9X5fmeteF/E+m+IFkFoxSWMnMb9cev0rbr5t0vULrTb6K8s5TFNGcgj+R9q9w8E+KbXxDYjlY7xB+9i/qPaurNsneE/eUtYfkeTwlxjHNV9XxVo1V90vTz8vmjoqKKK8I+8CiiigAooooAKKKKACiiigD5V/a8+P0mgvdeAvCUskepFdl9eDjyQR9xPfHeviiR3lkaSR2d2OWZjkk+tfoj+058CtP+Jektq2jxRWnie2T91KMKLlR/yzf+h7V+fOuaVqGiarcaXqtpLaXls5jlikXDKRX0mWSpOlaG/U56l76lKtPwtr+reGNetdb0S8ls761cPHJG2D9D6g9MVmUV6TSasyD9Jf2cfjXpPxR0MW9w0dp4gtkAubYnHmf7aeo/lXr1fkh4W1/V/DGuW2taHey2d9bOHjkjP6H1HtX6Jfs5fGvR/inoQgmeOz8RWqD7XaE439vMT1U+navnMfgHRfPD4fyN4Tvoz12iis7xJremeHdEutZ1i7jtLK1jLyyucAAf1rzUm3ZGgeJNb0vw7otzrOs3kVpZWyF5ZZDgAD+Z9q/PL9pP436r8UNZaxs2ks/Dlq5+z24ODMf77+p9B2o/aU+N2p/FDXDZ2LS2fhy1ci3t84Mx/wCej+/oO1eNV9DgMAqS55/F+RhOd9EFFFABJwBkmvUMzqPh34y1Lwjq63FszSWshAntyeHHt719Z2EstzpVlqD2txbR3kCzxLPGUbawyODXK/slfs8nUpbXx144tGFkhElhp8q4849pHB/h9B3r608X+GLDxBpX2WRFiljX9xIowUPYfT2rGnnkMPWVJ6x6vt/XU+P4o4SjmtN4igrVV/5N5Pz7P7z56zRmrmvaVe6LqMljexMkiHg9mHqKoZr6uEozipRd0z8Rq0J0ZunUVmtGmTwTSQTJNC7JIhyrKcEGvZvhz41j1mJdP1GRUv0GFY8CX/69eJZqSCaWCVZYXZHU5VlOCDXDmGXU8bT5ZaPo+x7WQZ9iMlxHtKesX8UejX+fZn1FRXDfDbxtHrUKadqDqmoIuAx4EoHf613NfnWKwtTC1HTqKzR/QGW5lh8yw8cRh3eL+9Ps/MKr6heW1hZyXd3KsUUYyzGjUby20+zku7yZYoY13MzGvDPHvi+48RXpjiZorCM/u4/73+0feuvLMsqY6pZaRW7/AK6nlcScR0MloXetR/DH9X5D/Hni648Q3nlxlo7GM/u48/e9zXL7qZmjNfodDDwoU1TpqyR+AY7G18dXlXryvJ/19w/dVvSdRutMvo7yzlaOVDkY7+xqkDmvTPhn4HMxj1jV4v3Y+aCFh97/AGjWGPxNHDUXKrt27+R15JlWLzHFxp4XSS1v/L53PQ/C+oXGqaJb3t1bNbyyLkoe/v8AQ1p0AAAAAADoBRX5nUkpSbirLsf0lh6c6dKMJy5mkrvv5hRRRUGwUUUUAFFFFABRRRQAV4d+038CdO+JWkyavo8cdp4mtkzHIBhbkD+B/f0Ne40VpSqypSUovUTV9GfkTruk6joer3Ok6taS2d7ayGOaGVdrKRVKv0T/AGnfgXp/xK0h9Y0iOO18TWqZikAwLkD+B/6Gvz51zStQ0TVbjS9UtZbW8tnKSxSLgqRX1GExccRG636o55RcSlWp4V1/VvDGvWut6JeSWl9bOGjkQ4/A+oPpWXRXU0mrMk/RP4LftDeFvF3ge41HxDfW+lappkG+/idsBwP40HfJ7V8o/tJ/G/VPifrbWVk8tn4btn/0e2zgykfxv6n0HavGwSM4JGeuO9JXFRwFKlUc18vIpzbVgoooAJIAGSa7SQr6x/ZM/Z4k1J7Xxz44tClkMSWFhIuDL3Ejg/w+g70fsmfs8NqMtt448c2eLJCJLCwlX/WnqHcH+H0HevtFFVECIoVVGAAMACvFx+PtenTfqzWEOrEjRI41jjUIigBVAwAPSnUUV4ZsYXjLwzZeJNOaCcBLhQfJmA5U/wCFeBa/pV7ompSWF9GUkToccMOxHtX01WF4z8M2XiXTTBOAk6AmGYDlD/hXvZPnEsHL2dTWD/A+K4r4UhmsHXoK1Zf+TeT8+z+8+c80Zq5r2k3ui6jJY30ZSRTwezD1FUM1+gQlGcVKLumfiFWjOjN06is1umTwTSQTJNE7JIh3KynBBr2PwL8QrO701odbnSC5t0yZCcCUD+teK5pd1cWPy2ljoctTdbPqetkme4rJ6rqUHdPdPZ/8Mdb4/wDGFz4ivDFGxisIz+7j/ve5rls1HuozXTQw1PD01TpqyR5+OxlfHV5V68ryf9fcSZozTAa9P+GHgQzmPWdZhIjHzQQMPvf7R9qxxuMpYOk6lR/8E6MpyfEZriFQoL1fRLux/wAMvApmMesazFiP70EDfxf7R9vavWFAUAAAAcACgAAAAAAdBRX5xjsdVxtXnn8l2P3/ACXJcNlGHVGivV9W/wCugUUUVxHrhRRRQAUUUUAFFFFABRRRQAUUUUAFeH/tOfArT/iXpUmsaSsVp4mto/3UuMLcgDhH/oe1e4Vn+I9a0zw7otzrGsXkVpZWyF5ZZGwAB/WtaNSdOalDcTSa1PyZ1zStQ0TVrnStVtZLS8tnMcsUgwVIqlXp/wC0l8S7T4nePn1aw0q3srO3XyYJBGBNOoPDSHv7DtXmFfXU5SlBOSszlYUUUVYAAScDk19Zfsmfs7vqLW3jjx1ZFLMESafYSjmXuJHHZfQd6+VtLvJtO1K2v7cRtLbyrKgkQOpKnIyp4I46Gv0b/Zv+NOjfFDw+lrIIrDX7RAtzZ8AMMffj9V9u1efmVSrCn7m3Vl00m9T16NEjjWONVRFGFUDAA9KWiivmToCiiigAooooAwfGnhiy8S6cYJwEuEH7mYDlT/hXz7r+k32h6lJYahFskQ8Hsw9QfSvpjUr2106ykvLyZYYYxlmY18+/EXxa/ijU1aOMRWkGRCCBuPuT/Svr+GK2KcnTSvT/ACfl/kfmPiBhMvUI1m7Vn0XVefp0fy9Oa3UbqZmjNfa2PynlJM+9AOajzTo5GjkV0YqynIPoaVg5T1P4XeA/P8vWdaiIj+9BAw+9/tH29q9dAAAAAAHQVwPwx8dQ63Ammai6R6hGuFJ4Ew9vf2rvq/Ms5qYmeJaxGjWy6W8j+gOFcPl9LAReBd0931b8+3oFFFFeSfSBRRRQAUUUUAFFFFABRRRQAUUUUAFFFZ3iTW9L8OaJdazrN5HaWNqheWWQ4AH+NNJt2QB4l1vTPDmiXWs6xdx2llaxl5ZHOAAO3ufavzx/aT+N2qfFDWzZWbSWfhy2ci3tg2DKf77+p9B2pf2lfjdqfxQ1trGxeW08N2z/AOj2+cGYj/lo/v6DtXjVfQ4DAKkuefxfkYTnfRBRRQAScAZNeoZhRXv3w2/Zh8V+Lfh7deJprgadcvHv02zlT5rgdcsf4Qe1eHa5pWoaJq1zpWq2ktpeW0hjlikXDKwrOFanUk4xd2htNFKtTwrr+reGNdtta0S8ltL22cPHIhx07H1HtWXRWjSasxH6S/s4/GrSfijoYtp3jtfENqg+1WpON4/vp6j27V69X5IeFfEGr+F9etdc0O9ks7+1cPHKh/QjuD3Ffoj+zl8bNI+KWhLbztFZ+IraMfa7TON+Osieqn07V85j8A6L54fD+RvCd9GevUUUV5hoFVtTvrXTbGW9vJligiXczNRqd9aabYy3t7MsMEQyzMa+ffiN42uvE96YoS0OmxH91F3b/ab3r1spympmFSy0it3+i8z57iDiCjlFG71qPZfq/Id8RPGl14lvTFEzRafGf3cf97/aNclmmZozX6Xh8NTw1NU6askfheNxdbG1pV68ryY/NGTTM16R4J+GVxrGkSX+pSSWfmJ/oq45J7MR6Vni8ZRwkOes7I1y7K8TmNX2WHjd7/0zzvJozV3xDpF7oepyWF/EUkQ8HHDD1FZ+feuiEozipRd0zjq0Z0puE1ZrdE0E8sEyTQu0ciHKspwQa9z+GHjuLXIU0zUpFTUEXCseBKB/WvBs1JBPLBMk0LmORCGVlOCDXn5lllLH0uWWjWz7HsZFnlfJ6/tKesXuu6/z7M+tKK4D4X+PItdhTTNSdY9SQYVicCYDuPf2rv6/M8XhKuEqulVVmj92y7MaGYUFXoO6f4Ps/MKKKK5juCiiigAooooAKKKKACiig9KAM7xLrmleG9EudZ1q8jtLG2QvLK5wAPQep9q/PH9pP43ap8T9beyspJbTw3bSH7NbZx5pH8b+p9u1bH7YPxL8XeJPG114V1G0udH0jT5SIrNuDOR0kbs2e3pXgdfRZfgVTSqT3/IwnO+iCiigAkgAZJr1DMK+s/2TP2d31Brbxz46tNtmMSafp8i8y9/MkB6L0wO9J+yb+zwdSe28b+ObLFmpEljYSr/rT1DuP7voO9faCKqIERQqqMAAYAFeLj8fa9Om/VmsIdWEaJGixooVFGFUDAA9K8Q/ac+BWnfErSZNY0mOO08T2yZilAwtyAPuP/Q9q9worx6VWVKSlF6mrSasfkTrmlahomrXOlaray2l7bSGOaKRcMrCqVfon+098C7D4l6U+s6Skdr4mtY/3UmMC5UdI29/Q1+fOt6XqGi6rcaVqlrJa3ls5SWKQYKkV9RhMXHERut+qOeUeUpVqeFfEGreGNdttb0W7ktb22cNG6HH4H1FZdFdTSasyT9Jf2cPjVpXxR0Fbe4eK18Q2qD7Va7sbx/z0T1H8q9V1O+tdNsZb29mWGCJdzMxr8ovAOoeIdK8W2GoeF5podVhlDQtEefcH2PevsbxP4417xTp1jDq3lQGKFPOigJ2NLj5m59849K4KHD0sTX9x2h18vJHj55xDSyqhd61Hsv1fkaXxG8bXXie9MURaLTo2/dR5+9/tH3rkM1HmjNffYfC08NTVOmrJH4ljMXWxtaVau7yZJmgHmmAmvWfhN8PTceVrmuQkRDDW9uw+9/tN7Vjj8dSwNJ1ar9F3OjK8pr5nXVGivV9Eu7H/Cf4emcx63rkJEfDW9u4+9/tMPT2r2RQFAVQABwAKAAAAAAB0Aor8uzDMKuOq+0qfJdj9zyjKMPlVBUaK9X1bOf8b+FbHxRppt7gCO4UfuZwOUP9R7V86+IdHv8AQtTk0/UIikqHg9mHqD6V9VVz3jnwrY+KNMNvcKEuEBME2OUP+FenkmdywUvZVdab/A8PijheGZw9vQVqq/8AJvJ+fZnzLuo3Ve8Q6Pf6FqclhqERjkQ8Hsw9Qazs1+jwlGpFSi7pn4xVozpTcJqzW6J7eeSCZJoZGjkQhlZTgg17t8LvHsWuQppmpOseooMKxPEw/wAa8DzV3Q7fULvVIIdLWQ3ZcGMx8EH1z2rzs1y2jjaLVTRrZ9v+AezkGcYnK8SpUVzKWjj3/wCD2PrCiqOgx38Oj20eqTJNeLGBK6jAJq9X5VOPLJq9z98pyc4KTVr9H0CiiipLCiiigAooooAKKKKAPK/2hfg3o/xT8PFdsVprlupNnebec/3W9VNfnR4y8Naz4R8RXWg69ZvaXts5V1YcEdmB7g9jX6115V+0P8GtF+Knh05SO0161UmzvQuD/uP6qf0r08DjnRfJP4fyM5wvqj80RycCvrP9kz9ndtRNr458dWTLaAiTT9PlXBl9JJB/d7gd+tXv2bv2Y7yz19vEHxFs1VbKYi1sCQwlZTw7f7PcDvX2CiLGioihVUYAAwAK6cfmGns6T9WTCHVhGiRoqRqFRRgKBgAUtFFeGbBRRRQAV4h+038CtP8AiZpTatpCQ2fia2jPlS4wtyo52P8A0Pavb6K0pVZUpKUXqJq+jPyJ1zStQ0TVrnStVtJbS9tnMcsUgwVIqPS7C61O+isrKFpZ5W2qor9AP2r/AIM6J448OzeJLV7fTtesoyRO3yrcqP4H9/Q14F8OvBlp4XsvMkCTajKP3suM7f8AZX0H86+1yiDzFcy0S3Pms+zqllNLXWb2X6vyH/DnwZaeF7EPIEm1CUDzZcfd/wBke1dfmo80ua+0pUY0oqMVofjWLxNXF1XWrO8mSZozUea9N+B/hTTdau5NUv5opvsrjbak8k9mYelc+OxcMHQlWqbI1y3LqmYYmOHpbvuafwj+HhnMWva5DiMENb27D73ozD09q9oAAAAAAHQCkUBVCqAAOABS1+U5jmNXH1XUqfJdj9yyjKKGV0FRor1fVsKKKK4D1AooooA57xz4UsPFOmG3uFEdwgJgnA5Q/wBR7V84eI9Gv9A1SXT9RhMcqHg/wuOxB7ivrCud8d+E7DxTpZt51CXKDMEwHKn/AAr6LI88lgpeyq603+Hmv1Pj+J+GIZnB16KtVX/k3k/Psz5p0uxu9Tv4rGxheaeVtqIoyTX0T8OPBNp4XsRJKFm1GQfvZf7v+yvtR8OfBFn4UtDIxW41CUfvJsdB/dX0FdfWue568W3RoP3Pz/4BhwvwtHL0sTiVeq9l/L/wQooor5g+3CiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKrarf2ml2E19fTpBbwrud2OAKTVdQtNLsJb6+mWGCJcszGvm34nePLzxXfmGEtDpkTfuos/f/wBpvevZyfJ6uZVbLSC3f6LzPBz3PaOVUbvWb2X6vyH/ABM8d3fiq/MULPDpsR/dRdN3+03vXF5pm6jdX6phsLTw1JUqSskfjGLxVbGVnWrO8mSZ96M0wGnSq8UhjkRkdeCrDBFb2OXlFzWn4b1y/wBA1SPUNPmMciHkdmHoR6Vk7hS596ipTjUi4zV0y6c50pqcHZrZn1X4C8W2HizShc27BLmMATwZ5Q/4V0dfIfhvXL/w/qseo6dMY5U6js47gj0r6Y8BeLtP8WaUtzbER3KAefATyh/qPevzPPshlgJe1pa03+Hk/wBGfr/DfEkcygqNbSqv/JvNefdHSUUUV80fWhRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFVtVv7TS7CW+vp1ht4l3O7HpSatqNnpWny319OsMES7mZjXzP8UfH154tv8AyYWeDS4WPlQ5xvP95vU/yr2smyarmVWy0gt3+i8zws8zylldK71m9l+r8h/xP8eXfiy/MUJaHTIm/cxZ5b/ab3ris0zNGa/V8NhaWFpKlSVkj8bxeKrYuq61Z3kx+aX2pmTXsnwc+GrXBh8Qa/CViB3W9sw5b0Zh6e1YZhj6OAourVfourfY3y3LK+Y11Ror1fRLux3wc+GxuPK1/X4SIgQ1tbuPvf7TD09BXT/Fv4dQ6/bPqukxpFqca5KgYE4Hb6+9ekKAqhVAAHAApa/L62fYupi1ilKzWy6W7f5n63R4bwVPBPBuN0931v3/AMj4wuIZred4J42jlQlWVhgg0zNfRHxc+HUXiCB9W0mNI9TRcso4EwH9a+eLiKW2neCeNo5UO1kYYIPpX6TlOa0cypc8NJLddv8AgH5XnOS1srrck9YvZ9/+CJmtPw1rl/4f1WLUdPmMcqHkZ4Yeh9qys0Zr0qlONSLhNXTPKpznSmpwdmtmfWHgDxfp/i3SVubZhHcoAJ4CfmQ/1HvXSV8feGdd1Dw9q0WpabMY5UPIz8rr3UjuK+nPAHjDT/FulLcW7CO6QYngJ5Q/1FfmGfZBLAS9rS1pv8PJ/oz9c4c4jjmMFRraVV/5N5rz7o6WiiivmT6wKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAOY+JXhRfFvh5rAXDwTod8LA/KW9GHcV8s65pV/oupzadqNu0FxC2GVu/uPUV9m1x/xM8DWHi/TD8qw6jEP3E4HP+6fUV9Tw7n7wEvY1v4b/AAf+Xc+S4k4eWYR9vR/iL8V29ex8q5o+gq9ruk32i6nLp2oQNFPG2CCOvuPUV6v8Gvhk1w0PiDxDBiH71tbOPvejMPT2r9Cx2Z4fB4f283o9rdfQ/OMBlWIxuI+rwjZre/T1F+DPw0NwYfEPiCDEQ+a2tnH3vRmHp6Cvc1AVQqgADgAUKoVQqgAAYAHalr8lzPMq2Y1nVqv0XRI/YsryuhltBUqS9X1bCiiivOPSCvNfi98OYvEVu+raTEseqRrllHAnHoff3r0qiuvBY2tgqyq0nZr8fJnHjsDRx1F0ayun+Hmj4ruIZbad4J42ilQlWRhgg1Hmvoz4vfDiLxDA+raRGseqRjLIOBOP8a8AsdI1K91hdIgtJDetJ5ZiK4Knvn0xX6zleb0Mwoe1Ts1uu3/A8z8dzbJK+XYj2TV0/hff/g+Q3SbC81XUIbCwgee4mYKiKOpr6a+F3ga28IaaWkYTajOo8+Tsv+yvtTPhd4DtPCWnCWULNqcq/vZcfd/2V9q7avh+IeIHjG6FB/u1u+//AAD73hrhuOBSxGIV6j2X8v8AwQooor5M+xCiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAxdd8LaHrd/a32pWKTT2rbo2Pf2PqK2VAVQqgAAYAHalorSVWc4qMm2lt5GcKNOEnKMUm9/MKKKKzNAooooAKKKKACs+HRdLh1iXV4rKFb6VQrzBfmIrQoqozlG/K7XJlCMrOSvYKKKKkoKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooA//2Q=="), + contactLink = Just adminContactReq, + preferences = Nothing + } + +simplexStatusContactProfile :: Profile +simplexStatusContactProfile = + Profile + { displayName = "SimpleX-Status", + fullName = "", + image = Just (ImageData "data:image/jpg;base64,/9j/4AAQSkZJRgABAQAASABIAAD/4QBYRXhpZgAATU0AKgAAAAgAAgESAAMAAAABAAEAAIdpAAQAAAABAAAAJgAAAAAAA6ABAAMAAAABAAEAAKACAAQAAAABAAAAr6ADAAQAAAABAAAArwAAAAD/7QA4UGhvdG9zaG9wIDMuMAA4QklNBAQAAAAAAAA4QklNBCUAAAAAABDUHYzZjwCyBOmACZjs+EJ+/8AAEQgArwCvAwEiAAIRAQMRAf/EAB8AAAEFAQEBAQEBAAAAAAAAAAABAgMEBQYHCAkKC//EALUQAAIBAwMCBAMFBQQEAAABfQECAwAEEQUSITFBBhNRYQcicRQygZGhCCNCscEVUtHwJDNicoIJChYXGBkaJSYnKCkqNDU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6g4SFhoeIiYqSk5SVlpeYmZqio6Slpqeoqaqys7S1tre4ubrCw8TFxsfIycrS09TV1tfY2drh4uPk5ebn6Onq8fLz9PX29/j5+v/EAB8BAAMBAQEBAQEBAQEAAAAAAAABAgMEBQYHCAkKC//EALURAAIBAgQEAwQHBQQEAAECdwABAgMRBAUhMQYSQVEHYXETIjKBCBRCkaGxwQkjM1LwFWJy0QoWJDThJfEXGBkaJicoKSo1Njc4OTpDREVGR0hJSlNUVVZXWFlaY2RlZmdoaWpzdHV2d3h5eoKDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uLj5OXm5+jp6vLz9PX29/j5+v/bAEMAAQEBAQEBAgEBAgMCAgIDBAMDAwMEBgQEBAQEBgcGBgYGBgYHBwcHBwcHBwgICAgICAkJCQkJCwsLCwsLCwsLC//bAEMBAgICAwMDBQMDBQsIBggLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLC//dAAQAC//aAAwDAQACEQMRAD8A/v4ooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAP/Q/v4ooooAKKKKACiiigAoorE8R+ItF8J6Jc+IvEVwlrZ2iGSWWQ4CgVUISlJRirtmdatTo05VaslGMU223ZJLVtvokbdFfl3of/BRbS734rtpup2Ig8LSsIYrjnzkOcea3bafTqBX6cafqFjq1jFqemSrPbzqHjkQ5VlPIINetm2Q43LXD65T5eZXX+XquqPiuC/Efh/itYh5HiVUdGTjJWaflJJ6uEvsy2fqXKKKK8c+5Ciq17e2mnWkl/fyLDDCpd3c4VVHJJJr8c/2kf8Ago34q8M3mpTfByG3fT7CGSJZrlC3nStwJF5GFU8gd69LA5VicXTrVaMfdpxcpPokk397toj4LjvxKyLhGjRqZxValVkowhFc05O9m0tPdjfV7dN2kfq346+J3w9+GWlPrXxA1m00i1QZL3Uqxj8Mnn8K/Mj4tf8ABYD4DeEJ5dM+Gmn3niq4TIE0YEFtn/ffBI+imv51vHfxA8b/ABR1+bxT8RNUuNXvp3LtJcOWCk84VeigdgBXI18LXzupLSkrL72fzrxH9IXNsTKVPKKMaMOkpe/P8fdXpaXqfqvrf/BYH9p6+1w3+iafo1jZA8WrRPKSPeTcpz9BX1l8J/8Ags34PvxDp/xn8M3OmSnAe709hcQfUoSHA/A1/PtSE4/GuKGZ4mLvz39T4TL/ABe4swlZ1ljpTvvGaUo/dbT/ALdsf2rfCX9pT4HfHGzF18M/EdnqTYBaFXCzJn+9G2GH5V7nX8IOm6hqGkX8eraLcy2d3EcpPbuY5FPsykGv6gf+CWf7QPxB+OPwX1Ky+JF22pX3h69+yJdyf62WJlDrvPdlzjPevdwGae3l7OcbP8D+i/DTxm/1ixkcqx2H5K7TalF3jLlV2rPWLtqtWvM/T2iiivYP3c//0f7+KKKKACiiigAooooAK/Fv/goX8Qvi2fFcXgfWrRtP8NDEls0bZS7YfxORxlT0Xt1r9pK8u+L/AMI/Cfxp8F3HgvxbFujlGYpgB5kMg6Op9R+tfR8K5vQy3MYYnE01KK0843+0vNf8NZn5f4wcFZhxTwziMpy3FOjVeqSdo1Lf8u5u11GXk97Xuro/mBFyDX3t+yL+2Be/CW+h8B+OHafw7cyALIxJa0Ldx6p6jt1FfMvx/wDgR4w/Z+8YN4d8RoZrSbLWd4owk6D+TDuK8KF0K/pLFYHA51geWVp0pq6a/Brs1/wH2P8ALvJsz4h4D4h9tR5qGLoS5ZRls11jJbSjJferSi9mf1uafqFlqtlFqWmyrPBOoeORDlWU8gg069vrPTbSS/v5FhghUu7ucKqjqSa/CH9j79sm++EuoQ/D/wAeSNceHbmRVjlZstZk9x6p6jt2q3+15+2fffFS8n8AfD2V7bw9CxWWZThrwj+Se3evxB+G2Zf2n9TX8Lf2nTl/+S/u/PbU/v2P0nuGv9Vf7cf+9/D9Xv73tLd/+ffXn7afF7pqftbfth3nxUu5vAXgGR7fw/A5WWUHDXZX19E9B361+Z/xKm3eCL9R3UfzFbQul6Cn+I/A3ivxR8LPEXivSbVn07RoVkurg8Iu5gAue7HPSv1HOsrwmVcN4uhRSjBUp6vq3Fq7fVt/5I/gTNeI884x4kjmeYOVWtKSdop2hCPvWjFbQjFNv5ybbuz4Toqa0ge9uoLOIhWnkSNSxwAXIUEnsBnmv0+/aK/4Jg+O/gj8Hoviz4b1n/hJFt40l1G2ig2NDG4yZEIJ3KvfgHHNfxVTw9SpGUoK6W5+xZVw1mWZYfEYrA0XOFBKU2raJ31te72b0T0R+XRIAyegr+gr/glx+yZoHhjwBc/tKfFywiafUY2OmpeIGS3sVGWmIbgF+TkjhR71+YP7DX7Lt9+1H8ZLfR75WTw5pBS61ScDKsoIKwg+snf0Ffqd/wAFSv2o4Phf4Ltv2WvhmVtrjUbRBfvA2Ps1kOFhAHQyAc9ML9a9HL6UacHi6q0W3mz9Q8M8owuV4KvxpnEL0aN40Yv/AJeVXpp5LZPo7v7J+M/7U/jX4e/EL4/+JfFXwrsI9P0Ke5K26RKESTZw0oUcAOeQBX7J/wDBFU5+HPjYf9RWH/0SK/nqACgKOgr+hT/giouPh143b11SH/0SKWVzc8YpPrf8jHwexk8XxzSxVRJSn7WTSVknKMnoui7H7a0UUV9cf3Mf/9L+/iiiigAoorzX4wfGD4afAP4bav8AF74v6xbaD4d0K3e6vb26cJHHGgyevUnoAOSeBTjFyajFXYHpVFf55Xxt/wCDu34nj9vzS/G3wX0Qz/ArQ2ksLnSp1CXurQyMA15uPMTqBmJD2+914/uU/Y//AGxfgH+3P8ENL+P37OutxazoWpoNwHyzW02PmhmjPKSKeCD9RxXqY/JcXg4QqV4WUvw8n2ZnCrGTaTPqGiiivKNDy/4u/CLwd8afBtx4N8ZW4kilBMUoH7yGTs6HsR+tfzjftA/AXxl+z54yfw34jQzWkuXs7xF/dzR/0YdxX9OPiDxBofhPQ7vxN4mu4rDT7CF57m4ncJHFFGMszMcAAAZJNf53n/Bav/g5W1H4ufGjTvg5+xB5F14E8JX4l1HVriIE6xNE2GjhLDKQdRuGC55HHX9L8Os+x2ExP1eKcsO/iX8vmvPy6/ifg3jZ4NYDjDBPFUEqeYU17k/50vsT8n0lvF+V0fq0LhTUgnA4r4y/ZG/bJ+FX7YXw9HjDwBP5N/ahV1LTZeJrSUjoR3U/wsOK+sRdL/n/APXX9G0nCrBTpu6Z/mVmuSYvLcXUwOPpOnWg7SjJWaf9ap7NarQ+pf2dP2evGH7Q3i4aLogNvp1uQ15esMpEnoPVj2Ffrd+1V8GvDnw5/YU8X+APh/Z7IrewEjYGXlZGUs7nqSQM18C/sO/ti6b8F7o/Dnx6qpoN9LvS6RRvglbjL45ZT69vpX7wX1poHjjwxNYzbL3TdUt2jbaQySRSrg4PoQa/nnxXxGaTxLwmIjy4e3uW2lpu33Xbp87v+7Po58I8L4nhfFVMuqKeY1oTp1nJe9S5k0oxWtoPfmXxve1uVfwqKA0YHYiv6Ev+CZ37bVv490eP9mb4zXAn1GKJo9Murg5F3bgYMLk9XUcD+8tflR+1/wDsn+Nv2XfiNdadqFs8vh28md9Mv1GY3iJyEY9nXoQa+UrC/v8ASr+DVdJnktbq2dZYZomKvG6nIZSOhFfztQrVMJW1Xqu5+Z8PZ5mvBWeSc4NSg+WrTeinHqv1jL56ptP+s7xHZ/A//gnR8EfE/jTwra+RHqF5JdxWpbLTXcwwkSnrsGPwXNfyrfEDx54l+J/jXU/iB4wna51LVZ3nmdj3Y8KPQKOAPQV2vxX/AGhvjT8corC3+K2vz6vFpq7beNgERT3YqvBY92NeNVeOxirNRpq0Fsju8RePKWfTo4TLqPscFRXuU9F7z+KTSuvJK7srvqwr+ir/AIIuaVd2/wAH/FesSIRDd6uFjb+8Y41Dfka/BX4YfCzx78ZfGVr4C+G+nyajqV22Aqj5I17u7dFUdya/r+/ZV+Aenfs2fBLSPhbZyC4ntVaW7nAx5tzKd0jfTJwPYV1ZLQk63tbaI+w8AOHcXiM8ebcjVClGS5ujlJWUV3sm27baX3R9FUUUV9Uf2gf/0/7+KKKKACv4If8Ag8QT9vN9W8IsVk/4Z+WJedOL7f7Xyd32/HGNu3yc/LnPev73q84+Lnwj+G/x3+HGr/CT4uaRba74d123e1vbK6QPHJG4weD0I6gjkHkV6WUY9YLFQxDgpJdP8vMipDmi0f4W1frt/wAEhP8Agrt8af8AglD8b38V+Fo21zwPr7xp4i0B3KpcRoeJoTyEnjBO04+boeK+m/8AguZ/wQz+I3/BMD4kyfEn4Ww3fiD4Oa5KzWWolC76XKx4tbphwOuI3PDAc81/PdX7LCeFzHC3VpU5f18mjympU5eZ/t9fsk/tb/Av9tv4G6N+0F+z3rUWs6BrEQYFCPNt5cfPDMnVJEPDKf5V794h8Q6F4T0O78TeJ7uGw06wiae4uZ3EcUUaDLMzHAAA6k1/j9f8EiP+Cunxv/4JTfHAeKPCZfWfAuuyRx+IvD8jkRTxg486Lsk8YJ2n+Loa/V7/AILy/wDBxZd/t2eHl/Zc/Y6mu9I+Gl1DDNrWoSBoLvUpGAY2+OqQoeH/AL5GOlfneI4OxCxio0taT+12Xn59u53xxMeW73ND/g4M/wCDgzVP2yNV1H9jz9j3UZrD4ZWE7waxrEDlH110ONiEYItgQe/7z6V/I6AAMDgCgAKNo6Cv0j/4Jkf8Ex/j/wD8FOvj/Y/Cj4UWE9voFvNGdf18xk2um2pPzEt0MhGdiZyTX6FhsNhctwvLH3YR1bfXzfn/AEjhlKVSR77/AMEMf2Rf2v8A9qr9tPRrb9mNpdL0fSp438UaxKjNYW+nk/PHKOA7uoIjTrnniv7Lfj98CvG37PPjiXwj4uiLxNl7S7UYjuIuzD39R1Ffvt+wn+wd+z5/wTy+A+n/AAF/Z70pbKyt1V728cA3V/c4w0079WYnoOijgV7V8cPgb4G+Pngqfwb41twwYEwXCgebBJ2ZT/MdDXi5N4mTwmYWqRvhXpb7S/vL9V28z8c8YfBXC8XYL61hbQx9Ne7LpNfyT8v5ZfZfkfyXi5r9Lf2Jv24bn4S3UHwz+JkzT+HZ5AsNy5LNZlu3vHn8q+KPj38CPHf7PPjabwn4yt2ELMxtLsD91cRg8Mp6Z9R2rxAXAPANfuePyzL89y/2c7TpTV1JdOzT6Nf8Bn8C5FnGfcEZ79Yw96OJpPlnCS0a6xkusX/k4u9mf2IeK/B/w++Mngt9C8U2ltrWi6lEGCuA6OrDhlPY+hHNfztftw/8E4tN+AGlTfE34ba3HJo0koVdMvGC3CFv4Ym/5aAenBArvf2PP2+9R+CGmv4B+JSy6joEUbtaOp3TQOBkRj1Rjx7V8uftEftH+Nf2i/G7+KPEzmG0hyllZqT5cEef1Y9zX4LT8GMTisynhsY7UI6qot5J7Jefe+i87o/prxI8YuEM/wCF6WM+rc2ZSXKo6qVJrdykvih/Ktebsmnb4DkilicxyqVYdQRzXUaN4R1HVMSzjyIf7zDk/QV6dIlpJIJ5Y1Z16MRk1+qf7DX7Ed58ULmH4p/Fe2kt/D8Dq9paSDabwjncf+mf/oX0rKXg3lOR+0zDPMW6lCL92EVyufZN3vfyjbvdI/AeFsJnHFOPp5TktD97L4pP4YLrJu2iXnq3ok20es/8Erv2f/G/gf8AtD4ozj7Bo2pwiFIpY/3t2VOQ4J5VFzx659q/aKq9paWthax2VlGsUMShERBtVVHAAA6AVYr4LNcdTxWIdSjRjSpqyjGKslFber7t6tn+k3APB1LhjJaOUUqsqjjdylJ/FKTvJpfZV9orbzd2yiiivNPsj//U/v4ooooAKKKKAPO/iz8Jvh18c/h1q/wm+LGk2+ueHtdt3tb2yukDxyxuMEEHoR1B6g81/lm/8Fy/+CFfxG/4Jh/ENvid8J4bzxF8Htdmke1vliaRtHctxbXTAEBecRyHAbGDzX+q54j8R6B4Q0C88U+KbyHT9N0+F7i5ubhxHFFFGMszMcAADqa/zM/+Dhb/AIL06p+3f4rvP2Tf2Xr6S0+Eui3DR397GcHXriM8N7W6EfIP4jz6V9fwfPGLFctD+H9q+3/D9jmxKjy+9ufyq0UAY4or9ZPMP0v/AOCX3/BLf9oT/gqP8d4Phf8ACa0lsvDtjLG3iDxDJGTa6bbse56NKwB8uPOSfav9ZX9hD9hT4Df8E8v2fdK/Z7+AenLbWNkoe8vHUfab+6I+eeZhyWY9B0UcCv8AKC/4JUf8FV/j1/wSu+PCfEf4aSHUvC+rPHH4i0CViIL63U43D+7MgJKN+B4r/Wd/Yy/bM+BH7eHwH0j9oL9n7Vo9S0fU4182LI8+0nx88MydVdTxz16ivzbjZ43nipfwOlu/n59uh6GE5Labn1ZRRRXwB2Hi3x3+BPgj9oHwJceCPGcIIYFre4UfvYJezKf5jvX8vH7QvwB8d/s4eOZfB/jKEtDIS9neKP3VxFngqfX1Hav6gvj58e/An7PHgK48ceN7gLtBW2twf3txL2RR/M9hX8rX7Qn7Rnjz9o3x5L418ZyhUXKWlqh/dW8WeFUevqe5r988G4Zu3Ut/ueu/839z/wBu6fM/jj6UdPhlwo8y/wCFTS3Lb+H/ANPf/bPtf9unlQuAec077SPWueFznrTxc1+/eyP4udE/XX9g79h24+K8tv8AF74qQvD4fgkDWdo64N4V53H/AKZg/wDfX0r+ge0tLWwtY7KyjWKGJQiIgwqqOAAOwFfzc/sIft2XnwO1KH4ZfEeVp/Ct5L8k7Es9k7YHH/TMnkjt1r+kDTNT07WtOg1fSJ0ubW5QSRSxncjowyCCOoNfyr4q0s3jmreYfwtfZW+Hl/8Akv5r6/Kx/or9HSXDX+rqhkqtidPb81vac/d/3P5Lab/auXqKKK/Lz+gwooooA//V/v4ooooAKxfEniTQPB2gXnirxVew6dpunQvcXV1cOI4oYoxlndjgAADJJrar/PV/4Ozf+CiX7Xlr8Yrf9hCx0u98GfDaS0iv5L1GZT4iZs5HmKceTERgx9d3LcYr08py2eOxMaEXbu/L9SKk1CN2fIX/AAcD/wDBfrXv27vFF1+yx+ylqFzpnwl0id476+icxSa/MhwGOMEWykHYv8fU9hX8qoAAwOAKUAAYFfqj/wAEnf8AglH8cv8Agqp8ek+Hvw/R9M8I6NJFJ4k19lzHZW7k/ImeGmcAhF/E8V+xUKGFyzC2Xuwju/1fds8tuVSXmM/4JQ/8Epfjr/wVU+Pcfw5+HiPpXhPSXjl8ReIZEJhsoGP3E7PO4B2J+J4r7o/4Li/8EC/H3/BL/UYPjH8Hp7vxV8JNQMcL3sy7rnTLkgDbcFRjZI3KPwATg9q/0rP2MP2MPgL+wZ8BdI/Z5/Z60hNM0bS4x5kpANxeTn7887gAvI55JPToOK9y+J/ww8AfGfwBqvwu+KOlW+t6Brdu9re2V0gkilicYIIP6HqDXwVbjSu8YqlNfulpy9139e3Y7VhY8tnuf4VdfqD/AMErP+Cpvx1/4Jb/ALQNn8S/h7cS6j4VvpUj8QeH2kIt723zgsB0WVRyjetffn/BeH/ghJ4x/wCCZvjlvjP8EYbvXPg5rk7GKcqZJdGmc5FvOwH+rOcRyH0wea/nCr9ApVcNmOGuvehL+vk0cLUqcvM/24v2Mf20PgH+3l8CdK/aA/Z61iPVNI1FF86LI+0Wc+PnhnTqjqeOevUcV3nx/wD2gfh/+zp4CuPHHjq5CBQVtrZT+9uJeyIP5noBX+Ud/wAEL/25f2t/2NP2u7A/s7xPrPhzW5Yk8T6LOzCyls1PzTE9I5UXJRupPHIr+p39o79pXx/+0v8AEGbxv42l2RrlLO0QnyreLPCqPX1PUmvM4b8KauYZg5VJWwkdW/tP+6vPu+i8z8r8VvF3D8L4P6vhbTx017sekF/PL/21fafkjV/aF/aN8e/tHePZ/GvjOc+XuK2lopPlW8WeFUevqe9eFfasDmsL7UB1r9kv+Cen/BPuX4mPa/Gv41Wrw6HE4k0/T5FwbsjkO4PPl56D+L6V/QWbZjlnDmW+1q2hSgrRit2+kYrq/wDh2fw9kXDmdcZ526NK9SvUfNOctorrKT6JdF6JIh/Yq/4JyXXxq8MSfEn4wtPpukXkLLp1vH8s0hYcTHPRR1Ud6+KP2nP2bvHX7MXj+Twl4pUz2U+Xsb5QRHcRZ/Rh/Etf2D2trbWNtHZ2caxRRKEREGFVRwAAOgFeSfHL4G+Af2gvAVz4A8f2wmt5huimUDzYJB0dD2I/Wv5/yrxgx0c3niMcr4abtyL7C6OPdrr/ADeWlv604g+jdlFTh6ngsrfLjaauqj/5eS6xn2i/s2+Hz1v/ABi+d3r9O/2DP28r/wCBGpRfDT4lSvdeFL2UBJmYs9izcZX1j7kduor48/ah/Zr8bfsu/EWTwZ4pHn2c4MtheqMJcQ5IB9mHRhXzd9oAFf0Djsuy3iHLeSdqlGorpr8Gn0a/4DW6P5DyrMc74Mzz2tG9LE0XaUXs11jJdYv/ACaezP7pdK1bTNd02DWdGnS6tLlBJFLEwZHRuQQR1FaFfix/wSG1n47X3hPVLHXUL+BoT/oEtxneLjPzLD6pjr2B6d6/aev424nyP+yMyrZf7RT5Huvv17NdV0Z/pTwPxP8A6w5Lh82dGVJ1FrGXdaNp9YveL6oKKKK8A+sP/9b+/iiiigAr4E/4KI/8E4f2b/8AgpZ8DLr4M/H7SklljV5NJ1aJQLzTblhxLC/Uc43L0YcGvvuitKNadKaqU3aS2Ymk1Zn+Vt8Nf+DZH9vDxJ/wUEn/AGQfGti+m+DdMkF5eeNlTNjLpRb5Xgz964cfL5XVWyTx1/0lv2L/ANif9nv9gn4H6b8Bv2dNDh0jSrFF8+YKDcXs4GGmuJOskjHPJ6dBxX1lgZz3pa9bNc+xWPjGFV2iui6vu/60M6dKMNgooorxTU4T4m/DHwB8ZfAeqfDH4paRba7oGtQPbXtjeRiWGaJxghlII/wr/M//AOCw/wDwbq/En9kb9o7Ttc/ZhQ6h8KvGl4VgknkUyaJIxy0UmTueMDmNgCexr/SN/aA/aA+Hf7N3w6u/iL8RbtYYIFIggBHm3Ev8Mca9yfyA5NfyB/tTftZfEX9qv4gSeL/GEv2exgLJYWEZPlW8WeOO7H+Ju9fsXhRwnmOZYl4hNwwi+Jv7T/lj5930Xnofj3iv4nYThrCPD0bTxs17kekV/PPy7L7T8rn58fs1fs1/Df8AZg8Dp4U8CwB7qYK19fuAZrmQDkseyjsvQV9GfaWrAWcjvUnnt6mv62w+Cp0KapUo2itkfwFmOLxWPxNTGYyo51Zu8pN6t/1stktEftx/wTa/YHsfi6sHx2+L8aT6BFJnT7DcGFy6dWlAzhQf4T171/SBaWltY20dlZRrFDEoREQYVVHAAA6AV/Hv+xJ+3N4y/ZO8Wi0ui+oeE9QkX7dYk5KdjLFzw49Ohr+tj4c/Efwb8WPB1l498A30eoaZqEYkiljOevVWHZh0IPIr+TPGXLs6p5p9Zxz5sO9KbXwxX8rXSXd/a3Wmi/t76P8AmHD08l+qZZDkxUdaydueT/mT0vDsl8Oz1d33FFFFfjR/QB4x8dPgN8O/2hvA1x4F+Idms8MgJhmAxLbydnjbqCP1r8RPg3/wSV8Z/wDC9r7T/izMreDNIlEkM8TYfUVPKpgcoAPv+/Ar+iKivrsh43zbKMLWweCq2hUXXXlf80eza0/HdJnwPFHhpkHEGOw+YZlQ5qlJ7rTnXSM/5op6/hs2jD8NeGdA8HaHbeGvC9nFYWFmgjhghUIiKOwArcoor5Oc5Tk5Sd292fd06cacVCCtFaJLZLsgoooqSz//1/7+KKKKACiiigAooooAK8J/aK/aG+H37M/wzvPiX8QrgRwwDbb26kebczH7saDuSep7DmvdW3bTt69s1/Hj/wAFS9c/acu/2hbiw+Psf2fTYWf+w47bd9ha2zw0ZPWQj7+eQfav0Dw44PpcRZssLXqqFOK5pK9pSS6RXfu+i1PzvxN4zrcN5PLF4ei51JPli7XjFv7U327Lq9Dwr9qv9rn4lftZ+Pv+Ev8AG8i29na7ksNPiJ8m2iJ7Ak5Y/wATHrXy/wDacDJNYfn45PFftR/wTX/4Ju6j8aryz+OXxttpLXwtbSrJY2Mi7W1Bl53MD0hB/wC+vpX9jZpmGU8LZT7WolTo01aMVu30jFdW/wDNvqz+HcryTOeLs4dODdSvUd5Tlsl1lJ9Eui9Elsix/wAE8/8Agmpc/Hq3HxZ+OcFxY+F8f6Daj93Jen++eMiMdum76V88ft4fsM+LP2RvGH9p6MJtS8G6gxNnfMMmFj/yxmIAAYfwnuPev7DbGxs9Ms4tP0+JYIIFCRxoNqqq8AADoBXL+P8AwB4R+KHhG+8C+OrGPUNM1CMxTQyjIIPcehHUEdDX8x4PxqzWOdvH11fDS0dJbKPRp/zrdvrtta39V47wCyWeQRy7D6YqOqrPeUuqkv5Hsl9ndXd7/wACwuGHevvT9iL9u7x1+yP4n+wMDqXhPUJVN/YMTlOxlh/uuB+BqH9vD9hXxl+yD4v/ALS03zNT8HajIfsV8VyYSf8AljNjgMOx/iHvX59C6bHav6fjDKeJsqurVcPVX9ecZRfzTP5LdLOeE850vRxNJ/15SjJfJo/v3+GnxJ8HfF3wRp/xC8BXiX2l6lEJYZEPr1Vh2YdCDyDXd1/PD/wRa8KftJW8moeKfPNp8N7kMBBdKT9ouR/Hbgn5QP4m6Gv6Hq/iHjXh6lkmb1svoVlUjF6Nbq/2ZdOZdbfhsf6AcC8SVs9yahmWIoOlOS1T2dvtR68r3V/x3ZRRRXyh9eFFFFABRRRQB//Q/v4ooooAKKKKACiiigAr5u/aj/Zg+HX7VvwyuPh14+i2N/rLO8jA861mHR0Pp2YdCOK+kaK6sDjq+DxEMVhZuFSDumt00cmOwOHxuHnhcVBTpzVpJ7NM/nF/ZW/4I2eINL+MV9rH7Rk0Vz4d0G5H2GCA8anjlXfuiDjcvJJ46V/RfY2FlpdlFpumxJBbwII444wFVEUYAAHAAFW6K9/injHM+Ia8a+Y1L8qsorSK7tLu3q3+iSPn+E+C8q4dw86GW07czvJvWT7Jvstkv1bYUUUV8sfVnEfEb4c+Dvix4Mv/AAB49sY9Q0vUYjFNDIMjB7j0YdQRyDX4HeH/APgiNJB+0LKNe1vzvhzARcxBeLyUEn/R27ADu46jtmv6KKK+r4d42zjI6Vajl1ZxjUVmt7P+aN9pW0uv0R8lxJwNk2e1aFfMqCnKk7p7XX8srbxvrZ/qzn/CnhXw/wCCPDll4R8K2sdlp2nQrBbwRDCoiDAAFdBRRXy05ynJzm7t6tvqfVwhGEVCCsloktkgoooqSgooooAKKKKAP//R/v4ooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKAP/Z"), + contactLink = Just (either error id $ strDecode "simplex:/contact/#/?v=1-2&smp=smp%3A%2F%2Fu2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU%3D%40smp4.simplex.im%2FShQuD-rPokbDvkyotKx5NwM8P3oUXHxA%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEA6fSx1k9zrOmF0BJpCaTarZvnZpMTAVQhd3RkDQ35KT0%253D%26srv%3Do5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"), + preferences = Nothing + } + +timeItToView :: String -> CM' a -> CM' a +timeItToView s action = do + t1 <- liftIO getCurrentTime + a <- action + t2 <- liftIO getCurrentTime + let diff = diffToMilliseconds $ diffUTCTime t2 t1 + toView' $ CRTimedAction s diff + pure a diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs new file mode 100644 index 0000000000..2df77a074e --- /dev/null +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -0,0 +1,2887 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + +module Simplex.Chat.Library.Subscriber where + +import Control.Logger.Simple +import Control.Monad +import Control.Monad.Except +import Control.Monad.IO.Unlift +import Control.Monad.Reader +import qualified Data.Aeson as J +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as LB +import Data.Either (lefts, partitionEithers, rights) +import Data.Functor (($>)) +import Data.Int (Int64) +import Data.List (foldl', partition) +import Data.List.NonEmpty (NonEmpty (..), (<|)) +import qualified Data.List.NonEmpty as L +import qualified Data.Map.Strict as M +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeLatin1) +import Data.Time (addUTCTime) +import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as V4 +import Data.Word (Word32) +import Simplex.Chat.Call +import Simplex.Chat.Controller +import Simplex.Chat.Messages +import Simplex.Chat.Messages.CIContent +import Simplex.Chat.Messages.CIContent.Events +import Simplex.Chat.ProfileGenerator (generateRandomProfile) +import Simplex.Chat.Protocol +import Simplex.Chat.Library.Internal +import Simplex.Chat.Store +import Simplex.Chat.Store.Connections +import Simplex.Chat.Store.Direct +import Simplex.Chat.Store.Files +import Simplex.Chat.Store.Groups +import Simplex.Chat.Store.Messages +import Simplex.Chat.Store.Profiles +import Simplex.Chat.Store.Shared +import Simplex.Chat.Types +import Simplex.Chat.Types.Preferences +import Simplex.Chat.Types.Shared +import Simplex.Chat.Util (shuffle) +import Simplex.FileTransfer.Description (ValidFileDescription) +import qualified Simplex.FileTransfer.Description as FD +import Simplex.FileTransfer.Protocol (FilePartyI) +import qualified Simplex.FileTransfer.Transport as XFTP +import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId) +import Simplex.Messaging.Agent as Agent +import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..)) +import Simplex.Messaging.Agent.Protocol +import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..)) +import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import Simplex.Messaging.Client (ProxyClientError (..)) +import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.File (CryptoFile (..)) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) +import qualified Simplex.Messaging.Crypto.Ratchet as CR +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Protocol (ErrorType (..), MsgFlags (..)) +import qualified Simplex.Messaging.Protocol as SMP +import qualified Simplex.Messaging.TMap as TM +import Simplex.Messaging.Transport (TransportError (..)) +import Simplex.Messaging.Util +import Simplex.Messaging.Version +import qualified System.FilePath as FP +import Text.Read (readMaybe) +import UnliftIO.Directory +import UnliftIO.STM + +smallGroupsRcptsMemLimit :: Int +smallGroupsRcptsMemLimit = 20 + +processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM () +processAgentMessage _ connId (DEL_RCVQ srv qId err_) = + toView $ CRAgentRcvQueueDeleted (AgentConnId connId) srv (AgentQueueId qId) err_ +processAgentMessage _ connId DEL_CONN = + toView $ CRAgentConnDeleted (AgentConnId connId) +processAgentMessage _ "" (ERR e) = + toView $ CRChatError Nothing $ ChatErrorAgent e Nothing +processAgentMessage corrId connId msg = do + lockEntity <- critical (withStore (`getChatLockEntity` AgentConnId connId)) + withEntityLock "processAgentMessage" lockEntity $ do + vr <- chatVersionRange + -- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here + critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case + Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user)) + _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) + +-- CRITICAL error will be shown to the user as alert with restart button in Android/desktop apps. +-- SEDBBusyError will only be thrown on IO exceptions or SQLError during DB queries, +-- e.g. when database is locked or busy for longer than 3s. +-- In this case there is no better mitigation than showing alert: +-- - without ACK the message delivery will be stuck, +-- - with ACK message will be lost, as it failed to be saved. +-- Full app restart is likely to resolve database condition and the message will be received and processed again. +critical :: CM a -> CM a +critical a = + a `catchChatError` \case + ChatErrorStore SEDBBusyError {message} -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing + e -> throwError e + +processAgentMessageNoConn :: AEvent 'AENone -> CM () +processAgentMessageNoConn = \case + CONNECT p h -> hostEvent $ CRHostConnected p h + DISCONNECT p h -> hostEvent $ CRHostDisconnected p h + DOWN srv conns -> serverEvent srv conns NSDisconnected CRContactsDisconnected + UP srv conns -> serverEvent srv conns NSConnected CRContactsSubscribed + SUSPENDED -> toView CRChatSuspended + DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId + ERRS cErrs -> errsEvent cErrs + where + hostEvent :: ChatResponse -> CM () + hostEvent = whenM (asks $ hostEvents . config) . toView + serverEvent srv conns nsStatus event = do + chatModifyVar connNetworkStatuses $ \m -> foldl' (\m' cId -> M.insert cId nsStatus m') m connIds + ifM (asks $ coreApi . config) (notifyAPI connIds) notifyCLI + where + connIds = map AgentConnId conns + notifyAPI = toView . CRNetworkStatus nsStatus + notifyCLI = do + cs <- withStore' (`getConnectionsContacts` conns) + toView $ event srv cs + errsEvent :: [(ConnId, AgentErrorType)] -> CM () + errsEvent cErrs = do + vr <- chatVersionRange + errs <- lift $ rights <$> withStoreBatch' (\db -> map (getChatErr vr db) cErrs) + toView $ CRChatErrors Nothing errs + where + getChatErr :: VersionRangeChat -> DB.Connection -> (ConnId, AgentErrorType) -> IO ChatError + getChatErr vr db (connId, err) = + let acId = AgentConnId connId + in ChatErrorAgent err <$> (getUserByAConnId db acId $>>= \user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)) + +processAgentMsgSndFile :: ACorrId -> SndFileId -> AEvent 'AESndFile -> CM () +processAgentMsgSndFile _corrId aFileId msg = do + (cRef_, fileId) <- withStore (`getXFTPSndFileDBIds` AgentSndFileId aFileId) + withEntityLock_ cRef_ . withFileLock "processAgentMsgSndFile" fileId $ + withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case + Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user)) + _ -> do + lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) + throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId + where + withEntityLock_ :: Maybe ChatRef -> CM a -> CM a + withEntityLock_ cRef_ = case cRef_ of + Just (ChatRef CTDirect contactId) -> withContactLock "processAgentMsgSndFile" contactId + Just (ChatRef CTGroup groupId) -> withGroupLock "processAgentMsgSndFile" groupId + _ -> id + process :: User -> FileTransferId -> CM () + process user fileId = do + (ft@FileTransferMeta {xftpRedirectFor, cancelled}, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId + vr <- chatVersionRange + unless cancelled $ case msg of + SFPROG sndProgress sndTotal -> do + let status = CIFSSndTransfer {sndProgress, sndTotal} + ci <- withStore $ \db -> do + liftIO $ updateCIFileStatus db user fileId status + lookupChatItemByFileId db vr user fileId + toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal + SFDONE sndDescr rfds -> do + withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr) + ci <- withStore $ \db -> lookupChatItemByFileId db vr user fileId + case ci of + Nothing -> do + lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) + withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText rfds) + case rfds of + [] -> sendFileError (FileErrOther "no receiver descriptions") "no receiver descriptions" vr ft + rfd : _ -> case [fd | fd@(FD.ValidFileDescription FD.FileDescription {chunks = [_]}) <- rfds] of + [] -> case xftpRedirectFor of + Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CRSndFileRedirectStartXFTP user ft + Just _ -> sendFileError (FileErrOther "chaining redirects") "Prohibit chaining redirects" vr ft + rfds' -> do + -- we have 1 chunk - use it as URI whether it is redirect or not + ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor + toView $ CRSndStandaloneFileComplete user ft' $ map (decodeLatin1 . strEncode . FD.fileDescriptionURI) rfds' + Just (AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) -> + case (msgId_, itemDeleted) of + (Just sharedMsgId, Nothing) -> do + when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send" + -- TODO either update database status or move to SFPROG + toView $ CRSndFileProgressXFTP user ci ft 1 1 + case (rfds, sfts, d, cInfo) of + (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do + withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) + conn@Connection {connId} <- liftEither $ contactSendConn_ ct + sendFileDescriptions (ConnectionId connId) ((conn, sft, fileDescrText rfd) :| []) sharedMsgId >>= \case + Just rs -> case L.last rs of + Right ([msgDeliveryId], _) -> + withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId + Right (deliveryIds, _) -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError $ "SFDONE, sendFileDescriptions: expected 1 delivery id, got " <> show (length deliveryIds) + Left e -> toView $ CRChatError (Just user) e + Nothing -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError "SFDONE, sendFileDescriptions: expected at least 1 result" + lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) + (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do + ms <- withStore' $ \db -> getGroupMembers db vr user g + let rfdsMemberFTs = zipWith (\rfd (conn, sft) -> (conn, sft, fileDescrText rfd)) rfds (memberFTs ms) + extraRFDs = drop (length rfdsMemberFTs) rfds + withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) + forM_ (L.nonEmpty rfdsMemberFTs) $ \rfdsMemberFTs' -> + sendFileDescriptions (GroupId groupId) rfdsMemberFTs' sharedMsgId + ci' <- withStore $ \db -> do + liftIO $ updateCIFileStatus db user fileId CIFSSndComplete + getChatItemByFileId db vr user fileId + lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) + toView $ CRSndFileCompleteXFTP user ci' ft + where + memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)] + memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts') + where + mConns' = mapMaybe useMember ms + sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts + -- Should match memberSendAction logic + useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}} + | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) && not (connInactive conn) = + Just (groupMemberId, conn) + | otherwise = Nothing + useMember _ = Nothing + _ -> pure () + _ -> pure () -- TODO error? + SFWARN e -> do + let err = tshow e + logWarn $ "Sent file warning: " <> err + ci <- withStore $ \db -> do + liftIO $ updateCIFileStatus db user fileId (CIFSSndWarning $ agentFileError e) + lookupChatItemByFileId db vr user fileId + toView $ CRSndFileWarning user ci ft err + SFERR e -> + sendFileError (agentFileError e) (tshow e) vr ft + where + fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text + fileDescrText = safeDecodeUtf8 . strEncode + sendFileDescriptions :: ConnOrGroupId -> NonEmpty (Connection, SndFileTransfer, RcvFileDescrText) -> SharedMsgId -> CM (Maybe (NonEmpty (Either ChatError ([Int64], PQEncryption)))) + sendFileDescriptions connOrGroupId connsTransfersDescrs sharedMsgId = do + lift . void . withStoreBatch' $ \db -> L.map (\(_, sft, rfdText) -> updateSndFTDescrXFTP db user sft rfdText) connsTransfersDescrs + partSize <- asks $ xftpDescrPartSize . config + let connsIdsEvts = connDescrEvents partSize + sndMsgs_ <- lift $ createSndMessages $ L.map snd connsIdsEvts + let (errs, msgReqs) = partitionEithers . L.toList $ L.zipWith (fmap . toMsgReq) connsIdsEvts sndMsgs_ + delivered <- mapM deliverMessages (L.nonEmpty msgReqs) + let errs' = errs <> maybe [] (lefts . L.toList) delivered + unless (null errs') $ toView $ CRChatErrors (Just user) errs' + pure delivered + where + connDescrEvents :: Int -> NonEmpty (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) + connDescrEvents partSize = L.fromList $ concatMap splitText (L.toList connsTransfersDescrs) + where + splitText :: (Connection, SndFileTransfer, RcvFileDescrText) -> [(Connection, (ConnOrGroupId, ChatMsgEvent 'Json))] + splitText (conn, _, rfdText) = + map (\fileDescr -> (conn, (connOrGroupId, XMsgFileDescr {msgId = sharedMsgId, fileDescr}))) (L.toList $ splitFileDescr partSize rfdText) + toMsgReq :: (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) -> SndMessage -> ChatMsgReq + toMsgReq (conn, _) SndMessage {msgId, msgBody} = + (conn, MsgFlags {notification = hasNotification XMsgFileDescr_}, msgBody, [msgId]) + sendFileError :: FileError -> Text -> VersionRangeChat -> FileTransferMeta -> CM () + sendFileError ferr err vr ft = do + logError $ "Sent file error: " <> err + ci <- withStore $ \db -> do + liftIO $ updateFileCancelled db user fileId (CIFSSndError ferr) + lookupChatItemByFileId db vr user fileId + lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) + toView $ CRSndFileError user ci ft err + +agentFileError :: AgentErrorType -> FileError +agentFileError = \case + XFTP _ XFTP.AUTH -> FileErrAuth + FILE NO_FILE -> FileErrNoFile + BROKER _ e -> brokerError FileErrRelay e + e -> FileErrOther $ tshow e + where + brokerError srvErr = \case + HOST -> srvErr SrvErrHost + SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion + e -> srvErr . SrvErrOther $ tshow e + +splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr +splitFileDescr partSize rfdText = splitParts 1 rfdText + where + splitParts partNo remText = + let (part, rest) = T.splitAt partSize remText + complete = T.null rest + fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete} + in if complete + then fileDescr :| [] + else fileDescr <| splitParts (partNo + 1) rest + +processAgentMsgRcvFile :: ACorrId -> RcvFileId -> AEvent 'AERcvFile -> CM () +processAgentMsgRcvFile _corrId aFileId msg = do + (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId) + withEntityLock_ cRef_ . withFileLock "processAgentMsgRcvFile" fileId $ + withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case + Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user)) + _ -> do + lift $ withAgent' (`xftpDeleteRcvFile` aFileId) + throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId + where + withEntityLock_ :: Maybe ChatRef -> CM a -> CM a + withEntityLock_ cRef_ = case cRef_ of + Just (ChatRef CTDirect contactId) -> withContactLock "processAgentMsgRcvFile" contactId + Just (ChatRef CTGroup groupId) -> withGroupLock "processAgentMsgRcvFile" groupId + _ -> id + process :: User -> FileTransferId -> CM () + process user fileId = do + ft <- withStore $ \db -> getRcvFileTransfer db user fileId + vr <- chatVersionRange + unless (rcvFileCompleteOrCancelled ft) $ case msg of + RFPROG rcvProgress rcvTotal -> do + let status = CIFSRcvTransfer {rcvProgress, rcvTotal} + ci <- withStore $ \db -> do + liftIO $ updateCIFileStatus db user fileId status + lookupChatItemByFileId db vr user fileId + toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal ft + RFDONE xftpPath -> + case liveRcvFileTransferPath ft of + Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file" + Just targetPath -> do + fsTargetPath <- lift $ toFSFilePath targetPath + renameFile xftpPath fsTargetPath + ci_ <- withStore $ \db -> do + liftIO $ do + updateRcvFileStatus db fileId FSComplete + updateCIFileStatus db user fileId CIFSRcvComplete + lookupChatItemByFileId db vr user fileId + agentXFTPDeleteRcvFile aFileId fileId + toView $ maybe (CRRcvStandaloneFileComplete user fsTargetPath ft) (CRRcvFileComplete user) ci_ + RFWARN e -> do + ci <- withStore $ \db -> do + liftIO $ updateCIFileStatus db user fileId (CIFSRcvWarning $ agentFileError e) + lookupChatItemByFileId db vr user fileId + toView $ CRRcvFileWarning user ci e ft + RFERR e + | e == FILE NOT_APPROVED -> do + aci_ <- resetRcvCIFileStatus user fileId CIFSRcvAborted + forM_ aci_ cleanupACIFile + agentXFTPDeleteRcvFile aFileId fileId + forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci + | otherwise -> do + aci_ <- withStore $ \db -> do + liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ agentFileError e) + lookupChatItemByFileId db vr user fileId + forM_ aci_ cleanupACIFile + agentXFTPDeleteRcvFile aFileId fileId + toView $ CRRcvFileError user aci_ e ft + +processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM () +processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do + -- Missing connection/entity errors here will be sent to the view but not shown as CRITICAL alert, + -- as in this case no need to ACK message - we can't process messages for this connection anyway. + -- SEDBException will be re-trown as CRITICAL as it is likely to indicate a temporary database condition + -- that will be resolved with app restart. + entity <- critical $ withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus + case agentMessage of + END -> case entity of + RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct + _ -> toView $ CRSubscriptionEnd user entity + MSGNTF msgId msgTs_ -> toView $ CRNtfMessage user entity $ ntfMsgAckInfo msgId msgTs_ + _ -> case entity of + RcvDirectMsgConnection conn contact_ -> + processDirectMessage agentMessage entity conn contact_ + RcvGroupMsgConnection conn gInfo m -> + processGroupMessage agentMessage entity conn gInfo m + RcvFileConnection conn ft -> + processRcvFileConn agentMessage entity conn ft + SndFileConnection conn ft -> + processSndFileConn agentMessage entity conn ft + UserContactConnection conn uc -> + processUserContactRequest agentMessage entity conn uc + where + updateConnStatus :: ConnectionEntity -> CM ConnectionEntity + updateConnStatus acEntity = case agentMsgConnStatus agentMessage of + Just connStatus -> do + let conn = (entityConnection acEntity) {connStatus} + withStore' $ \db -> updateConnectionStatus db conn connStatus + pure $ updateEntityConnStatus acEntity connStatus + Nothing -> pure acEntity + + agentMsgConnStatus :: AEvent e -> Maybe ConnStatus + agentMsgConnStatus = \case + JOINED True -> Just ConnSndReady + CONF {} -> Just ConnRequested + INFO {} -> Just ConnSndReady + CON _ -> Just ConnReady + _ -> Nothing + + processCONFpqSupport :: Connection -> PQSupport -> CM Connection + processCONFpqSupport conn@Connection {connId, pqSupport = pq} pq' + | pq == PQSupportOn && pq' == PQSupportOff = do + let pqEnc' = CR.pqSupportToEnc pq' + withStore' $ \db -> updateConnSupportPQ db connId pq' pqEnc' + pure (conn {pqSupport = pq', pqEncryption = pqEnc'} :: Connection) + | pq /= pq' = do + messageWarning "processCONFpqSupport: unexpected pqSupport change" + pure conn + | otherwise = pure conn + + processINFOpqSupport :: Connection -> PQSupport -> CM () + processINFOpqSupport Connection {pqSupport = pq} pq' = + when (pq /= pq') $ messageWarning "processINFOpqSupport: unexpected pqSupport change" + + processDirectMessage :: AEvent e -> ConnectionEntity -> Connection -> Maybe Contact -> CM () + processDirectMessage agentMsg connEntity conn@Connection {connId, connChatVersion, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case + Nothing -> case agentMsg of + CONF confId pqSupport _ connInfo -> do + conn' <- processCONFpqSupport conn pqSupport + -- [incognito] send saved profile + (conn'', inGroup) <- saveConnInfo conn' connInfo + incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) + let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing inGroup + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + INFO pqSupport connInfo -> do + processINFOpqSupport conn pqSupport + void $ saveConnInfo conn connInfo + MSG meta _msgFlags _msgBody -> + -- We are not saving message (saveDirectRcvMSG) as contact hasn't been created yet, + -- chat item is also not created here + withAckMessage' "new contact msg" agentConnId meta $ pure () + SENT msgId _proxy -> do + void $ continueSending connEntity conn + sentMsgDeliveryEvent conn msgId + OK -> + -- [async agent commands] continuation on receiving OK + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + JOINED _ -> + -- [async agent commands] continuation on receiving JOINED + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + QCONT -> + void $ continueSending connEntity conn + MWARN _ err -> + processConnMWARN connEntity conn err + MERR _ err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + processConnMERR connEntity conn err + MERRS _ err -> do + -- error cannot be AUTH error here + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + ERR err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + -- TODO add debugging output + _ -> pure () + Just ct@Contact {contactId} -> case agentMsg of + INV (ACR _ cReq) -> + -- [async agent commands] XGrpMemIntro continuation on receiving INV + withCompletedCommand conn agentMsg $ \_ -> + case cReq of + directConnReq@(CRInvitationUri _ _) -> do + contData <- withStore' $ \db -> do + setConnConnReqInv db user connId cReq + getXGrpMemIntroContDirect db user ct + forM_ contData $ \(hostConnId, xGrpMemIntroCont) -> + sendXGrpMemInv hostConnId (Just directConnReq) xGrpMemIntroCont + CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" + MSG msgMeta _msgFlags msgBody -> do + tags <- newTVarIO [] + withAckMessage "contact msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do + let MsgMeta {pqEncryption} = msgMeta + (ct', conn') <- updateContactPQRcv user ct conn pqEncryption + checkIntegrityCreateItem (CDDirectRcv ct') msgMeta `catchChatError` \_ -> pure () + forM_ aChatMsgs $ \case + Right (ACMsg _ chatMsg) -> + processEvent ct' conn' tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e + Left e -> do + atomically $ modifyTVar' tags ("error" :) + logInfo $ "contact msg=error " <> eInfo <> " " <> tshow e + toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) + checkSendRcpt ct' $ rights aChatMsgs -- not crucial to use ct'' from processEvent + where + aChatMsgs = parseChatMessages msgBody + processEvent :: Contact -> Connection -> TVar [Text] -> Text -> MsgEncodingI e => ChatMessage e -> CM () + processEvent ct' conn' tags eInfo chatMsg@ChatMessage {chatMsgEvent} = do + let tag = toCMEventTag chatMsgEvent + atomically $ modifyTVar' tags (tshow tag :) + logInfo $ "contact msg=" <> tshow tag <> " " <> eInfo + (conn'', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn' msgMeta msgBody chatMsg + let ct'' = ct' {activeConn = Just conn''} :: Contact + case event of + XMsgNew mc -> newContentMessage ct'' mc msg msgMeta + XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr + XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct'' sharedMsgId mContent msg msgMeta ttl live + XMsgDel sharedMsgId _ -> messageDelete ct'' sharedMsgId msg msgMeta + XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct'' sharedMsgId reaction add msg msgMeta + -- TODO discontinue XFile + XFile fInv -> processFileInvitation' ct'' fInv msg msgMeta + XFileCancel sharedMsgId -> xFileCancel ct'' sharedMsgId + XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct'' sharedMsgId fileConnReq_ fName + XInfo p -> xInfo ct'' p + XDirectDel -> xDirectDel ct'' msg msgMeta + XGrpInv gInv -> processGroupInvitation ct'' gInv msg msgMeta + XInfoProbe probe -> xInfoProbe (COMContact ct'') probe + XInfoProbeCheck probeHash -> xInfoProbeCheck (COMContact ct'') probeHash + XInfoProbeOk probe -> xInfoProbeOk (COMContact ct'') probe + XCallInv callId invitation -> xCallInv ct'' callId invitation msg msgMeta + XCallOffer callId offer -> xCallOffer ct'' callId offer msg + XCallAnswer callId answer -> xCallAnswer ct'' callId answer msg + XCallExtra callId extraInfo -> xCallExtra ct'' callId extraInfo msg + XCallEnd callId -> xCallEnd ct'' callId msg + BFileChunk sharedMsgId chunk -> bFileChunk ct'' sharedMsgId chunk msgMeta + _ -> messageError $ "unsupported message: " <> T.pack (show event) + checkSendRcpt :: Contact -> [AChatMessage] -> CM Bool + checkSendRcpt ct' aMsgs = do + let Contact {chatSettings = ChatSettings {sendRcpts}} = ct' + pure $ fromMaybe (sendRcptsContacts user) sendRcpts && any aChatMsgHasReceipt aMsgs + where + aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) = + hasDeliveryReceipt (toCMEventTag chatMsgEvent) + RCVD msgMeta msgRcpt -> + withAckMessage' "contact rcvd" agentConnId msgMeta $ + directMsgReceived ct conn msgMeta msgRcpt + CONF confId pqSupport _ connInfo -> do + conn' <- processCONFpqSupport conn pqSupport + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn' connInfo + conn'' <- updatePeerChatVRange conn' chatVRange + case chatMsgEvent of + -- confirming direct connection with a member + XGrpMemInfo _memId _memProfile -> do + -- TODO check member ID + -- TODO update member profile + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn'' confId XOk + XInfo profile -> do + ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct) + -- [incognito] send incognito profile + incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId + let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False + allowAgentConnectionAsync user conn'' confId $ XInfo p + void $ withStore' $ \db -> resetMemberContactFields db ct' + XGrpLinkInv glInv -> do + -- XGrpLinkInv here means we are connecting via business contact card, so we replace contact with group + (gInfo, host) <- withStore $ \db -> do + liftIO $ deleteContactCardKeepConn db connId ct + createGroupInvitedViaLink db vr user conn'' glInv + -- [incognito] send saved profile + incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) + let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing True + allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + toView $ CRBusinessLinkConnecting user gInfo host ct + _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" + INFO pqSupport connInfo -> do + processINFOpqSupport conn pqSupport + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + _conn' <- updatePeerChatVRange conn chatVRange + case chatMsgEvent of + XGrpMemInfo _memId _memProfile -> do + -- TODO check member ID + -- TODO update member profile + pure () + XInfo profile -> + void $ processContactProfileUpdate ct profile False + XOk -> pure () + _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" + CON pqEnc -> + withStore' (\db -> getViaGroupMember db vr user ct) >>= \case + Nothing -> do + when (pqEnc == PQEncOn) $ withStore' $ \db -> updateConnPQEnabledCON db connId pqEnc + let conn' = conn {pqSndEnabled = Just pqEnc, pqRcvEnabled = Just pqEnc} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + -- [incognito] print incognito profile used for this contact + incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) + lift $ setContactNetworkStatus ct' NSConnected + toView $ CRContactConnected user ct' (fmap fromLocalProfile incognitoProfile) + when (directOrUsed ct') $ do + unless (contactUsed ct') $ withFastStore' $ \db -> updateContactUsed db user ct' + createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EInfo pqEnc) Nothing + createFeatureEnabledItems ct' + when (contactConnInitiated conn') $ do + let Connection {groupLinkId} = conn' + doProbeContacts = isJust groupLinkId + probeMatchingContactsAndMembers ct' (contactConnIncognito ct') doProbeContacts + withStore' $ \db -> resetContactConnInitiated db user conn' + forM_ viaUserContactLink $ \userContactLinkId -> do + ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId + let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl + when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept + forM_ groupId_ $ \groupId -> do + groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId + subMode <- chatReadVar subscriptionMode + groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode + gVar <- asks random + withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode + Just (gInfo, m@GroupMember {activeConn}) -> + when (maybe False ((== ConnReady) . connStatus) activeConn) $ do + notifyMemberConnected gInfo m $ Just ct + let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo + when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True + SENT msgId proxy -> do + void $ continueSending connEntity conn + sentMsgDeliveryEvent conn msgId + checkSndInlineFTComplete conn msgId + cis <- withStore $ \db -> do + cis <- updateDirectItemsStatus' db ct conn msgId (CISSndSent SSPComplete) + liftIO $ forM cis $ \ci -> setDirectSndChatItemViaProxy db user ct ci (isJust proxy) + let acis = map ctItem cis + unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + where + ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) + SWITCH qd phase cStats -> do + toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats) + when (phase == SPStarted || phase == SPCompleted) $ case qd of + QDRcv -> createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCESwitchQueue phase Nothing) Nothing + QDSnd -> createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing + RSYNC rss cryptoErr_ cStats -> + case (rss, connectionCode, cryptoErr_) of + (RSRequired, _, Just cryptoErr) -> processErr cryptoErr + (RSAllowed, _, Just cryptoErr) -> processErr cryptoErr + (RSAgreed, Just _, _) -> do + withStore' $ \db -> setConnectionVerified db user connId Nothing + let ct' = ct {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} :: Contact + ratchetSyncEventItem ct' + securityCodeChanged ct' + _ -> ratchetSyncEventItem ct + where + processErr cryptoErr = do + let e@(mde, n) = agentMsgDecryptError cryptoErr + ci_ <- withStore $ \db -> + getDirectChatItemLast db user contactId + >>= liftIO + . mapM (\(ci, content') -> updateDirectChatItem' db user contactId ci content' False False Nothing Nothing) + . mdeUpdatedCI e + case ci_ of + Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) + _ -> do + toView $ CRContactRatchetSync user ct (RatchetSyncProgress rss cStats) + createInternalChatItem user (CDDirectRcv ct) (CIRcvDecryptionError mde n) Nothing + ratchetSyncEventItem ct' = do + toView $ CRContactRatchetSync user ct' (RatchetSyncProgress rss cStats) + createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent $ RCERatchetSync rss) Nothing + OK -> + -- [async agent commands] continuation on receiving OK + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + JOINED sqSecured -> + -- [async agent commands] continuation on receiving JOINED + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> + when (directOrUsed ct && sqSecured) $ do + lift $ setContactNetworkStatus ct NSConnected + toView $ CRContactSndReady user ct + forM_ viaUserContactLink $ \userContactLinkId -> do + ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId + let (UserContactLink {autoAccept}, _, _) = ucl + when (connChatVersion >= batchSend2Version) $ sendAutoReply ct autoAccept + QCONT -> + void $ continueSending connEntity conn + MWARN msgId err -> do + updateDirectItemStatus ct conn msgId (CISSndWarning $ agentSndError err) + processConnMWARN connEntity conn err + MERR msgId err -> do + updateDirectItemStatus ct conn msgId (CISSndError $ agentSndError err) + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + processConnMERR connEntity conn err + MERRS msgIds err -> do + -- error cannot be AUTH error here + updateDirectItemsStatusMsgs ct conn (L.toList msgIds) (CISSndError $ agentSndError err) + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + ERR err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + -- TODO add debugging output + _ -> pure () + where + sendAutoReply ct = \case + Just AutoAccept {autoReply = Just mc} -> do + (msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) + toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] + _ -> pure () + + processGroupMessage :: AEvent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM () + processGroupMessage agentMsg connEntity conn@Connection {connId, connChatVersion, connectionCode} gInfo@GroupInfo {groupId, groupProfile, membership, chatSettings} m = case agentMsg of + INV (ACR _ cReq) -> + withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> + case cReq of + groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of + -- [async agent commands] XGrpMemIntro continuation on receiving INV + CFCreateConnGrpMemInv + | maxVersion (peerChatVRange conn) >= groupDirectInvVersion -> sendWithoutDirectCReq + | otherwise -> sendWithDirectCReq + where + sendWithoutDirectCReq = do + let GroupMember {groupMemberId, memberId} = m + hostConnId <- withStore $ \db -> do + liftIO $ setConnConnReqInv db user connId cReq + getHostConnId db user groupId + sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} + sendWithDirectCReq = do + let GroupMember {groupMemberId, memberId} = m + contData <- withStore' $ \db -> do + setConnConnReqInv db user connId cReq + getXGrpMemIntroContGroup db user m + forM_ contData $ \(hostConnId, directConnReq) -> + sendXGrpMemInv hostConnId (Just directConnReq) XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} + -- [async agent commands] group link auto-accept continuation on receiving INV + CFCreateConnGrpInv -> do + ct <- withStore $ \db -> getContactViaMember db vr user m + withStore' $ \db -> setNewContactMemberConnRequest db user m cReq + groupLinkId <- withStore' $ \db -> getGroupLinkId db user gInfo + sendGrpInvitation ct m groupLinkId + toView $ CRSentGroupInvitation user gInfo ct m + where + sendGrpInvitation :: Contact -> GroupMember -> Maybe GroupLinkId -> CM () + sendGrpInvitation ct GroupMember {memberId, memberRole = memRole} groupLinkId = do + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo + let GroupMember {memberRole = userRole, memberId = userMemberId} = membership + groupInv = + GroupInvitation + { fromMember = MemberIdRole userMemberId userRole, + invitedMember = MemberIdRole memberId memRole, + connRequest = cReq, + groupProfile, + business = Nothing, + groupLinkId = groupLinkId, + groupSize = Just currentMemCount + } + (_msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv + -- we could link chat item with sent group invitation message (_msg) + createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing + _ -> throwChatError $ CECommandError "unexpected cmdFunction" + CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" + CONF confId _pqSupport _ connInfo -> do + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updatePeerChatVRange conn chatVRange + case memberCategory m of + GCInviteeMember -> + case chatMsgEvent of + XGrpAcpt memId + | sameMemberId memId m -> do + withStore $ \db -> liftIO $ updateGroupMemberStatus db userId m GSMemAccepted + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn' confId XOk + | otherwise -> messageError "x.grp.acpt: memberId is different from expected" + _ -> messageError "CONF from invited member must have x.grp.acpt" + _ -> + case chatMsgEvent of + XGrpMemInfo memId _memProfile + | sameMemberId memId m -> do + let GroupMember {memberId = membershipMemId} = membership + membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership + -- TODO update member profile + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile + | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" + _ -> messageError "CONF from member must have x.grp.mem.info" + INFO _pqSupport connInfo -> do + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + _conn' <- updatePeerChatVRange conn chatVRange + case chatMsgEvent of + XGrpMemInfo memId _memProfile + | sameMemberId memId m -> do + -- TODO update member profile + pure () + | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" + XInfo _ -> pure () -- sent when connecting via group link + XOk -> pure () + _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok" + pure () + CON _pqEnc -> do + withStore' $ \db -> do + updateGroupMemberStatus db userId m GSMemConnected + unless (memberActive membership) $ + updateGroupMemberStatus db userId membership GSMemConnected + -- possible improvement: check for each pending message, requires keeping track of connection state + unless (connDisabled conn) $ sendPendingGroupMessages user m conn + withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings + case memberCategory m of + GCHostMember -> do + toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} + let cd = CDGroupRcv gInfo m + createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing + createGroupFeatureItems user cd CIRcvGroupFeature gInfo + let GroupInfo {groupProfile = GroupProfile {description}} = gInfo + memberConnectedChatItem gInfo m + unless expectHistory $ forM_ description $ groupDescriptionChatItem gInfo m + where + expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion + GCInviteeMember -> do + memberConnectedChatItem gInfo m + toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} + let Connection {viaUserContactLink} = conn + when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem + members <- withStore' $ \db -> getGroupMembers db vr user gInfo + void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m + sendIntroductions members + when (groupFeatureAllowed SGFHistory gInfo) sendHistory + when (connChatVersion < batchSend2Version) sendGroupAutoReply + where + sendXGrpLinkMem = do + let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo + profileToSend = profileToSendOnAccept user profileMode True + void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId + sendIntroductions members = do + intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m + shuffledIntros <- liftIO $ shuffleIntros intros + if m `supportsVersion` batchSendVersion + then do + let events = map (memberIntro . reMember) shuffledIntros + forM_ (L.nonEmpty events) $ \events' -> + sendGroupMemberMessages user conn events' groupId + else forM_ shuffledIntros $ \intro -> + processIntro intro `catchChatError` (toView . CRChatError (Just user)) + memberIntro :: GroupMember -> ChatMsgEvent 'Json + memberIntro reMember = + let mInfo = memberInfo reMember + mRestrictions = memberRestrictions reMember + in XGrpMemIntro mInfo mRestrictions + shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro] + shuffleIntros intros = do + let (admins, others) = partition isAdmin intros + (admPics, admNoPics) = partition hasPicture admins + (othPics, othNoPics) = partition hasPicture others + mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics] + where + isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin + hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image + processIntro intro@GroupMemberIntro {introId} = do + void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId + withStore' $ \db -> updateIntroStatus db introId GMIntroSent + sendHistory = + when (m `supportsVersion` batchSendVersion) $ do + (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100) + (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items + let errors = map ChatErrorStore errs <> errs' + unless (null errors) $ toView $ CRChatErrors (Just user) errors + let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_ + forM_ (L.nonEmpty events') $ \events'' -> + sendGroupMemberMessages user conn events'' groupId + descrEvent_ :: Maybe (ChatMsgEvent 'Json) + descrEvent_ + | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do + let GroupInfo {groupProfile = GroupProfile {description}} = gInfo + fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description + | otherwise = Nothing + itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json] + itemForwardEvents cci = case cci of + (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file}) + | not (blockedByAdmin sender) -> do + fInvDescr_ <- join <$> forM file getRcvFileInvDescr + processContentItem sender ci mc fInvDescr_ + (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do + fInvDescr_ <- join <$> forM file getSndFileInvDescr + processContentItem membership ci mc fInvDescr_ + _ -> pure [] + where + getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText)) + getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do + expired <- fileExpired + if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired + then pure Nothing + else do + rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId + pure $ invCompleteDescr ciFile rfd + getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText)) + getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do + expired <- fileExpired + if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired + then pure Nothing + else do + -- can also lookup in extra_xftp_file_descriptions, though it can be empty; + -- would be best if snd file had a single rcv description for all members saved in files table + rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId + pure $ invCompleteDescr ciFile rfd + fileExpired :: CM Bool + fileExpired = do + ttl <- asks $ rcvFilesTTL . agentConfig . config + cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime + pure $ chatItemTs cci < cutoffTs + invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText) + invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete} + | fileDescrComplete = + let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} + fInv = xftpFileInvitation fileName fileSize fInvDescr + in Just (fInv, fileDescrText) + | otherwise = Nothing + processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json] + processContentItem sender ChatItem {meta, quotedItem} mc fInvDescr_ = + if isNothing fInvDescr_ && not (msgContentHasText mc) + then pure [] + else do + let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta + quotedItemId_ = quoteItemId =<< quotedItem + fInv_ = fst <$> fInvDescr_ + (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ Nothing fInv_ itemTimed False + let senderVRange = memberChatVRange' sender + xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer} + fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of + (Just fileDescrText, Just msgId) -> do + partSize <- asks $ xftpDescrPartSize . config + let parts = splitFileDescr partSize fileDescrText + pure . L.toList $ L.map (XMsgFileDescr msgId) parts + _ -> pure [] + let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents + GroupMember {memberId} = sender + msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs) + pure msgForwardEvents + _ -> do + let memCategory = memberCategory m + withStore' (\db -> getViaGroupContact db vr user m) >>= \case + Nothing -> do + notifyMemberConnected gInfo m Nothing + let connectedIncognito = memberIncognito membership + when (memCategory == GCPreMember) $ probeMatchingMemberContact m connectedIncognito + Just ct@Contact {activeConn} -> + forM_ activeConn $ \Connection {connStatus} -> + when (connStatus == ConnReady) $ do + notifyMemberConnected gInfo m $ Just ct + let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo + when (memCategory == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True + sendXGrpMemCon memCategory + where + GroupMember {memberId} = m + sendXGrpMemCon = \case + GCPreMember -> + forM_ (invitedByGroupMemberId membership) $ \hostId -> do + host <- withStore $ \db -> getGroupMember db vr user groupId hostId + forM_ (memberConn host) $ \hostConn -> + void $ sendDirectMemberMessage hostConn (XGrpMemCon memberId) groupId + GCPostMember -> + forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do + im <- withStore $ \db -> getGroupMember db vr user groupId invitingMemberId + forM_ (memberConn im) $ \imConn -> + void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId + _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected" + MSG msgMeta _msgFlags msgBody -> do + tags <- newTVarIO [] + withAckMessage "group msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do + checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure () + forM_ aChatMsgs $ \case + Right (ACMsg _ chatMsg) -> + processEvent tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e + Left e -> do + atomically $ modifyTVar' tags ("error" :) + logInfo $ "group msg=error " <> eInfo <> " " <> tshow e + toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) + forwardMsgs (rights aChatMsgs) `catchChatError` (toView . CRChatError (Just user)) + checkSendRcpt $ rights aChatMsgs + where + aChatMsgs = parseChatMessages msgBody + brokerTs = metaBrokerTs msgMeta + processEvent :: TVar [Text] -> Text -> MsgEncodingI e => ChatMessage e -> CM () + processEvent tags eInfo chatMsg@ChatMessage {chatMsgEvent} = do + let tag = toCMEventTag chatMsgEvent + atomically $ modifyTVar' tags (tshow tag :) + logInfo $ "group msg=" <> tshow tag <> " " <> eInfo + (m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta msgBody chatMsg + case event of + XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False + XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr + XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg brokerTs ttl live + XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg brokerTs + XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg brokerTs + -- TODO discontinue XFile + XFile fInv -> processGroupFileInvitation' gInfo m' fInv msg brokerTs + XFileCancel sharedMsgId -> xFileCancelGroup gInfo m' sharedMsgId + XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName + XInfo p -> xInfoMember gInfo m' p brokerTs + XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p + XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg brokerTs + XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo m' memInfo memRestrictions_ + XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv + XGrpMemFwd memInfo introInv -> xGrpMemFwd gInfo m' memInfo introInv + XGrpMemRole memId memRole -> xGrpMemRole gInfo m' memId memRole msg brokerTs + XGrpMemRestrict memId memRestrictions -> xGrpMemRestrict gInfo m' memId memRestrictions msg brokerTs + XGrpMemCon memId -> xGrpMemCon gInfo m' memId + XGrpMemDel memId -> xGrpMemDel gInfo m' memId msg brokerTs + XGrpLeave -> xGrpLeave gInfo m' msg brokerTs + XGrpDel -> xGrpDel gInfo m' msg brokerTs + XGrpInfo p' -> xGrpInfo gInfo m' p' msg brokerTs + XGrpPrefs ps' -> xGrpPrefs gInfo m' ps' + XGrpDirectInv connReq mContent_ -> memberCanSend m' $ xGrpDirectInv gInfo m' conn' connReq mContent_ msg brokerTs + XGrpMsgForward memberId msg' msgTs -> xGrpMsgForward gInfo m' memberId msg' msgTs + XInfoProbe probe -> xInfoProbe (COMGroupMember m') probe + XInfoProbeCheck probeHash -> xInfoProbeCheck (COMGroupMember m') probeHash + XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe + BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta + _ -> messageError $ "unsupported message: " <> tshow event + checkSendRcpt :: [AChatMessage] -> CM Bool + checkSendRcpt aMsgs = do + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo + let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo + pure $ + fromMaybe (sendRcptsSmallGroups user) sendRcpts + && any aChatMsgHasReceipt aMsgs + && currentMemCount <= smallGroupsRcptsMemLimit + where + aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) = + hasDeliveryReceipt (toCMEventTag chatMsgEvent) + forwardMsgs :: [AChatMessage] -> CM () + forwardMsgs aMsgs = do + let GroupMember {memberRole = membershipMemRole} = membership + when (membershipMemRole >= GRAdmin && not (blockedByAdmin m)) $ do + let forwardedMsgs = mapMaybe (\(ACMsg _ chatMsg) -> forwardedGroupMsg chatMsg) aMsgs + forM_ (L.nonEmpty forwardedMsgs) $ \forwardedMsgs' -> do + ChatConfig {highlyAvailable} <- asks config + -- members introduced to this invited member + introducedMembers <- + if memberCategory m == GCInviteeMember + then withStore' $ \db -> getForwardIntroducedMembers db vr user m highlyAvailable + else pure [] + -- invited members to which this member was introduced + invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db vr user m highlyAvailable + let GroupMember {memberId} = m + ms = forwardedToGroupMembers (introducedMembers <> invitedMembers) forwardedMsgs' + events = L.map (\cm -> XGrpMsgForward memberId cm brokerTs) forwardedMsgs' + unless (null ms) $ void $ sendGroupMessages user gInfo ms events + RCVD msgMeta msgRcpt -> + withAckMessage' "group rcvd" agentConnId msgMeta $ + groupMsgReceived gInfo m conn msgMeta msgRcpt + SENT msgId proxy -> do + continued <- continueSending connEntity conn + sentMsgDeliveryEvent conn msgId + checkSndInlineFTComplete conn msgId + updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy) + when continued $ sendPendingGroupMessages user m conn + SWITCH qd phase cStats -> do + toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) + when (phase == SPStarted || phase == SPCompleted) $ case qd of + QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing + QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing + RSYNC rss cryptoErr_ cStats -> + case (rss, connectionCode, cryptoErr_) of + (RSRequired, _, Just cryptoErr) -> processErr cryptoErr + (RSAllowed, _, Just cryptoErr) -> processErr cryptoErr + (RSAgreed, Just _, _) -> do + withStore' $ \db -> setConnectionVerified db user connId Nothing + let m' = m {activeConn = Just (conn {connectionCode = Nothing} :: Connection)} :: GroupMember + ratchetSyncEventItem m' + toView $ CRGroupMemberVerificationReset user gInfo m' + createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent RCEVerificationCodeReset) Nothing + _ -> ratchetSyncEventItem m + where + processErr cryptoErr = do + let e@(mde, n) = agentMsgDecryptError cryptoErr + ci_ <- withStore $ \db -> + getGroupMemberChatItemLast db user groupId (groupMemberId' m) + >>= liftIO + . mapM (\(ci, content') -> updateGroupChatItem db user groupId ci content' False False Nothing) + . mdeUpdatedCI e + case ci_ of + Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) + _ -> do + toView $ CRGroupMemberRatchetSync user gInfo m (RatchetSyncProgress rss cStats) + createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvDecryptionError mde n) Nothing + ratchetSyncEventItem m' = do + toView $ CRGroupMemberRatchetSync user gInfo m' (RatchetSyncProgress rss cStats) + createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent $ RCERatchetSync rss) Nothing + OK -> + -- [async agent commands] continuation on receiving OK + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + JOINED sqSecured -> + -- [async agent commands] continuation on receiving JOINED + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> + when (sqSecured && connChatVersion >= batchSend2Version) sendGroupAutoReply + QCONT -> do + continued <- continueSending connEntity conn + when continued $ sendPendingGroupMessages user m conn + MWARN msgId err -> do + withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSWarning $ agentSndError err) + processConnMWARN connEntity conn err + MERR msgId err -> do + withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSError $ agentSndError err) + -- group errors are silenced to reduce load on UI event log + -- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + processConnMERR connEntity conn err + MERRS msgIds err -> do + let newStatus = GSSError $ agentSndError err + -- error cannot be AUTH error here + withStore' $ \db -> forM_ msgIds $ \msgId -> + updateGroupItemsErrorStatus db msgId (groupMemberId' m) newStatus `catchAll_` pure () + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + ERR err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + -- TODO add debugging output + _ -> pure () + where + updateGroupItemsErrorStatus :: DB.Connection -> AgentMsgId -> GroupMemberId -> GroupSndStatus -> IO () + updateGroupItemsErrorStatus db msgId groupMemberId newStatus = do + itemIds <- getChatItemIdsByAgentMsgId db connId msgId + forM_ itemIds $ \itemId -> updateGroupMemSndStatus' db itemId groupMemberId newStatus + sendGroupAutoReply = autoReplyMC >>= mapM_ send + where + autoReplyMC = do + let GroupInfo {businessChat} = gInfo + GroupMember {memberId = joiningMemberId} = m + case businessChat of + Just BusinessChatInfo {customerId, chatType = BCCustomer} + | joiningMemberId == customerId -> useReply <$> withStore (`getUserAddress` user) + where + useReply UserContactLink {autoAccept} = case autoAccept of + Just AutoAccept {businessAddress, autoReply} | businessAddress -> autoReply + _ -> Nothing + _ -> pure Nothing + send mc = do + msg <- sendGroupMessage' user gInfo [m] (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc) + withStore' $ \db -> createGroupSndStatus db (chatItemId' ci) (groupMemberId' m) GSSNew + toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] + + agentMsgDecryptError :: AgentCryptoError -> (MsgDecryptError, Word32) + agentMsgDecryptError = \case + DECRYPT_AES -> (MDEOther, 1) + DECRYPT_CB -> (MDEOther, 1) + RATCHET_HEADER -> (MDERatchetHeader, 1) + RATCHET_EARLIER _ -> (MDERatchetEarlier, 1) + RATCHET_SKIPPED n -> (MDETooManySkipped, n) + RATCHET_SYNC -> (MDERatchetSync, 0) + + mdeUpdatedCI :: (MsgDecryptError, Word32) -> CChatItem c -> Maybe (ChatItem c 'MDRcv, CIContent 'MDRcv) + mdeUpdatedCI (mde', n') (CChatItem _ ci@ChatItem {content = CIRcvDecryptionError mde n}) + | mde == mde' = case mde of + MDERatchetHeader -> r (n + n') + MDETooManySkipped -> r n' -- the numbers are not added as sequential MDETooManySkipped will have it incremented by 1 + MDERatchetEarlier -> r (n + n') + MDEOther -> r (n + n') + MDERatchetSync -> r 0 + | otherwise = Nothing + where + r n'' = Just (ci, CIRcvDecryptionError mde n'') + mdeUpdatedCI _ _ = Nothing + + processSndFileConn :: AEvent e -> ConnectionEntity -> Connection -> SndFileTransfer -> CM () + processSndFileConn agentMsg connEntity conn ft@SndFileTransfer {fileId, fileName, fileStatus} = + case agentMsg of + -- SMP CONF for SndFileConnection happens for direct file protocol + -- when recipient of the file "joins" connection created by the sender + CONF confId _pqSupport _ connInfo -> do + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updatePeerChatVRange conn chatVRange + case chatMsgEvent of + -- TODO save XFileAcpt message + XFileAcpt name + | name == fileName -> do + withStore' $ \db -> updateSndFileStatus db ft FSAccepted + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + allowAgentConnectionAsync user conn' confId XOk + | otherwise -> messageError "x.file.acpt: fileName is different from expected" + _ -> messageError "CONF from file connection must have x.file.acpt" + CON _ -> do + ci <- withStore $ \db -> do + liftIO $ updateSndFileStatus db ft FSConnected + updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 + toView $ CRSndFileStart user ci ft + sendFileChunk user ft + SENT msgId _proxy -> do + withStore' $ \db -> updateSndFileChunkSent db ft msgId + unless (fileStatus == FSCancelled) $ sendFileChunk user ft + MERR _ err -> do + cancelSndFileTransfer user ft True >>= mapM_ (deleteAgentConnectionAsync user) + case err of + SMP _ SMP.AUTH -> unless (fileStatus == FSCancelled) $ do + ci <- withStore $ \db -> do + liftIO (lookupChatRefByFileId db user fileId) >>= \case + Just (ChatRef CTDirect _) -> liftIO $ updateFileCancelled db user fileId CIFSSndCancelled + _ -> pure () + lookupChatItemByFileId db vr user fileId + toView $ CRSndFileRcvCancelled user ci ft + _ -> throwChatError $ CEFileSend fileId err + MSG meta _ _ -> + withAckMessage' "file msg" agentConnId meta $ pure () + OK -> + -- [async agent commands] continuation on receiving OK + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + JOINED _ -> + -- [async agent commands] continuation on receiving JOINED + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + ERR err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + -- TODO add debugging output + _ -> pure () + + processRcvFileConn :: AEvent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> CM () + processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} = + case agentMsg of + INV (ACR _ cReq) -> + withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> + case cReq of + fileInvConnReq@(CRInvitationUri _ _) -> case cmdFunction of + -- [async agent commands] direct XFileAcptInv continuation on receiving INV + CFCreateConnFileInvDirect -> do + ct <- withStore $ \db -> getContactByFileId db vr user fileId + sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId + void $ sendDirectContactMessage user ct (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) + -- [async agent commands] group XFileAcptInv continuation on receiving INV + CFCreateConnFileInvGroup -> case grpMemberId of + Just gMemberId -> do + GroupMember {groupId, activeConn} <- withStore $ \db -> getGroupMemberById db vr user gMemberId + case activeConn of + Just gMemberConn -> do + sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId + void $ sendDirectMemberMessage gMemberConn (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) groupId + _ -> throwChatError $ CECommandError "no GroupMember activeConn" + _ -> throwChatError $ CECommandError "no grpMemberId" + _ -> throwChatError $ CECommandError "unexpected cmdFunction" + CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" + -- SMP CONF for RcvFileConnection happens for group file protocol + -- when sender of the file "joins" connection created by the recipient + -- (sender doesn't create connections for all group members) + CONF confId _pqSupport _ connInfo -> do + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + conn' <- updatePeerChatVRange conn chatVRange + case chatMsgEvent of + XOk -> allowAgentConnectionAsync user conn' confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability + _ -> pure () + CON _ -> startReceivingFile user fileId + MSG meta _ msgBody -> do + -- XXX: not all branches do ACK + parseFileChunk msgBody >>= receiveFileChunk ft (Just conn) meta + OK -> + -- [async agent commands] continuation on receiving OK + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + JOINED _ -> + -- [async agent commands] continuation on receiving JOINED + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + MERR _ err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + processConnMERR connEntity conn err + ERR err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + -- TODO add debugging output + _ -> pure () + + receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> CM () + receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case + FileChunkCancel -> + unless (rcvFileCompleteOrCancelled ft) $ do + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId + toView $ CRRcvFileSndCancelled user ci ft + FileChunk {chunkNo, chunkBytes = chunk} -> do + case integrity of + MsgOk -> pure () + MsgError MsgDuplicate -> pure () -- TODO remove once agent removes duplicates + MsgError e -> + badRcvFileChunk ft $ "invalid file chunk number " <> show chunkNo <> ": " <> show e + withStore' (\db -> createRcvFileChunk db ft chunkNo msgId) >>= \case + RcvChunkOk -> + if B.length chunk /= fromInteger chunkSize + then badRcvFileChunk ft "incorrect chunk size" + else withAckMessage' "file msg" agentConnId meta $ appendFileChunk ft chunkNo chunk False + RcvChunkFinal -> + if B.length chunk > fromInteger chunkSize + then badRcvFileChunk ft "incorrect chunk size" + else do + appendFileChunk ft chunkNo chunk True + ci <- withStore $ \db -> do + liftIO $ do + updateRcvFileStatus db fileId FSComplete + updateCIFileStatus db user fileId CIFSRcvComplete + deleteRcvFileChunks db ft + getChatItemByFileId db vr user fileId + toView $ CRRcvFileComplete user ci + forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn) + RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure () + RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo + + processUserContactRequest :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM () + processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of + REQ invId pqSupport _ connInfo -> do + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo + case chatMsgEvent of + XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ pqSupport + XInfo p -> profileContactRequest invId chatVRange p Nothing pqSupport + -- TODO show/log error, other events in contact request + _ -> pure () + MERR _ err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + processConnMERR connEntity conn err + ERR err -> do + toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () + -- TODO add debugging output + _ -> pure () + where + profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> CM () + profileContactRequest invId chatVRange p xContactId_ reqPQSup = do + withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case + CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact + CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo + CORRequest cReq -> do + ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId + let (UserContactLink {connReqContact, autoAccept}, groupId_, gLinkMemRole) = ucl + isSimplexTeam = sameConnReqContact connReqContact adminContactReq + v = maxVersion chatVRange + case autoAccept of + Just AutoAccept {acceptIncognito, businessAddress} + | businessAddress -> + if v < groupFastLinkJoinVersion || (isSimplexTeam && v < businessChatsVersion) + then do + ct <- acceptContactRequestAsync user cReq Nothing True reqPQSup + toView $ CRAcceptingContactRequest user ct + else do + gInfo <- acceptBusinessJoinRequestAsync user cReq + toView $ CRAcceptingBusinessRequest user gInfo + | otherwise -> case groupId_ of + Nothing -> do + -- [incognito] generate profile to send, create connection with incognito profile + incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing + ct <- acceptContactRequestAsync user cReq incognitoProfile True reqPQSup + toView $ CRAcceptingContactRequest user ct + Just groupId -> do + gInfo <- withStore $ \db -> getGroupInfo db vr user groupId + let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo + if v >= groupFastLinkJoinVersion + then do + mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode + createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing + toView $ CRAcceptingGroupJoinRequestMember user gInfo mem + else do + -- TODO v5.7 remove old API (or v6.0?) + ct <- acceptContactRequestAsync user cReq profileMode False PQSupportOff + toView $ CRAcceptingGroupJoinRequest user gInfo ct + _ -> toView $ CRReceivedContactRequest user cReq + + memberCanSend :: GroupMember -> CM () -> CM () + memberCanSend GroupMember {memberRole} a + | memberRole <= GRObserver = messageError "member is not allowed to send messages" + | otherwise = a + + processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM () + processConnMERR connEntity conn err = do + case err of + SMP _ SMP.AUTH -> do + authErrCounter' <- withStore' $ \db -> incAuthErrCounter db user conn + when (authErrCounter' >= authErrDisableCount) $ case connEntity of + RcvDirectMsgConnection ctConn (Just ct) -> do + toView $ CRContactDisabled user ct {activeConn = Just ctConn {authErrCounter = authErrCounter'}} + _ -> toView $ CRConnectionDisabled connEntity + SMP _ SMP.QUOTA -> + unless (connInactive conn) $ do + withStore' $ \db -> setQuotaErrCounter db user conn quotaErrSetOnMERR + toView $ CRConnectionInactive connEntity True + _ -> pure () + + processConnMWARN :: ConnectionEntity -> Connection -> AgentErrorType -> CM () + processConnMWARN connEntity conn err = do + case err of + SMP _ SMP.QUOTA -> + unless (connInactive conn) $ do + quotaErrCounter' <- withStore' $ \db -> incQuotaErrCounter db user conn + when (quotaErrCounter' >= quotaErrInactiveCount) $ + toView $ + CRConnectionInactive connEntity True + _ -> pure () + + continueSending :: ConnectionEntity -> Connection -> CM Bool + continueSending connEntity conn = + if connInactive conn + then do + withStore' $ \db -> setQuotaErrCounter db user conn 0 + toView $ CRConnectionInactive connEntity False + pure True + else pure False + + -- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections? + -- we could save command records only for agent APIs we process continuations for (INV) + withCompletedCommand :: forall e. AEntityI e => Connection -> AEvent e -> (CommandData -> CM ()) -> CM () + withCompletedCommand Connection {connId} agentMsg action = do + let agentMsgTag = AEvtTag (sAEntity @e) $ aEventTag agentMsg + cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId + case cmdData_ of + Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction} + | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == AEvtTag SAEConn ERR_) -> do + withStore' $ \db -> deleteCommand db user cmdId + action cmdData + | otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId + Just CommandData {cmdId, cmdConnId = Nothing} -> err cmdId $ "no command connection id, corrId = " <> show corrId + Nothing -> throwChatError . CEAgentCommandError $ "command not found, corrId = " <> show corrId + where + err cmdId msg = do + withStore' $ \db -> updateCommandStatus db user cmdId CSError + throwChatError . CEAgentCommandError $ msg + + withAckMessage' :: Text -> ConnId -> MsgMeta -> CM () -> CM () + withAckMessage' label cId msgMeta action = do + withAckMessage label cId msgMeta False Nothing $ \_ -> action $> False + + withAckMessage :: Text -> ConnId -> MsgMeta -> Bool -> Maybe (TVar [Text]) -> (Text -> CM Bool) -> CM () + withAckMessage label cId msgMeta showCritical tags action = do + -- [async agent commands] command should be asynchronous + -- TODO catching error and sending ACK after an error, particularly if it is a database error, will result in the message not processed (and no notification to the user). + -- Possible solutions are: + -- 1) retry processing several times + -- 2) stabilize database + -- 3) show screen of death to the user asking to restart + eInfo <- eventInfo + logInfo $ label <> ": " <> eInfo + tryChatError (action eInfo) >>= \case + Right withRcpt -> + withLog (eInfo <> " ok") $ ackMsg msgMeta $ if withRcpt then Just "" else Nothing + -- If showCritical is True, then these errors don't result in ACK and show user visible alert + -- This prevents losing the message that failed to be processed. + Left (ChatErrorStore SEDBBusyError {message}) | showCritical -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing + Left e -> do + withLog (eInfo <> " error: " <> tshow e) $ ackMsg msgMeta Nothing + throwError e + where + eventInfo = do + v <- asks eventSeq + eId <- atomically $ stateTVar v $ \i -> (i + 1, i + 1) + pure $ "conn_id=" <> tshow cId <> " event_id=" <> tshow eId + withLog eInfo' ack = do + ts <- showTags + logInfo $ T.unwords [label, "ack:", ts, eInfo'] + ack + logInfo $ T.unwords [label, "ack=success:", ts, eInfo'] + showTags = do + ts <- maybe (pure []) readTVarIO tags + pure $ case ts of + [] -> "no_chat_messages" + [t] -> "chat_message=" <> t + _ -> "chat_message_batch=" <> T.intercalate "," (reverse ts) + ackMsg :: MsgMeta -> Maybe MsgReceiptInfo -> CM () + ackMsg MsgMeta {recipient = (msgId, _)} rcpt = withAgent $ \a -> ackMessageAsync a "" cId msgId rcpt + + sentMsgDeliveryEvent :: Connection -> AgentMsgId -> CM () + sentMsgDeliveryEvent Connection {connId} msgId = + withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent + + agentSndError :: AgentErrorType -> SndError + agentSndError = \case + SMP _ AUTH -> SndErrAuth + SMP _ QUOTA -> SndErrQuota + BROKER _ e -> brokerError SndErrRelay e + SMP proxySrv (SMP.PROXY (SMP.BROKER e)) -> brokerError (SndErrProxy proxySrv) e + AP.PROXY proxySrv _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> brokerError (SndErrProxyRelay proxySrv) e + e -> SndErrOther $ tshow e + where + brokerError srvErr = \case + NETWORK -> SndErrExpired + TIMEOUT -> SndErrExpired + HOST -> srvErr SrvErrHost + SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion + e -> srvErr . SrvErrOther $ tshow e + + badRcvFileChunk :: RcvFileTransfer -> String -> CM () + badRcvFileChunk ft err = + unless (rcvFileCompleteOrCancelled ft) $ do + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) + throwChatError $ CEFileRcvChunk err + + memberConnectedChatItem :: GroupInfo -> GroupMember -> CM () + memberConnectedChatItem gInfo m = + -- ts should be broker ts but we don't have it for CON + createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEMemberConnected) Nothing + + groupDescriptionChatItem :: GroupInfo -> GroupMember -> Text -> CM () + groupDescriptionChatItem gInfo m descr = + createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvMsgContent $ MCText descr) Nothing + + notifyMemberConnected :: GroupInfo -> GroupMember -> Maybe Contact -> CM () + notifyMemberConnected gInfo m ct_ = do + memberConnectedChatItem gInfo m + lift $ mapM_ (`setContactNetworkStatus` NSConnected) ct_ + toView $ CRConnectedToGroupMember user gInfo m ct_ + + probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> CM () + probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do + gVar <- asks random + contactMerge <- readTVarIO =<< asks contactMergeEnabled + if contactMerge && not connectedIncognito + then do + (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId (COMContact ct) + -- ! when making changes to probe-and-merge mechanism, + -- ! test scenario in which recipient receives probe after probe hashes (not covered in tests): + -- sendProbe -> sendProbeHashes (currently) + -- sendProbeHashes -> sendProbe (reversed - change order in code, may add delay) + sendProbe probe + cs <- + if doProbeContacts + then map COMContact <$> withStore' (\db -> getMatchingContacts db vr user ct) + else pure [] + ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db vr user ct) + sendProbeHashes (cs <> ms) probe probeId + else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) + where + sendProbe :: Probe -> CM () + sendProbe probe = void . sendDirectContactMessage user ct $ XInfoProbe probe + + probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> CM () + probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure () + probeMatchingMemberContact m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do + gVar <- asks random + contactMerge <- readTVarIO =<< asks contactMergeEnabled + if contactMerge && not connectedIncognito + then do + (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ COMGroupMember m + sendProbe probe + cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db vr user m) + sendProbeHashes cs probe probeId + else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) + where + sendProbe :: Probe -> CM () + sendProbe probe = void $ sendDirectMemberMessage conn (XInfoProbe probe) groupId + + sendProbeHashes :: [ContactOrMember] -> Probe -> Int64 -> CM () + sendProbeHashes cgms probe probeId = + forM_ cgms $ \cgm -> sendProbeHash cgm `catchChatError` \_ -> pure () + where + probeHash = ProbeHash $ C.sha256Hash (unProbe probe) + sendProbeHash :: ContactOrMember -> CM () + sendProbeHash cgm@(COMContact c) = do + void . sendDirectContactMessage user c $ XInfoProbeCheck probeHash + withStore' $ \db -> createSentProbeHash db userId probeId cgm + sendProbeHash (COMGroupMember GroupMember {activeConn = Nothing}) = pure () + sendProbeHash cgm@(COMGroupMember m@GroupMember {groupId, activeConn = Just conn}) = + when (memberCurrent m) $ do + void $ sendDirectMemberMessage conn (XInfoProbeCheck probeHash) groupId + withStore' $ \db -> createSentProbeHash db userId probeId cgm + + messageWarning :: Text -> CM () + messageWarning = toView . CRMessageError user "warning" + + messageError :: Text -> CM () + messageError = toView . CRMessageError user "error" + + newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM () + newContentMessage ct@Contact {contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do + unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct + let ExtMsgContent content fInv_ _ _ = mcExtMsgContent mc + -- Uncomment to test stuck delivery on errors - see test testDirectMessageDelete + -- case content of + -- MCText "hello 111" -> + -- UE.throwIO $ userError "#####################" + -- -- throwChatError $ CECommandError "#####################" + -- _ -> pure () + if isVoice content && not (featureAllowed SCFVoice forContact ct) + then do + void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False + else do + let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc + timed_ = rcvContactCITimed ct itemTTL + live = fromMaybe False live_ + file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct + newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live + autoAcceptFile file_ + where + brokerTs = metaBrokerTs msgMeta + newChatItem ciContent ciFile_ timed_ live = do + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live + reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}] + + autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> CM () + autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do + -- ! autoAcceptFileSize is only used in tests + ChatConfig {autoAcceptFileSize = sz} <- asks config + when (sz > fileSize) $ receiveFile' user ft False Nothing Nothing >>= toView + + messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> CM () + messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr = do + fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId + processFDMessage (CDDirectRcv ct) sharedMsgId fileId fileDescr + + groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> CM () + groupMessageFileDescription g@GroupInfo {groupId} m sharedMsgId fileDescr = do + fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId + processFDMessage (CDGroupRcv g m) sharedMsgId fileId fileDescr + + processFDMessage :: ChatTypeQuotable c => ChatDirection c 'MDRcv -> SharedMsgId -> FileTransferId -> FileDescr -> CM () + processFDMessage cd sharedMsgId fileId fileDescr = do + ft <- withStore $ \db -> getRcvFileTransfer db user fileId + unless (rcvFileCompleteOrCancelled ft) $ do + (rfd@RcvFileDescr {fileDescrComplete}, ft'@RcvFileTransfer {fileStatus, xftpRcvFile, cryptoArgs}) <- withStore $ \db -> do + rfd <- appendRcvFD db userId fileId fileDescr + -- reading second time in the same transaction as appending description + -- to prevent race condition with accept + ft' <- getRcvFileTransfer db user fileId + pure (rfd, ft') + when fileDescrComplete $ do + ci <- withStore $ \db -> getAChatItemBySharedMsgId db user cd sharedMsgId + toView $ CRRcvFileDescrReady user ci ft' rfd + case (fileStatus, xftpRcvFile) of + (RFSAccepted _, Just XFTPRcvFile {userApprovedRelays}) -> receiveViaCompleteFD user fileId rfd userApprovedRelays cryptoArgs + _ -> pure () + + processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> CM (Maybe (RcvFileTransfer, CIFile 'MDRcv)) + processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv' -> do + ChatConfig {fileChunkSize} <- asks config + let fInv@FileInvitation {fileName, fileSize} = mkValidFileInvitation fInv' + inline <- receiveInlineMode fInv (Just mc) fileChunkSize + ft@RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize + let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP + (filePath, fileStatus, ft') <- case inline of + Just IFMSent -> do + encrypt <- chatReadVar encryptLocalFiles + ft' <- (if encrypt then setFileToEncrypt else pure) ft + fPath <- getRcvFilePath fileId Nothing fileName True + withStore' $ \db -> startRcvInlineFT db user ft' fPath inline + pure (Just fPath, CIFSRcvAccepted, ft') + _ -> pure (Nothing, CIFSRcvInvitation, ft) + let RcvFileTransfer {cryptoArgs} = ft' + fileSource = (`CryptoFile` cryptoArgs) <$> filePath + pure (ft', CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}) + + mkValidFileInvitation :: FileInvitation -> FileInvitation + mkValidFileInvitation fInv@FileInvitation {fileName} = fInv {fileName = FP.makeValid $ FP.takeFileName fileName} + + messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> CM () + messageUpdate ct@Contact {contactId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do + updateRcvChatItem `catchCINotFound` \_ -> do + -- This patches initial sharedMsgId into chat item when locally deleted chat item + -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). + -- Chat item and update message which created it will have different sharedMsgId in this case... + let timed_ = rcvContactCITimed ct ttl + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs content Nothing timed_ live + ci' <- withStore' $ \db -> do + createChatItemVersion db (chatItemId' ci) brokerTs mc + updateDirectChatItem' db user contactId ci content True live Nothing Nothing + toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') + where + brokerTs = metaBrokerTs msgMeta + content = CIRcvMsgContent mc + live = fromMaybe False live_ + updateRcvChatItem = do + cci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId + case cci of + CChatItem SMDRcv ci@ChatItem {meta = CIMeta {itemForwarded, itemLive}, content = CIRcvMsgContent oldMC} + | isNothing itemForwarded -> do + let changed = mc /= oldMC + if changed || fromMaybe False itemLive + then do + ci' <- withStore' $ \db -> do + when changed $ + addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) + reactions <- getDirectCIReactions db ct sharedMsgId + let edited = itemLive /= Just True + updateDirectChatItem' db user contactId ci {reactions} content edited live Nothing $ Just msgId + toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') + startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' + else toView $ CRChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) + _ -> messageError "x.msg.update: contact attempted invalid message update" + + messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> CM () + messageDelete ct@Contact {contactId} sharedMsgId _rcvMessage msgMeta = do + deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct) + where + brokerTs = metaBrokerTs msgMeta + deleteRcvChatItem = do + cci@(CChatItem msgDir ci) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId + case msgDir of + SMDRcv + | rcvItemDeletable ci brokerTs -> + if featureAllowed SCFFullDelete forContact ct + then deleteDirectCIs user ct [cci] False False >>= toView + else markDirectCIsDeleted user ct [cci] False brokerTs >>= toView + | otherwise -> messageError "x.msg.del: contact attempted invalid message delete" + SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete" + + rcvItemDeletable :: ChatItem c d -> UTCTime -> Bool + rcvItemDeletable ChatItem {meta = CIMeta {itemTs, itemDeleted}} brokerTs = + -- 78 hours margin to account for possible sending delay + diffUTCTime brokerTs itemTs < (78 * 3600) && isNothing itemDeleted + + directMsgReaction :: Contact -> SharedMsgId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> CM () + directMsgReaction ct sharedMsgId reaction add RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do + when (featureAllowed SCFReactions forContact ct) $ do + rs <- withStore' $ \db -> getDirectReactions db ct sharedMsgId False + when (reactionAllowed add reaction rs) $ do + updateChatItemReaction `catchCINotFound` \_ -> + withStore' $ \db -> setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs + where + updateChatItemReaction = do + cr_ <- withStore $ \db -> do + CChatItem md ci <- getDirectChatItemBySharedMsgId db user (contactId' ct) sharedMsgId + if ciReactionAllowed ci + then liftIO $ do + setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs + reactions <- getDirectCIReactions db ct sharedMsgId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTDirect SMDRcv (DirectChat ct) $ CIReaction CIDirectRcv ci' brokerTs reaction + pure $ Just $ CRChatItemReaction user add r + else pure Nothing + mapM_ toView cr_ + + groupMsgReaction :: GroupInfo -> GroupMember -> SharedMsgId -> MemberId -> MsgReaction -> Bool -> RcvMessage -> UTCTime -> CM () + groupMsgReaction g@GroupInfo {groupId} m sharedMsgId itemMemberId reaction add RcvMessage {msgId} brokerTs = do + when (groupFeatureAllowed SGFReactions g) $ do + rs <- withStore' $ \db -> getGroupReactions db g m itemMemberId sharedMsgId False + when (reactionAllowed add reaction rs) $ do + updateChatItemReaction `catchCINotFound` \_ -> + withStore' $ \db -> setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs + where + updateChatItemReaction = do + cr_ <- withStore $ \db -> do + CChatItem md ci <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId + if ciReactionAllowed ci + then liftIO $ do + setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs + reactions <- getGroupCIReactions db g itemMemberId sharedMsgId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m) ci' brokerTs reaction + pure $ Just $ CRChatItemReaction user add r + else pure Nothing + mapM_ toView cr_ + + reactionAllowed :: Bool -> MsgReaction -> [MsgReaction] -> Bool + reactionAllowed add reaction rs = (reaction `elem` rs) /= add && not (add && length rs >= maxMsgReactions) + + catchCINotFound :: CM a -> (SharedMsgId -> CM a) -> CM a + catchCINotFound f handle = + f `catchChatError` \case + ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId + e -> throwError e + + newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> CM () + newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded + | blockedByAdmin m = createBlockedByAdmin + | otherwise = case prohibitedGroupContent gInfo m content fInv_ of + Just f -> rejected f + Nothing -> + withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case + Just ciModeration -> do + applyModeration ciModeration + withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_ + Nothing -> createContentItem + where + rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False + timed' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo itemTTL + live' = fromMaybe False live_ + ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc + createBlockedByAdmin + | groupFeatureAllowed SGFFullDelete gInfo = do + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvBlocked Nothing timed' False + ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs + groupMsgToView gInfo ci' + | otherwise = do + file_ <- processFileInv + ci <- createNonLive file_ + ci' <- withStore' $ \db -> markGroupCIBlockedByAdmin db user gInfo ci + groupMsgToView gInfo ci' + applyModeration CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, moderatedAt} + | moderatorRole < GRAdmin || moderatorRole < memberRole = + createContentItem + | groupFeatureAllowed SGFFullDelete gInfo = do + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed' False + ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt + groupMsgToView gInfo ci' + | otherwise = do + file_ <- processFileInv + ci <- createNonLive file_ + toView =<< markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] False (Just moderator) moderatedAt + createNonLive file_ = + saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed' False + createContentItem = do + file_ <- processFileInv + newChatItem (CIRcvMsgContent content) (snd <$> file_) timed' live' + when (showMessages $ memberSettings m) $ autoAcceptFile file_ + processFileInv = + processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m + newChatItem ciContent ciFile_ timed_ live = do + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live + ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci + reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ + groupMsgToView gInfo ci' {reactions} + + groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> UTCTime -> Maybe Int -> Maybe Bool -> CM () + groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} brokerTs ttl_ live_ + | prohibitedSimplexLinks gInfo m mc = + messageWarning $ "x.msg.update ignored: feature not allowed " <> groupFeatureNameText GFSimplexLinks + | otherwise = do + updateRcvChatItem `catchCINotFound` \_ -> do + -- This patches initial sharedMsgId into chat item when locally deleted chat item + -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). + -- Chat item and update message which created it will have different sharedMsgId in this case... + let timed_ = rcvGroupCITimed gInfo ttl_ + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs content Nothing timed_ live + ci' <- withStore' $ \db -> do + createChatItemVersion db (chatItemId' ci) brokerTs mc + ci' <- updateGroupChatItem db user groupId ci content True live Nothing + blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci' + toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') + where + content = CIRcvMsgContent mc + live = fromMaybe False live_ + updateRcvChatItem = do + cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId + case cci of + CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} -> + if sameMemberId memberId m' + then do + let changed = mc /= oldMC + if changed || fromMaybe False itemLive + then do + ci' <- withStore' $ \db -> do + when changed $ + addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) + reactions <- getGroupCIReactions db gInfo memberId sharedMsgId + let edited = itemLive /= Just True + updateGroupChatItem db user groupId ci {reactions} content edited live $ Just msgId + toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') + startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' + else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) + else messageError "x.msg.update: group member attempted to update a message of another member" + _ -> messageError "x.msg.update: group member attempted invalid message update" + + groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> UTCTime -> CM () + groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} brokerTs = do + let msgMemberId = fromMaybe memberId sndMemberId_ + withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case + Right cci@(CChatItem _ ci@ChatItem {chatDir}) -> case chatDir of + CIGroupRcv mem -> case sndMemberId_ of + -- regular deletion + Nothing + | sameMemberId memberId mem && msgMemberId == memberId && rcvItemDeletable ci brokerTs -> + delete cci Nothing >>= toView + | otherwise -> + messageError "x.msg.del: member attempted invalid message delete" + -- moderation (not limited by time) + Just _ + | sameMemberId memberId mem && msgMemberId == memberId -> + delete cci (Just m) >>= toView + | otherwise -> + moderate mem cci + CIGroupSnd -> moderate membership cci + Left e + | msgMemberId == memberId -> messageError $ "x.msg.del: message not found, " <> tshow e + | senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e + | otherwise -> withStore' $ \db -> createCIModeration db gInfo m msgMemberId sharedMsgId msgId brokerTs + where + moderate :: GroupMember -> CChatItem 'CTGroup -> CM () + moderate mem cci = case sndMemberId_ of + Just sndMemberId + | sameMemberId sndMemberId mem -> checkRole mem $ delete cci (Just m) >>= toView + | otherwise -> messageError "x.msg.del: message of another member with incorrect memberId" + _ -> messageError "x.msg.del: message of another member without memberId" + checkRole GroupMember {memberRole} a + | senderRole < GRAdmin || senderRole < memberRole = + messageError "x.msg.del: message of another member with insufficient member permissions" + | otherwise = a + delete :: CChatItem 'CTGroup -> Maybe GroupMember -> CM ChatResponse + delete cci byGroupMember + | groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs + | otherwise = markGroupCIsDeleted user gInfo [cci] False byGroupMember brokerTs + + -- TODO remove once XFile is discontinued + processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> CM () + processFileInvitation' ct fInv' msg@RcvMessage {sharedMsgId_} msgMeta = do + ChatConfig {fileChunkSize} <- asks config + let fInv@FileInvitation {fileName, fileSize} = mkValidFileInvitation fInv' + inline <- receiveInlineMode fInv Nothing fileChunkSize + RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize + let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP + ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + where + brokerTs = metaBrokerTs msgMeta + + -- TODO remove once XFile is discontinued + processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> UTCTime -> CM () + processGroupFileInvitation' gInfo m fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} brokerTs = do + ChatConfig {fileChunkSize} <- asks config + inline <- receiveInlineMode fInv Nothing fileChunkSize + RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize + let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP + ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False + ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci + groupMsgToView gInfo ci' + + blockedMember :: Monad m' => GroupMember -> ChatItem c d -> m' (ChatItem c d) -> m' (ChatItem c d) + blockedMember m ci blockedCI + | showMessages (memberSettings m) = pure ci + | otherwise = blockedCI + + receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> CM (Maybe InlineFileMode) + receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of + (Just mode, Nothing) -> do + InlineFilesConfig {receiveChunks, receiveInstant} <- asks $ inlineFiles . config + pure $ if fileSize <= receiveChunks * chSize then inline' receiveInstant else Nothing + where + inline' receiveInstant = if mode == IFMOffer || (receiveInstant && maybe False isVoice mc_) then fileInline else Nothing + _ -> pure Nothing + + xFileCancel :: Contact -> SharedMsgId -> CM () + xFileCancel Contact {contactId} sharedMsgId = do + fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId + ft <- withStore (\db -> getRcvFileTransfer db user fileId) + unless (rcvFileCompleteOrCancelled ft) $ do + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId + toView $ CRRcvFileSndCancelled user ci ft + + xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM () + xFileAcptInv ct sharedMsgId fileConnReq_ fName = do + fileId <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId + (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId + assertSMPAcceptNotProhibited ci + ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId) + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + if fName == fileName + then unless cancelled $ case fileConnReq_ of + -- receiving via a separate connection + Just fileConnReq -> do + subMode <- chatReadVar subscriptionMode + dm <- encodeConnInfo XOk + connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode + withStore' $ \db -> createSndDirectFTConnection db vr user fileId connIds subMode + -- receiving inline + _ -> do + event <- withStore $ \db -> do + ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 + sft <- createSndDirectInlineFT db ct ft + pure $ CRSndFileStart user ci' sft + toView event + ifM + (allowSendInline fileSize fileInline) + (sendDirectFileInline user ct ft sharedMsgId) + (messageError "x.file.acpt.inv: fileSize is bigger than allowed to send inline") + else messageError "x.file.acpt.inv: fileName is different from expected" + + assertSMPAcceptNotProhibited :: ChatItem c d -> CM () + assertSMPAcceptNotProhibited ChatItem {file = Just CIFile {fileId, fileProtocol}, content} + | fileProtocol == FPXFTP && not (imageOrVoice content) = throwChatError $ CEFallbackToSMPProhibited fileId + | otherwise = pure () + where + imageOrVoice :: CIContent d -> Bool + imageOrVoice (CISndMsgContent (MCImage _ _)) = True + imageOrVoice (CISndMsgContent (MCVoice _ _)) = True + imageOrVoice _ = False + assertSMPAcceptNotProhibited _ = pure () + + checkSndInlineFTComplete :: Connection -> AgentMsgId -> CM () + checkSndInlineFTComplete conn agentMsgId = do + sft_ <- withStore' $ \db -> getSndFTViaMsgDelivery db user conn agentMsgId + forM_ sft_ $ \sft@SndFileTransfer {fileId} -> do + ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> do + liftIO $ updateSndFileStatus db sft FSComplete + liftIO $ deleteSndFileChunks db sft + updateDirectCIFileStatus db vr user fileId CIFSSndComplete + case file of + Just CIFile {fileProtocol = FPXFTP} -> do + ft <- withStore $ \db -> getFileTransferMeta db user fileId + toView $ CRSndFileCompleteXFTP user ci ft + _ -> toView $ CRSndFileComplete user ci sft + + allowSendInline :: Integer -> Maybe InlineFileMode -> CM Bool + allowSendInline fileSize = \case + Just IFMOffer -> do + ChatConfig {fileChunkSize, inlineFiles} <- asks config + pure $ fileSize <= fileChunkSize * offerChunks inlineFiles + _ -> pure False + + bFileChunk :: Contact -> SharedMsgId -> FileChunk -> MsgMeta -> CM () + bFileChunk ct sharedMsgId chunk meta = do + ft <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId >>= getRcvFileTransfer db user + receiveInlineChunk ft chunk meta + + bFileChunkGroup :: GroupInfo -> SharedMsgId -> FileChunk -> MsgMeta -> CM () + bFileChunkGroup GroupInfo {groupId} sharedMsgId chunk meta = do + ft <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId >>= getRcvFileTransfer db user + receiveInlineChunk ft chunk meta + + receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> CM () + receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _ + | chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId + | otherwise = pure () + receiveInlineChunk ft@RcvFileTransfer {fileId} chunk meta = do + case chunk of + FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId + _ -> pure () + receiveFileChunk ft Nothing meta chunk + + xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> CM () + xFileCancelGroup GroupInfo {groupId} GroupMember {groupMemberId, memberId} sharedMsgId = do + fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId + CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId + case (msgDir, chatDir) of + (SMDRcv, CIGroupRcv m) -> do + if sameMemberId memberId m + then do + ft <- withStore (\db -> getRcvFileTransfer db user fileId) + unless (rcvFileCompleteOrCancelled ft) $ do + cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId + toView $ CRRcvFileSndCancelled user ci ft + else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id + (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" + + xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM () + xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do + fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId + (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId + assertSMPAcceptNotProhibited ci + -- TODO check that it's not already accepted + ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId) + if fName == fileName + then unless cancelled $ case (fileConnReq_, activeConn) of + (Just fileConnReq, _) -> do + subMode <- chatReadVar subscriptionMode + -- receiving via a separate connection + -- [async agent commands] no continuation needed, but command should be asynchronous for stability + dm <- encodeConnInfo XOk + connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode + withStore' $ \db -> createSndGroupFileTransferConnection db vr user fileId connIds m subMode + (_, Just conn) -> do + -- receiving inline + event <- withStore $ \db -> do + ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 + sft <- liftIO $ createSndGroupInlineFT db m conn ft + pure $ CRSndFileStart user ci' sft + toView event + ifM + (allowSendInline fileSize fileInline) + (sendMemberFileInline m conn ft sharedMsgId) + (messageError "x.file.acpt.inv: fileSize is bigger than allowed to send inline") + _ -> messageError "x.file.acpt.inv: member connection is not active" + else messageError "x.file.acpt.inv: fileName is different from expected" + + groupMsgToView :: forall d. MsgDirectionI d => GroupInfo -> ChatItem 'CTGroup d -> CM () + groupMsgToView gInfo ci = + toView $ CRNewChatItems user [AChatItem SCTGroup (msgDirection @d) (GroupChat gInfo) ci] + + processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> CM () + processGroupInvitation ct inv msg msgMeta = do + let Contact {localDisplayName = c, activeConn} = ct + GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv + forM_ activeConn $ \Connection {connId, connChatVersion, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do + when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) + when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId + -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile + (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership}, hostId) <- withStore $ \db -> createGroupInvitation db vr user ct inv customUserProfileId + let GroupMember {groupMemberId, memberId = membershipMemId} = membership + if sameGroupLinkId groupLinkId groupLinkId' + then do + subMode <- chatReadVar subscriptionMode + dm <- encodeConnInfo $ XGrpAcpt membershipMemId + connIds <- joinAgentConnectionAsync user True connRequest dm subMode + withStore' $ \db -> do + setViaGroupLinkHash db groupId connId + createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode + updateGroupMemberStatusById db userId hostId GSMemAccepted + updateGroupMemberStatus db userId membership GSMemAccepted + toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) + else do + let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole + ci <- saveRcvChatItem user (CDDirectRcv ct) msg brokerTs content + withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} + where + brokerTs = metaBrokerTs msgMeta + sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool + sameGroupLinkId (Just gli) (Just gli') = gli == gli' + sameGroupLinkId _ _ = False + + checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> CM () + checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of + MsgOk -> pure () + MsgError e -> createInternalChatItem user cd (CIRcvIntegrityError e) (Just brokerTs) + + xInfo :: Contact -> Profile -> CM () + xInfo c p' = void $ processContactProfileUpdate c p' True + + xDirectDel :: Contact -> RcvMessage -> MsgMeta -> CM () + xDirectDel c msg msgMeta = + if directOrUsed c + then do + ct' <- withStore' $ \db -> updateContactStatus db user c CSDeleted + contactConns <- withStore' $ \db -> getContactConnections db vr userId ct' + deleteAgentConnectionsAsync user $ map aConnId contactConns + forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted + activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted} + let ct'' = ct' {activeConn = activeConn'} :: Contact + ci <- saveRcvChatItem user (CDDirectRcv ct'') msg brokerTs (CIRcvDirectEvent RDEContactDeleted) + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct'') ci] + toView $ CRContactDeletedByContact user ct'' + else do + contactConns <- withStore' $ \db -> getContactConnections db vr userId c + deleteAgentConnectionsAsync user $ map aConnId contactConns + withStore $ \db -> deleteContact db user c + where + brokerTs = metaBrokerTs msgMeta + + processContactProfileUpdate :: Contact -> Profile -> Bool -> CM Contact + processContactProfileUpdate c@Contact {profile = lp} p' createItems + | p /= p' = do + c' <- withStore $ \db -> + if userTTL == rcvTTL + then updateContactProfile db user c p' + else do + c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs' + updateContactProfile db user c' p' + when (directOrUsed c' && createItems) $ do + createProfileUpdatedItem c' + lift $ createRcvFeatureItems user c c' + toView $ CRContactUpdated user c c' + pure c' + | otherwise = + pure c + where + p = fromLocalProfile lp + Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c + userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs + Profile {preferences = rcvPrefs_} = p' + rcvTTL = prefParam $ getPreference SCFTimedMessages rcvPrefs_ + ctUserPrefs' = + let userDefault = getPreference SCFTimedMessages (fullPreferences user) + userDefaultTTL = prefParam userDefault + ctUserTMPref' = case ctUserTMPref of + Just userTM -> Just (userTM :: TimedMessagesPreference) {ttl = rcvTTL} + _ + | rcvTTL /= userDefaultTTL -> Just (userDefault :: TimedMessagesPreference) {ttl = rcvTTL} + | otherwise -> Nothing + in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs + createProfileUpdatedItem c' = + when visibleProfileUpdated $ do + let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p' + createInternalChatItem user (CDDirectRcv c') ciContent Nothing + where + visibleProfileUpdated = + n' /= n || fn' /= fn || i' /= i || cl' /= cl + Profile {displayName = n, fullName = fn, image = i, contactLink = cl} = p + Profile {displayName = n', fullName = fn', image = i', contactLink = cl'} = p' + + xInfoMember :: GroupInfo -> GroupMember -> Profile -> UTCTime -> CM () + xInfoMember gInfo m p' brokerTs = void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs) + + xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM () + xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do + xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId + if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived + then do + m' <- processMemberProfileUpdate gInfo m p' False Nothing + withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True + let connectedIncognito = memberIncognito membership + probeMatchingMemberContact m' connectedIncognito + else messageError "x.grp.link.mem error: invalid group link host profile update" + + processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember + processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_ + | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do + updateBusinessChatProfile gInfo + case memberContactId of + Nothing -> do + m' <- withStore $ \db -> updateMemberProfile db user m p' + createProfileUpdatedItem m' + toView $ CRGroupMemberUpdated user gInfo m m' + pure m' + Just mContactId -> do + mCt <- withStore $ \db -> getContact db vr user mContactId + if canUpdateProfile mCt + then do + (m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p' + createProfileUpdatedItem m' + toView $ CRGroupMemberUpdated user gInfo m m' + toView $ CRContactUpdated user mCt ct' + pure m' + else pure m + where + canUpdateProfile ct + | not (contactActive ct) = True + | otherwise = case contactConn ct of + Nothing -> True + Just conn -> not (connReady conn) || (authErrCounter conn >= 1) + | otherwise = + pure m + where + updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of + Just bc | isMainBusinessMember bc m -> do + g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' + toView $ CRGroupUpdated user g g' (Just m) + _ -> pure () + isMainBusinessMember BusinessChatInfo {chatType, businessId, customerId} GroupMember {memberId} = case chatType of + BCBusiness -> businessId == memberId + BCCustomer -> customerId == memberId + createProfileUpdatedItem m' = + when createItems $ do + let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p' + createInternalChatItem user (CDGroupRcv gInfo m') ciContent itemTs_ + + createFeatureEnabledItems :: Contact -> CM () + createFeatureEnabledItems ct@Contact {mergedPreferences} = + forM_ allChatFeatures $ \(ACF f) -> do + let state = featureState $ getContactUserPreference f mergedPreferences + createInternalChatItem user (CDDirectRcv ct) (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing + + xInfoProbe :: ContactOrMember -> Probe -> CM () + xInfoProbe cgm2 probe = do + contactMerge <- readTVarIO =<< asks contactMergeEnabled + -- [incognito] unless connected incognito + when (contactMerge && not (contactOrMemberIncognito cgm2)) $ do + cgm1s <- withStore' $ \db -> matchReceivedProbe db vr user cgm2 probe + let cgm1s' = filter (not . contactOrMemberIncognito) cgm1s + probeMatches cgm1s' cgm2 + where + probeMatches :: [ContactOrMember] -> ContactOrMember -> CM () + probeMatches [] _ = pure () + probeMatches (cgm1' : cgm1s') cgm2' = do + cgm2''_ <- probeMatch cgm1' cgm2' probe `catchChatError` \_ -> pure (Just cgm2') + let cgm2'' = fromMaybe cgm2' cgm2''_ + probeMatches cgm1s' cgm2'' + + xInfoProbeCheck :: ContactOrMember -> ProbeHash -> CM () + xInfoProbeCheck cgm1 probeHash = do + contactMerge <- readTVarIO =<< asks contactMergeEnabled + -- [incognito] unless connected incognito + when (contactMerge && not (contactOrMemberIncognito cgm1)) $ do + cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db vr user cgm1 probeHash + forM_ cgm2Probe_ $ \(cgm2, probe) -> + unless (contactOrMemberIncognito cgm2) . void $ + probeMatch cgm1 cgm2 probe + + probeMatch :: ContactOrMember -> ContactOrMember -> Probe -> CM (Maybe ContactOrMember) + probeMatch cgm1 cgm2 probe = + case cgm1 of + COMContact c1@Contact {contactId = cId1, profile = p1} -> + case cgm2 of + COMContact c2@Contact {contactId = cId2, profile = p2} + | cId1 /= cId2 && profilesMatch p1 p2 -> do + void . sendDirectContactMessage user c1 $ XInfoProbeOk probe + COMContact <$$> mergeContacts c1 c2 + | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing + COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId} + | isNothing memberContactId && profilesMatch p1 p2 -> do + void . sendDirectContactMessage user c1 $ XInfoProbeOk probe + COMContact <$$> associateMemberAndContact c1 m2 + | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing + COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing + COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} -> + case cgm2 of + COMContact c2@Contact {profile = p2} + | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do + void $ sendDirectMemberMessage conn (XInfoProbeOk probe) groupId + COMContact <$$> associateMemberAndContact c2 m1 + | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing + COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing + + xInfoProbeOk :: ContactOrMember -> Probe -> CM () + xInfoProbeOk cgm1 probe = do + cgm2 <- withStore' $ \db -> matchSentProbe db vr user cgm1 probe + case cgm1 of + COMContact c1@Contact {contactId = cId1} -> + case cgm2 of + Just (COMContact c2@Contact {contactId = cId2}) + | cId1 /= cId2 -> void $ mergeContacts c1 c2 + | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id" + Just (COMGroupMember m2@GroupMember {memberContactId}) + | isNothing memberContactId -> void $ associateMemberAndContact c1 m2 + | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact" + _ -> pure () + COMGroupMember m1@GroupMember {memberContactId} -> + case cgm2 of + Just (COMContact c2) + | isNothing memberContactId -> void $ associateMemberAndContact c2 m1 + | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact" + Just (COMGroupMember _) -> messageWarning "xInfoProbeOk ignored: members are not matched with members" + _ -> pure () + + -- to party accepting call + xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> CM () + xCallInv ct@Contact {contactId} callId CallInvitation {callType, callDhPubKey} msg@RcvMessage {sharedMsgId_} msgMeta = do + if featureAllowed SCFCalls forContact ct + then do + g <- asks random + dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing + ci <- saveCallItem CISCallPending + callUUID <- UUID.toText <$> liftIO V4.nextRandom + let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair)) + callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey} + call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci} + calls <- asks currentCalls + -- theoretically, the new call invitation for the current contact can mark the in-progress call as ended + -- (and replace it in ChatController) + -- practically, this should not happen + withStore' $ \db -> createCall db user call' $ chatItemTs' ci + call_ <- atomically (TM.lookupInsert contactId call' calls) + forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing + toView $ CRCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callUUID, callTs = chatItemTs' ci} + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + else featureRejected CFCalls + where + brokerTs = metaBrokerTs msgMeta + saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0) + featureRejected f = do + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvChatFeatureRejected f) Nothing Nothing False + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + + -- to party initiating call + xCallOffer :: Contact -> CallId -> CallOffer -> RcvMessage -> CM () + xCallOffer ct callId CallOffer {callType, rtcSession, callDhPubKey} msg = do + msgCurrentCall ct callId "x.call.offer" msg $ + \call -> case callState call of + CallInvitationSent {localCallType, localDhPrivKey} -> do + let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> localDhPrivKey) + callState' = CallOfferReceived {localCallType, peerCallType = callType, peerCallSession = rtcSession, sharedKey} + askConfirmation = encryptedCall localCallType && not (encryptedCall callType) + toView CRCallOffer {user, contact = ct, callType, offer = rtcSession, sharedKey, askConfirmation} + pure (Just call {callState = callState'}, Just . ACIContent SMDSnd $ CISndCall CISCallAccepted 0) + _ -> do + msgCallStateError "x.call.offer" call + pure (Just call, Nothing) + + -- to party accepting call + xCallAnswer :: Contact -> CallId -> CallAnswer -> RcvMessage -> CM () + xCallAnswer ct callId CallAnswer {rtcSession} msg = do + msgCurrentCall ct callId "x.call.answer" msg $ + \call -> case callState call of + CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} -> do + let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession = rtcSession, sharedKey} + toView $ CRCallAnswer user ct rtcSession + pure (Just call {callState = callState'}, Just . ACIContent SMDRcv $ CIRcvCall CISCallNegotiated 0) + _ -> do + msgCallStateError "x.call.answer" call + pure (Just call, Nothing) + + -- to any call party + xCallExtra :: Contact -> CallId -> CallExtraInfo -> RcvMessage -> CM () + xCallExtra ct callId CallExtraInfo {rtcExtraInfo} msg = do + msgCurrentCall ct callId "x.call.extra" msg $ + \call -> case callState call of + CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} -> do + -- TODO update the list of ice servers in peerCallSession + let callState' = CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} + toView $ CRCallExtraInfo user ct rtcExtraInfo + pure (Just call {callState = callState'}, Nothing) + CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} -> do + -- TODO update the list of ice servers in peerCallSession + let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} + toView $ CRCallExtraInfo user ct rtcExtraInfo + pure (Just call {callState = callState'}, Nothing) + _ -> do + msgCallStateError "x.call.extra" call + pure (Just call, Nothing) + + -- to any call party + xCallEnd :: Contact -> CallId -> RcvMessage -> CM () + xCallEnd ct callId msg = + msgCurrentCall ct callId "x.call.end" msg $ \Call {chatItemId} -> do + toView $ CRCallEnded user ct + (Nothing,) <$> callStatusItemContent user ct chatItemId WCSDisconnected + + msgCurrentCall :: Contact -> CallId -> Text -> RcvMessage -> (Call -> CM (Maybe Call, Maybe ACIContent)) -> CM () + msgCurrentCall ct@Contact {contactId = ctId'} callId' eventName RcvMessage {msgId} action = do + calls <- asks currentCalls + atomically (TM.lookup ctId' calls) >>= \case + Nothing -> messageError $ eventName <> ": no current call" + Just call@Call {contactId, callId, chatItemId} + | contactId /= ctId' || callId /= callId' -> messageError $ eventName <> ": wrong contact or callId" + | otherwise -> do + (call_, aciContent_) <- action call + case call_ of + Just call' -> do + unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId' + atomically $ TM.insert ctId' call' calls + _ -> do + withStore' $ \db -> deleteCalls db user ctId' + atomically $ TM.delete ctId' calls + forM_ aciContent_ $ \aciContent -> do + timed_ <- callTimed ct aciContent + updateDirectChatItemView user ct chatItemId aciContent False False timed_ $ Just msgId + forM_ (timed_ >>= timedDeleteAt') $ + startProximateTimedItemThread user (ChatRef CTDirect ctId', chatItemId) + + msgCallStateError :: Text -> Call -> CM () + msgCallStateError eventName Call {callState} = + messageError $ eventName <> ": wrong call state " <> T.pack (show $ callStateTag callState) + + mergeContacts :: Contact -> Contact -> CM (Maybe Contact) + mergeContacts c1 c2 = do + let Contact {localDisplayName = cLDN1, profile = LocalProfile {displayName}} = c1 + Contact {localDisplayName = cLDN2} = c2 + case (suffixOrd displayName cLDN1, suffixOrd displayName cLDN2) of + (Just cOrd1, Just cOrd2) + | cOrd1 < cOrd2 -> merge c1 c2 + | cOrd2 < cOrd1 -> merge c2 c1 + | otherwise -> pure Nothing + _ -> pure Nothing + where + merge c1' c2' = do + c2'' <- withStore $ \db -> mergeContactRecords db vr user c1' c2' + toView $ CRContactsMerged user c1' c2' c2'' + when (directOrUsed c2'') $ showSecurityCodeChanged c2'' + pure $ Just c2'' + where + showSecurityCodeChanged mergedCt = do + let sc1_ = contactSecurityCode c1' + sc2_ = contactSecurityCode c2' + scMerged_ = contactSecurityCode mergedCt + case (sc1_, sc2_) of + (Just sc1, Nothing) + | scMerged_ /= Just sc1 -> securityCodeChanged mergedCt + | otherwise -> pure () + (Nothing, Just sc2) + | scMerged_ /= Just sc2 -> securityCodeChanged mergedCt + | otherwise -> pure () + _ -> pure () + + associateMemberAndContact :: Contact -> GroupMember -> CM (Maybe Contact) + associateMemberAndContact c m = do + let Contact {localDisplayName = cLDN, profile = LocalProfile {displayName}} = c + GroupMember {localDisplayName = mLDN} = m + case (suffixOrd displayName cLDN, suffixOrd displayName mLDN) of + (Just cOrd, Just mOrd) + | cOrd < mOrd -> Just <$> associateMemberWithContact c m + | mOrd < cOrd -> Just <$> associateContactWithMember m c + | otherwise -> pure Nothing + _ -> pure Nothing + + suffixOrd :: ContactName -> ContactName -> Maybe Int + suffixOrd displayName localDisplayName + | localDisplayName == displayName = Just 0 + | otherwise = case T.stripPrefix (displayName <> "_") localDisplayName of + Just suffix -> readMaybe $ T.unpack suffix + Nothing -> Nothing + + associateMemberWithContact :: Contact -> GroupMember -> CM Contact + associateMemberWithContact c1 m2@GroupMember {groupId} = do + withStore' $ \db -> associateMemberWithContactRecord db user c1 m2 + g <- withStore $ \db -> getGroupInfo db vr user groupId + toView $ CRContactAndMemberAssociated user c1 g m2 c1 + pure c1 + + associateContactWithMember :: GroupMember -> Contact -> CM Contact + associateContactWithMember m1@GroupMember {groupId} c2 = do + c2' <- withStore $ \db -> associateContactWithMemberRecord db vr user m1 c2 + g <- withStore $ \db -> getGroupInfo db vr user groupId + toView $ CRContactAndMemberAssociated user c2 g m1 c2' + pure c2' + + saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Bool) + saveConnInfo activeConn connInfo = do + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo + conn' <- updatePeerChatVRange activeConn chatVRange + case chatMsgEvent of + XInfo p -> do + let contactUsed = connDirect activeConn + ct <- withStore $ \db -> createDirectContact db user conn' p contactUsed + toView $ CRContactConnecting user ct + pure (conn', False) + XGrpLinkInv glInv -> do + (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv + toView $ CRGroupLinkConnecting user gInfo host + pure (conn', True) + -- TODO show/log error, other events in SMP confirmation + _ -> pure (conn', False) + + xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> UTCTime -> CM () + xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _) msg brokerTs = do + checkHostRole m memRole + unless (sameMemberId memId $ membership gInfo) $ + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + Right unknownMember@GroupMember {memberStatus = GSMemUnknown} -> do + updatedMember <- withStore $ \db -> updateUnknownMemberAnnounced db vr user m unknownMember memInfo + toView $ CRUnknownMemberAnnounced user gInfo m unknownMember updatedMember + memberAnnouncedToView updatedMember + Right _ -> messageError "x.grp.mem.new error: member already exists" + Left _ -> do + newMember <- withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced + memberAnnouncedToView newMember + where + memberAnnouncedToView announcedMember@GroupMember {groupMemberId, memberProfile} = do + let event = RGEMemberAdded groupMemberId (fromLocalProfile memberProfile) + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent event) + groupMsgToView gInfo ci + toView $ CRJoinedGroupMemberConnecting user gInfo m announcedMember + + xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM () + xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do + case memberCategory m of + GCHostMember -> + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + Right _ -> messageError "x.grp.mem.intro ignored: member already exists" + Left _ -> do + when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) + subMode <- chatReadVar subscriptionMode + -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second + groupConnIds <- createConn subMode + directConnIds <- case memChatVRange of + Nothing -> Just <$> createConn subMode + Just (ChatVersionRange mcvr) + | maxVersion mcvr >= groupDirectInvVersion -> pure Nothing + | otherwise -> Just <$> createConn subMode + let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo + chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange + void $ withStore $ \db -> createIntroReMember db user gInfo m chatV memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode + _ -> messageError "x.grp.mem.intro can be only sent by host member" + where + createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode + + sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> CM () + sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do + hostConn <- withStore $ \db -> getConnectionById db vr user hostConnId + let msg = XGrpMemInv memberId IntroInvitation {groupConnReq, directConnReq} + void $ sendDirectMemberMessage hostConn msg groupId + withStore' $ \db -> updateGroupMemberStatusById db userId groupMemberId GSMemIntroInvited + + xGrpMemInv :: GroupInfo -> GroupMember -> MemberId -> IntroInvitation -> CM () + xGrpMemInv gInfo m memId introInv = do + case memberCategory m of + GCInviteeMember -> + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + Left _ -> messageError "x.grp.mem.inv error: referenced member does not exist" + Right reMember -> do + GroupMemberIntro {introId} <- withStore $ \db -> saveIntroInvitation db reMember m introInv + sendGroupMemberMessage user gInfo reMember (XGrpMemFwd (memberInfo m) introInv) (Just introId) $ + withStore' $ + \db -> updateIntroStatus db introId GMIntroInvForwarded + _ -> messageError "x.grp.mem.inv can be only sent by invitee member" + + xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> CM () + xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do + let GroupMember {memberId = membershipMemId} = membership + checkHostRole m memRole + toMember <- + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent + -- the situation when member does not exist is an error + -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that. + -- For now, this branch compensates for the lack of delayed message delivery. + Left _ -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced + Right m' -> pure m' + withStore' $ \db -> saveMemberInvitation db toMember introInv + subMode <- chatReadVar subscriptionMode + -- [incognito] send membership incognito profile, create direct connection as incognito + let membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership + dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile + -- [async agent commands] no continuation needed, but commands should be asynchronous for stability + groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode + directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode + let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo + mcvr = maybe chatInitialVRange fromChatVRange memChatVRange + chatV = vr `peerConnChatVersion` mcvr + withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode + + xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> CM () + xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs + | membershipMemId == memId = + let gInfo' = gInfo {membership = membership {memberRole = memRole}} + in changeMemberRole gInfo' membership $ RGEUserRole memRole + | otherwise = + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole + Left _ -> messageError "x.grp.mem.role with unknown member ID" + where + GroupMember {memberId = membershipMemId} = membership + changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent + | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" + | otherwise = do + withStore' $ \db -> updateGroupMemberRole db user member memRole + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) + groupMsgToView gInfo ci + toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} + + checkHostRole :: GroupMember -> GroupMemberRole -> CM () + checkHostRole GroupMember {memberRole, localDisplayName} memRole = + when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName) + + xGrpMemRestrict :: GroupInfo -> GroupMember -> MemberId -> MemberRestrictions -> RcvMessage -> UTCTime -> CM () + xGrpMemRestrict + gInfo@GroupInfo {groupId, membership = GroupMember {memberId = membershipMemId}} + m@GroupMember {memberRole = senderRole} + memId + MemberRestrictions {restriction} + msg + brokerTs + | membershipMemId == memId = + -- member shouldn't receive this message about themselves + messageError "x.grp.mem.restrict: admin blocks you" + | otherwise = + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + Right bm@GroupMember {groupMemberId = bmId, memberRole, memberProfile = bmp} + | senderRole < GRAdmin || senderRole < memberRole -> messageError "x.grp.mem.restrict with insufficient member permissions" + | otherwise -> do + bm' <- setMemberBlocked bmId + toggleNtf user bm' (not blocked) + let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs ciContent + groupMsgToView gInfo ci + toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked} + Left (SEGroupMemberNotFoundByMemberId _) -> do + bm <- createUnknownMember gInfo memId + bm' <- setMemberBlocked $ groupMemberId' bm + toView $ CRUnknownMemberBlocked user gInfo m bm' + Left e -> throwError $ ChatErrorStore e + where + setMemberBlocked bmId = + withStore $ \db -> do + liftIO $ updateGroupMemberBlocked db user groupId bmId restriction + getGroupMember db vr user groupId bmId + blocked = mrsBlocked restriction + + xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> CM () + xGrpMemCon gInfo sendingMember memId = do + refMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo memId + case (memberCategory sendingMember, memberCategory refMember) of + (GCInviteeMember, GCInviteeMember) -> + withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case + Right intro -> inviteeXGrpMemCon intro + Left _ -> + withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case + Right intro -> forwardMemberXGrpMemCon intro + Left _ -> messageWarning "x.grp.mem.con: no introduction" + (GCInviteeMember, _) -> + withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case + Right intro -> inviteeXGrpMemCon intro + Left _ -> messageWarning "x.grp.mem.con: no introduction" + (_, GCInviteeMember) -> + withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case + Right intro -> forwardMemberXGrpMemCon intro + Left _ -> messageWarning "x.grp.mem.con: no introductiosupportn" + -- Note: we can allow XGrpMemCon to all member categories if we decide to support broader group forwarding, + -- deduplication (see saveGroupRcvMsg, saveGroupFwdRcvMsg) already supports sending XGrpMemCon + -- to any forwarding member, not only host/inviting member; + -- database would track all members connections then + -- (currently it's done via group_member_intros for introduced connections only) + _ -> + messageWarning "x.grp.mem.con: neither member is invitee" + where + inviteeXGrpMemCon :: GroupMemberIntro -> CM () + inviteeXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of + GMIntroReConnected -> updateStatus introId GMIntroConnected + GMIntroToConnected -> pure () + GMIntroConnected -> pure () + _ -> updateStatus introId GMIntroToConnected + forwardMemberXGrpMemCon :: GroupMemberIntro -> CM () + forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of + GMIntroToConnected -> updateStatus introId GMIntroConnected + GMIntroReConnected -> pure () + GMIntroConnected -> pure () + _ -> updateStatus introId GMIntroReConnected + updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status + + xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> CM () + xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do + let GroupMember {memberId = membershipMemId} = membership + if membershipMemId == memId + then checkRole membership $ do + deleteGroupLinkIfExists user gInfo + -- member records are not deleted to keep history + members <- withStore' $ \db -> getGroupMembers db vr user gInfo + deleteMembersConnections user members + withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved + deleteMemberItem RGEUserDeleted + toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m + else + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case + Left _ -> messageError "x.grp.mem.del with unknown member ID" + Right member@GroupMember {groupMemberId, memberProfile} -> + checkRole member $ do + -- ? prohibit deleting member if it's the sender - sender should use x.grp.leave + deleteMemberConnection user member + -- undeleted "member connected" chat item will prevent deletion of member record + deleteOrUpdateMemberRecord user member + deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile) + toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved} + where + checkRole GroupMember {memberRole} a + | senderRole < GRAdmin || senderRole < memberRole = + messageError "x.grp.mem.del with insufficient member permissions" + | otherwise = a + deleteMemberItem gEvent = do + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) + groupMsgToView gInfo ci + + xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () + xGrpLeave gInfo m msg brokerTs = do + deleteMemberConnection user m + -- member record is not deleted to allow creation of "member left" chat item + withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEMemberLeft) + groupMsgToView gInfo ci + toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft} + + xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () + xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg brokerTs = do + when (memberRole /= GROwner) $ throwChatError $ CEGroupUserRole gInfo GROwner + ms <- withStore' $ \db -> do + members <- getGroupMembers db vr user gInfo + updateGroupMemberStatus db userId membership GSMemGroupDeleted + pure members + -- member records are not deleted to keep history + deleteMembersConnections user ms + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEGroupDeleted) + groupMsgToView gInfo ci + toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m + + xGrpInfo :: GroupInfo -> GroupMember -> GroupProfile -> RcvMessage -> UTCTime -> CM () + xGrpInfo g@GroupInfo {groupProfile = p, businessChat} m@GroupMember {memberRole} p' msg brokerTs + | memberRole < GROwner = messageError "x.grp.info with insufficient member permissions" + | otherwise = case businessChat of + Nothing -> unless (p == p') $ do + g' <- withStore $ \db -> updateGroupProfile db user g p' + toView $ CRGroupUpdated user g g' (Just m) + let cd = CDGroupRcv g' m + unless (sameGroupProfileInfo p p') $ do + ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') + groupMsgToView g' ci + createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' + Just _ -> updateGroupPrefs_ g m $ fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' + + xGrpPrefs :: GroupInfo -> GroupMember -> GroupPreferences -> CM () + xGrpPrefs g m@GroupMember {memberRole} ps' + | memberRole < GROwner = messageError "x.grp.prefs with insufficient member permissions" + | otherwise = updateGroupPrefs_ g m ps' + + updateGroupPrefs_ :: GroupInfo -> GroupMember -> GroupPreferences -> CM () + updateGroupPrefs_ g@GroupInfo {groupProfile = p} m ps' = + unless (groupPreferences p == Just ps') $ do + g' <- withStore' $ \db -> updateGroupPreferences db user g ps' + toView $ CRGroupUpdated user g g' (Just m) + let cd = CDGroupRcv g' m + createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' + + xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> CM () + xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do + unless (groupFeatureMemberAllowed SGFDirectMessages m g) $ messageError "x.grp.direct.inv: direct messages not allowed" + let GroupMember {memberContactId} = m + subMode <- chatReadVar subscriptionMode + case memberContactId of + Nothing -> createNewContact subMode + Just mContactId -> do + mCt <- withStore $ \db -> getContact db vr user mContactId + let Contact {activeConn, contactGrpInvSent} = mCt + forM_ activeConn $ \Connection {connId} -> + if contactGrpInvSent + then do + ownConnReq <- withStore $ \db -> getConnReqInv db connId + -- in case both members sent x.grp.direct.inv before receiving other's for processing, + -- only the one who received greater connReq joins, the other creates items and waits for confirmation + if strEncode connReq > strEncode ownConnReq + then joinExistingContact subMode mCt + else createItems mCt m + else joinExistingContact subMode mCt + where + joinExistingContact subMode mCt = do + connIds <- joinConn subMode + mCt' <- withStore $ \db -> updateMemberContactInvited db user connIds g mConn mCt subMode + createItems mCt' m + securityCodeChanged mCt' + createNewContact subMode = do + connIds <- joinConn subMode + -- [incognito] reuse membership incognito profile + (mCt', m') <- withStore' $ \db -> createMemberContactInvited db user connIds g m mConn subMode + createItems mCt' m' + joinConn subMode = do + -- [incognito] send membership incognito profile + let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing False + -- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ) + dm <- encodeConnInfo $ XInfo p + joinAgentConnectionAsync user True connReq dm subMode + createItems mCt' m' = do + createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing + toView $ CRNewMemberContactReceivedInv user mCt' g m' + forM_ mContent_ $ \mc -> do + ci <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc) + toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat mCt') ci] + + securityCodeChanged :: Contact -> CM () + securityCodeChanged ct = do + toView $ CRContactVerificationReset user ct + createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing + + xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> CM () + xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId msg msgTs = do + when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName) + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case + Right author -> processForwardedMsg author msg + Left (SEGroupMemberNotFoundByMemberId _) -> do + unknownAuthor <- createUnknownMember gInfo memberId + toView $ CRUnknownMemberCreated user gInfo m unknownAuthor + processForwardedMsg unknownAuthor msg + Left e -> throwError $ ChatErrorStore e + where + -- Note: forwarded group events (see forwardedGroupMsg) should include msgId to be deduplicated + processForwardedMsg :: GroupMember -> ChatMessage 'Json -> CM () + processForwardedMsg author chatMsg = do + let body = LB.toStrict $ J.encode msg + rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} <- saveGroupFwdRcvMsg user groupId m author body chatMsg + case event of + XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True + XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr + XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent rcvMsg msgTs ttl live + XMsgDel sharedMsgId memId -> groupMessageDelete gInfo author sharedMsgId memId rcvMsg msgTs + XMsgReact sharedMsgId (Just memId) reaction add -> groupMsgReaction gInfo author sharedMsgId memId reaction add rcvMsg msgTs + XFileCancel sharedMsgId -> xFileCancelGroup gInfo author sharedMsgId + XInfo p -> xInfoMember gInfo author p msgTs + XGrpMemNew memInfo -> xGrpMemNew gInfo author memInfo rcvMsg msgTs + XGrpMemRole memId memRole -> xGrpMemRole gInfo author memId memRole rcvMsg msgTs + XGrpMemDel memId -> xGrpMemDel gInfo author memId rcvMsg msgTs + XGrpLeave -> xGrpLeave gInfo author rcvMsg msgTs + XGrpDel -> xGrpDel gInfo author rcvMsg msgTs + XGrpInfo p' -> xGrpInfo gInfo author p' rcvMsg msgTs + XGrpPrefs ps' -> xGrpPrefs gInfo author ps' + _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event) + + createUnknownMember :: GroupInfo -> MemberId -> CM GroupMember + createUnknownMember gInfo memberId = do + let name = T.take 7 . safeDecodeUtf8 . B64.encode . unMemberId $ memberId + withStore $ \db -> createNewUnknownGroupMember db vr user gInfo memberId name + + directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM () + directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta `catchChatError` \_ -> pure () + forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do + withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus + updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete + + groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM () + groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do + checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure () + forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do + withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus + updateGroupItemsStatus gInfo m conn agentMsgId (GSSRcvd msgRcptStatus) Nothing + + -- Searches chat items for many agent message IDs and updates their status + updateDirectItemsStatusMsgs :: Contact -> Connection -> [AgentMsgId] -> CIStatus 'MDSnd -> CM () + updateDirectItemsStatusMsgs ct conn msgIds newStatus = do + cis <- withStore' $ \db -> forM msgIds $ \msgId -> runExceptT $ updateDirectItemsStatus' db ct conn msgId newStatus + let acis = map ctItem $ concat $ rights cis + unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + where + ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) + + updateDirectItemStatus :: Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> CM () + updateDirectItemStatus ct conn msgId newStatus = do + cis <- withStore $ \db -> updateDirectItemsStatus' db ct conn msgId newStatus + let acis = map ctItem cis + unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + where + ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) + + updateDirectItemsStatus' :: DB.Connection -> Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> ExceptT StoreError IO [ChatItem 'CTDirect 'MDSnd] + updateDirectItemsStatus' db ct@Contact {contactId} Connection {connId} msgId newStatus = do + items <- liftIO $ getDirectChatItemsByAgentMsgId db user contactId connId msgId + catMaybes <$> mapM updateItem items + where + updateItem :: CChatItem 'CTDirect -> ExceptT StoreError IO (Maybe (ChatItem 'CTDirect 'MDSnd)) + updateItem = \case + (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _ _}}) -> pure Nothing + (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) + | itemStatus == newStatus -> pure Nothing + | otherwise -> Just <$> updateDirectChatItemStatus db user ct itemId newStatus + _ -> pure Nothing + + updateGroupMemSndStatus' :: DB.Connection -> ChatItemId -> GroupMemberId -> GroupSndStatus -> IO Bool + updateGroupMemSndStatus' db itemId groupMemberId newStatus = + runExceptT (getGroupSndStatus db itemId groupMemberId) >>= \case + Right (GSSRcvd _) -> pure False + Right memStatus + | memStatus == newStatus -> pure False + | otherwise -> updateGroupSndStatus db itemId groupMemberId newStatus $> True + _ -> pure False + + updateGroupItemsStatus :: GroupInfo -> GroupMember -> Connection -> AgentMsgId -> GroupSndStatus -> Maybe Bool -> CM () + updateGroupItemsStatus gInfo@GroupInfo {groupId} GroupMember {groupMemberId} Connection {connId} msgId newMemStatus viaProxy_ = do + items <- withStore' (\db -> getGroupChatItemsByAgentMsgId db user groupId connId msgId) + cis <- catMaybes <$> withStore (\db -> mapM (updateItem db) items) + let acis = map gItem cis + unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + where + gItem = AChatItem SCTGroup SMDSnd (GroupChat gInfo) + updateItem :: DB.Connection -> CChatItem 'CTGroup -> ExceptT StoreError IO (Maybe (ChatItem 'CTGroup 'MDSnd)) + updateItem db = \case + (CChatItem SMDSnd ChatItem {meta = CIMeta {itemStatus = CISSndRcvd _ SSPComplete}}) -> pure Nothing + (CChatItem SMDSnd ChatItem {meta = CIMeta {itemId, itemStatus}}) -> do + forM_ viaProxy_ $ \viaProxy -> liftIO $ setGroupSndViaProxy db itemId groupMemberId viaProxy + memStatusChanged <- liftIO $ updateGroupMemSndStatus' db itemId groupMemberId newMemStatus + if memStatusChanged + then do + memStatusCounts <- liftIO $ getGroupSndStatusCounts db itemId + let newStatus = membersGroupItemStatus memStatusCounts + if newStatus /= itemStatus + then Just <$> updateGroupChatItemStatus db user gInfo itemId newStatus + else pure Nothing + else pure Nothing + _ -> pure Nothing diff --git a/src/Simplex/Chat/Migrations/M20241222_operator_conditions.hs b/src/Simplex/Chat/Migrations/M20241222_operator_conditions.hs new file mode 100644 index 0000000000..c0c4304313 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20241222_operator_conditions.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20241222_operator_conditions where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20241222_operator_conditions :: Query +m20241222_operator_conditions = + [sql| +ALTER TABLE operator_usage_conditions ADD COLUMN auto_accepted INTEGER DEFAULT 0; +|] + +down_m20241222_operator_conditions :: Query +down_m20241222_operator_conditions = + [sql| +ALTER TABLE operator_usage_conditions DROP COLUMN auto_accepted; +|] diff --git a/src/Simplex/Chat/Migrations/M20241223_chat_tags.hs b/src/Simplex/Chat/Migrations/M20241223_chat_tags.hs new file mode 100644 index 0000000000..a83be7549d --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20241223_chat_tags.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20241223_chat_tags where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20241223_chat_tags :: Query +m20241223_chat_tags = + [sql| +CREATE TABLE chat_tags ( + chat_tag_id INTEGER PRIMARY KEY AUTOINCREMENT, + user_id INTEGER REFERENCES users, + chat_tag_text TEXT NOT NULL, + chat_tag_emoji TEXT, + tag_order INTEGER NOT NULL +); + +CREATE TABLE chat_tags_chats ( + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_id INTEGER REFERENCES groups ON DELETE CASCADE, + chat_tag_id INTEGER NOT NULL REFERENCES chat_tags ON DELETE CASCADE +); + +CREATE INDEX idx_chat_tags_user_id ON chat_tags(user_id); +CREATE UNIQUE INDEX idx_chat_tags_user_id_chat_tag_text ON chat_tags(user_id, chat_tag_text); +CREATE UNIQUE INDEX idx_chat_tags_user_id_chat_tag_emoji ON chat_tags(user_id, chat_tag_emoji); + +CREATE INDEX idx_chat_tags_chats_chat_tag_id ON chat_tags_chats(chat_tag_id); +CREATE UNIQUE INDEX idx_chat_tags_chats_chat_tag_id_contact_id ON chat_tags_chats(contact_id, chat_tag_id); +CREATE UNIQUE INDEX idx_chat_tags_chats_chat_tag_id_group_id ON chat_tags_chats(group_id, chat_tag_id); +|] + +down_m20241223_chat_tags :: Query +down_m20241223_chat_tags = + [sql| +DROP INDEX idx_chat_tags_user_id; +DROP INDEX idx_chat_tags_user_id_chat_tag_text; +DROP INDEX idx_chat_tags_user_id_chat_tag_emoji; + +DROP INDEX idx_chat_tags_chats_chat_tag_id; +DROP INDEX idx_chat_tags_chats_chat_tag_id_contact_id; +DROP INDEX idx_chat_tags_chats_chat_tag_id_group_id; + +DROP TABLE chat_tags_chats; +DROP TABLE chat_tags; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 94ccc65b7f..7ddbc84e4a 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -622,6 +622,20 @@ CREATE TABLE operator_usage_conditions( conditions_commit TEXT NOT NULL, accepted_at TEXT, created_at TEXT NOT NULL DEFAULT(datetime('now')) + , + auto_accepted INTEGER DEFAULT 0 +); +CREATE TABLE chat_tags( + chat_tag_id INTEGER PRIMARY KEY AUTOINCREMENT, + user_id INTEGER REFERENCES users, + chat_tag_text TEXT NOT NULL, + chat_tag_emoji TEXT, + tag_order INTEGER NOT NULL +); +CREATE TABLE chat_tags_chats( + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_id INTEGER REFERENCES groups ON DELETE CASCADE, + chat_tag_id INTEGER NOT NULL REFERENCES chat_tags ON DELETE CASCADE ); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, @@ -929,3 +943,21 @@ CREATE INDEX idx_chat_items_notes ON chat_items( created_at ); CREATE INDEX idx_groups_business_xcontact_id ON groups(business_xcontact_id); +CREATE INDEX idx_chat_tags_user_id ON chat_tags(user_id); +CREATE UNIQUE INDEX idx_chat_tags_user_id_chat_tag_text ON chat_tags( + user_id, + chat_tag_text +); +CREATE UNIQUE INDEX idx_chat_tags_user_id_chat_tag_emoji ON chat_tags( + user_id, + chat_tag_emoji +); +CREATE INDEX idx_chat_tags_chats_chat_tag_id ON chat_tags_chats(chat_tag_id); +CREATE UNIQUE INDEX idx_chat_tags_chats_chat_tag_id_contact_id ON chat_tags_chats( + contact_id, + chat_tag_id +); +CREATE UNIQUE INDEX idx_chat_tags_chats_chat_tag_id_group_id ON chat_tags_chats( + group_id, + chat_tag_id +); diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 57b0ee6c17..4f39c5d6a0 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -36,6 +36,7 @@ import Foreign.Storable (poke) import GHC.IO.Encoding (setFileSystemEncoding, setForeignEncoding, setLocaleEncoding) import Simplex.Chat import Simplex.Chat.Controller +import Simplex.Chat.Library.Commands import Simplex.Chat.Markdown (ParsedMarkdown (..), parseMaybeMarkdownList) import Simplex.Chat.Mobile.File import Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index e14e95211a..9eda85aaf3 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/src/Simplex/Chat/Operators.hs @@ -167,7 +167,7 @@ conditionsRequiredOrDeadline createdAt notifiedAtOrNow = conditionsDeadline = addUTCTime (31 * nominalDay) data ConditionsAcceptance - = CAAccepted {acceptedAt :: Maybe UTCTime} + = CAAccepted {acceptedAt :: Maybe UTCTime, autoAccepted :: Bool} | CARequired {deadline :: Maybe UTCTime} deriving (Show) diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index db787b0112..6783dae99e 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -21,11 +21,14 @@ where import Control.Applicative ((<|>)) import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class +import Data.Bitraversable (bitraverse) import Data.Int (Int64) import Data.Maybe (catMaybes, fromMaybe) import Database.SQLite.Simple (Only (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) import Simplex.Chat.Protocol +import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Files import Simplex.Chat.Store.Groups import Simplex.Chat.Store.Profiles @@ -93,8 +96,9 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do (userId, agentConnId) getContactRec_ :: Int64 -> Connection -> ExceptT StoreError IO Contact getContactRec_ contactId c = ExceptT $ do - toContact' contactId c - <$> DB.query + chatTags <- getDirectChatTags db contactId + firstRow (toContact' contactId c chatTags) (SEInternalError "referenced contact not found") $ + DB.query db [sql| SELECT @@ -105,17 +109,16 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0 |] (userId, contactId) - toContact' :: Int64 -> Connection -> [ContactRow'] -> Either StoreError Contact - toContact' contactId conn [(profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)] = + toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact + toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn activeConn = Just conn - in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData} - toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" + in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, chatTags, uiThemes, chatDeleted, customData} getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember) - getGroupAndMember_ groupMemberId c = ExceptT $ do - firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $ + getGroupAndMember_ groupMemberId c = do + gm <- ExceptT $ firstRow (toGroupAndMember c) (SEInternalError "referenced group member not found") $ DB.query db [sql| @@ -141,9 +144,10 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ? |] (groupMemberId, userId, userContactId) + liftIO $ bitraverse (addGroupChatTags db) pure gm toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember) toGroupAndMember c (groupInfoRow :. memberRow) = - let groupInfo = toGroupInfo vr userContactId groupInfoRow + let groupInfo = toGroupInfo vr userContactId [] groupInfoRow member = toGroupMember userContactId memberRow in (groupInfo, (member :: GroupMember) {activeConn = Just c}) getConnSndFileTransfer_ :: Int64 -> Connection -> ExceptT StoreError IO SndFileTransfer diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index d5396a0fef..7697f5d5d8 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -79,6 +79,8 @@ module Simplex.Chat.Store.Direct setContactCustomData, setContactUIThemes, setContactChatDeleted, + getDirectChatTags, + updateDirectChatTags, ) where @@ -180,8 +182,8 @@ getConnReqContactXContactId db vr user@User {userId} cReqHash = do (userId, cReqHash) getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact) -getContactByConnReqHash db vr user@User {userId} cReqHash = - maybeFirstRow (toContact vr user) $ +getContactByConnReqHash db vr user@User {userId} cReqHash = do + ct_ <- maybeFirstRow (toContact vr user []) $ DB.query db [sql| @@ -201,6 +203,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash = LIMIT 1 |] (userId, cReqHash, CSActive) + mapM (addDirectChatTags db) ct_ createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode chatV pqSup = do @@ -251,6 +254,7 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, + chatTags = [], uiThemes = Nothing, chatDeleted = False, customData = Nothing @@ -636,8 +640,8 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact ) insertedRowId db getContact' :: XContactId -> IO (Maybe Contact) - getContact' xContactId = - maybeFirstRow (toContact vr user) $ + getContact' xContactId = do + ct_ <- maybeFirstRow (toContact vr user []) $ DB.query db [sql| @@ -657,13 +661,15 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact LIMIT 1 |] (userId, xContactId) + mapM (addDirectChatTags db) ct_ getGroupInfo' :: XContactId -> IO (Maybe GroupInfo) - getGroupInfo' xContactId = - maybeFirstRow (toGroupInfo vr userContactId) $ + getGroupInfo' xContactId = do + g_ <- maybeFirstRow (toGroupInfo vr userContactId []) $ DB.query db (groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?") (xContactId, userId, userContactId) + mapM (addGroupChatTags db) g_ getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest) getContactRequestByXContactId xContactId = maybeFirstRow toContactRequest $ @@ -819,6 +825,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False, + chatTags = [], uiThemes = Nothing, chatDeleted = False, customData = Nothing @@ -845,8 +852,9 @@ getContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT Stor getContact db vr user contactId = getContact_ db vr user contactId False getContact_ :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact -getContact_ db vr user@User {userId} contactId deleted = - ExceptT . firstRow (toContact vr user) (SEContactNotFound contactId) $ +getContact_ db vr user@User {userId} contactId deleted = do + chatTags <- liftIO $ getDirectChatTags db contactId + ExceptT . firstRow (toContact vr user chatTags) (SEContactNotFound contactId) $ DB.query db [sql| @@ -1018,3 +1026,39 @@ setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO () setContactChatDeleted db User {userId} Contact {contactId} chatDeleted = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (chatDeleted, updatedAt, userId, contactId) + +updateDirectChatTags :: DB.Connection -> ContactId -> [ChatTagId] -> IO () +updateDirectChatTags db contactId tIds = do + currentTags <- getDirectChatTags db contactId + let tagsToAdd = filter (`notElem` currentTags) tIds + tagsToDelete = filter (`notElem` tIds) currentTags + forM_ tagsToDelete $ untagDirectChat db contactId + forM_ tagsToAdd $ tagDirectChat db contactId + +tagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO () +tagDirectChat db contactId tId = + DB.execute + db + [sql| + INSERT INTO chat_tags_chats (contact_id, chat_tag_id) + VALUES (?,?) + |] + (contactId, tId) + +untagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO () +untagDirectChat db contactId tId = + DB.execute + db + [sql| + DELETE FROM chat_tags_chats + WHERE contact_id = ? AND chat_tag_id = ? + |] + (contactId, tId) + +getDirectChatTags :: DB.Connection -> ContactId -> IO [ChatTagId] +getDirectChatTags db contactId = map fromOnly <$> DB.query db "SELECT chat_tag_id FROM chat_tags_chats WHERE contact_id = ?" (Only contactId) + +addDirectChatTags :: DB.Connection -> Contact -> IO Contact +addDirectChatTags db ct = do + chatTags <- getDirectChatTags db $ contactId' ct + pure (ct :: Contact) {chatTags} diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 36ce7f3575..98173800cc 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -122,6 +122,8 @@ module Simplex.Chat.Store.Groups updateUserMemberProfileSentAt, setGroupCustomData, setGroupUIThemes, + updateGroupChatTags, + getGroupChatTags, ) where @@ -130,6 +132,7 @@ import Control.Monad.Except import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG) import Data.Bifunctor (second) +import Data.Bitraversable (bitraverse) import Data.Either (rights) import Data.Int (Int64) import Data.List (partition, sortOn) @@ -249,8 +252,8 @@ setGroupLinkMemberRole db User {userId} userContactLinkId memberRole = DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId) getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember) -getGroupAndMember db User {userId, userContactId} groupMemberId vr = - ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $ +getGroupAndMember db User {userId, userContactId} groupMemberId vr = do + gm <- ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $ DB.query db [sql| @@ -285,10 +288,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ? |] (userId, groupMemberId, userId, userContactId) + liftIO $ bitraverse (addGroupChatTags db) pure gm where toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember) toGroupAndMember (groupInfoRow :. memberRow :. connRow) = - let groupInfo = toGroupInfo vr userContactId groupInfoRow + let groupInfo = toGroupInfo vr userContactId [] groupInfoRow member = toGroupMember userContactId memberRow in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow}) @@ -333,6 +337,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc updatedAt = currentTs, chatTs = Just currentTs, userMemberProfileSentAt = Just currentTs, + chatTags = [], uiThemes = Nothing, customData = Nothing } @@ -401,6 +406,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ updatedAt = currentTs, chatTs = Just currentTs, userMemberProfileSentAt = Just currentTs, + chatTags = [], uiThemes = Nothing, customData = Nothing }, @@ -624,8 +630,8 @@ getUserGroups db vr user@User {userId} = do rights <$> mapM (runExceptT . getGroup db vr user) groupIds getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] -getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = - map (toGroupInfo vr userContactId) +getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do + g_ <- map (toGroupInfo vr userContactId []) <$> DB.query db [sql| @@ -643,6 +649,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = AND (gp.display_name LIKE '%' || ? || '%' OR gp.full_name LIKE '%' || ? || '%' OR gp.description LIKE '%' || ? || '%') |] (userId, userContactId, search, search, search) + mapM (addGroupChatTags db) g_ where search = fromMaybe "" search_ @@ -1362,8 +1369,8 @@ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff getViaGroupMember :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) -getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = - maybeFirstRow toGroupAndMember $ +getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do + gm_ <- maybeFirstRow toGroupAndMember $ DB.query db [sql| @@ -1399,10 +1406,11 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = WHERE ct.user_id = ? AND ct.contact_id = ? AND mu.contact_id = ? AND ct.deleted = 0 |] (userId, userId, contactId, userContactId) + mapM (bitraverse (addGroupChatTags db) pure) gm_ where toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember) toGroupAndMember (groupInfoRow :. memberRow :. connRow) = - let groupInfo = toGroupInfo vr userContactId groupInfoRow + let groupInfo = toGroupInfo vr userContactId [] groupInfoRow member = toGroupMember userContactId memberRow in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow}) @@ -1482,22 +1490,24 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName updateGroupProfile db user g' p' where getGroupProfile = - ExceptT $ firstRow toGroupProfile (SEGroupNotFound groupId) $ - DB.query - db - [sql| + ExceptT $ + firstRow toGroupProfile (SEGroupNotFound groupId) $ + DB.query + db + [sql| SELECT gp.display_name, gp.full_name, gp.description, gp.image, gp.preferences FROM group_profiles gp JOIN groups g ON gp.group_profile_id = g.group_profile_id WHERE g.group_id = ? |] - (Only groupId) + (Only groupId) toGroupProfile (displayName, fullName, description, image, groupPreferences) = GroupProfile {displayName, fullName, description, image, groupPreferences} getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo -getGroupInfo db vr User {userId, userContactId} groupId = - ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $ +getGroupInfo db vr User {userId, userContactId} groupId = ExceptT $ do + chatTags <- getGroupChatTags db groupId + firstRow (toGroupInfo vr userContactId chatTags) (SEGroupNotFound groupId) $ DB.query db (groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?") @@ -2053,7 +2063,7 @@ createMemberContact quotaErrCounter = 0 } mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing} + pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, chatTags = [], uiThemes = Nothing, chatDeleted = False, customData = Nothing} getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) getMemberContact db vr user contactId = do @@ -2090,7 +2100,7 @@ createMemberContactInvited contactId <- createContactUpdateMember currentTs userPreferences ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing} + mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, chatTags = [], uiThemes = Nothing, chatDeleted = False, customData = Nothing} m' = m {memberContactId = Just contactId} pure (mCt', m') where @@ -2301,3 +2311,31 @@ setGroupUIThemes :: DB.Connection -> User -> GroupInfo -> Maybe UIThemeEntityOve setGroupUIThemes db User {userId} GroupInfo {groupId} uiThemes = do updatedAt <- getCurrentTime DB.execute db "UPDATE groups SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (uiThemes, updatedAt, userId, groupId) + +updateGroupChatTags :: DB.Connection -> GroupId -> [ChatTagId] -> IO () +updateGroupChatTags db gId tIds = do + currentTags <- getGroupChatTags db gId + let tagsToAdd = filter (`notElem` currentTags) tIds + tagsToDelete = filter (`notElem` tIds) currentTags + forM_ tagsToDelete $ untagGroupChat db gId + forM_ tagsToAdd $ tagGroupChat db gId + +tagGroupChat :: DB.Connection -> GroupId -> ChatTagId -> IO () +tagGroupChat db groupId tId = + DB.execute + db + [sql| + INSERT INTO chat_tags_chats (group_id, chat_tag_id) + VALUES (?,?) + |] + (groupId, tId) + +untagGroupChat :: DB.Connection -> GroupId -> ChatTagId -> IO () +untagGroupChat db groupId tId = + DB.execute + db + [sql| + DELETE FROM chat_tags_chats + WHERE group_id = ? AND chat_tag_id = ? + |] + (groupId, tId) diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 65fe8223fe..33f5c329dc 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -119,6 +119,8 @@ import Simplex.Chat.Migrations.M20241027_server_operators import Simplex.Chat.Migrations.M20241125_indexes import Simplex.Chat.Migrations.M20241128_business_chats import Simplex.Chat.Migrations.M20241205_business_chat_members +import Simplex.Chat.Migrations.M20241222_operator_conditions +import Simplex.Chat.Migrations.M20241223_chat_tags import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -237,7 +239,9 @@ schemaMigrations = ("20241027_server_operators", m20241027_server_operators, Just down_m20241027_server_operators), ("20241125_indexes", m20241125_indexes, Just down_m20241125_indexes), ("20241128_business_chats", m20241128_business_chats, Just down_m20241128_business_chats), - ("20241205_business_chat_members", m20241205_business_chat_members, Just down_m20241205_business_chat_members) + ("20241205_business_chat_members", m20241205_business_chat_members, Just down_m20241205_business_chat_members), + ("20241222_operator_conditions", m20241222_operator_conditions, Just down_m20241222_operator_conditions), + ("20241223_chat_tags", m20241223_chat_tags, Just down_m20241223_chat_tags) ] -- | 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 e88cf39feb..013075841e 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -627,13 +627,13 @@ getUpdateServerOperators db presetOps newUser = do DBNewEntity -> do op' <- insertOperator op case (operatorTag op', acceptForSimplex_) of - (Just OTSimplex, Just cond) -> autoAcceptConditions op' cond + (Just OTSimplex, Just cond) -> autoAcceptConditions op' cond now _ -> pure op' DBEntityId _ -> do updateOperator op getOperatorConditions_ db op currentConds latestAcceptedConds_ now >>= \case - CARequired Nothing | operatorTag op == Just OTSimplex -> autoAcceptConditions op currentConds - CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds + CARequired Nothing | operatorTag op == Just OTSimplex -> autoAcceptConditions op currentConds now + CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds now ca -> pure op {conditionsAcceptance = ca} where insertConditions UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt} = @@ -667,9 +667,9 @@ getUpdateServerOperators db presetOps newUser = do (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage smpRoles, proxy smpRoles, storage xftpRoles, proxy xftpRoles) opId <- insertedRowId db pure op {operatorId = DBEntityId opId} - autoAcceptConditions op UsageConditions {conditionsCommit} = - acceptConditions_ db op conditionsCommit Nothing - $> op {conditionsAcceptance = CAAccepted Nothing} + autoAcceptConditions op UsageConditions {conditionsCommit} now = + acceptConditions_ db op conditionsCommit now True + $> op {conditionsAcceptance = CAAccepted (Just now) True} serverOperatorQuery :: Query serverOperatorQuery = @@ -708,7 +708,7 @@ getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {condition DB.query db [sql| - SELECT conditions_commit, accepted_at + SELECT conditions_commit, accepted_at, auto_accepted FROM operator_usage_conditions WHERE server_operator_id = ? ORDER BY operator_usage_conditions_id DESC @@ -716,10 +716,10 @@ getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {condition |] (Only operatorId) pure $ case operatorAcceptedConds_ of - Just (operatorCommit, acceptedAt_) + Just (operatorCommit, acceptedAt_, autoAccept) | operatorCommit /= latestAcceptedCommit -> CARequired Nothing -- TODO should we consider this operator disabled? | currentCommit /= latestAcceptedCommit -> CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt) - | otherwise -> CAAccepted acceptedAt_ + | otherwise -> CAAccepted acceptedAt_ autoAccept _ -> CARequired Nothing -- no conditions were accepted for this operator getCurrentUsageConditions :: DB.Connection -> ExceptT StoreError IO UsageConditions @@ -763,24 +763,39 @@ acceptConditions :: DB.Connection -> Int64 -> NonEmpty Int64 -> UTCTime -> Excep acceptConditions db condId opIds acceptedAt = do UsageConditions {conditionsCommit} <- getUsageConditionsById_ db condId operators <- mapM getServerOperator_ opIds - let ts = Just acceptedAt - liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit ts + liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit acceptedAt False where getServerOperator_ opId = ExceptT $ firstRow toServerOperator (SEOperatorNotFound opId) $ DB.query db (serverOperatorQuery <> " WHERE server_operator_id = ?") (Only opId) -acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> Maybe UTCTime -> IO () -acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt = - DB.execute - db - [sql| - INSERT INTO operator_usage_conditions - (server_operator_id, server_operator_tag, conditions_commit, accepted_at) - VALUES (?,?,?,?) - |] - (operatorId, operatorTag, conditionsCommit, acceptedAt) +acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> UTCTime -> Bool -> IO () +acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt autoAccepted = do + acceptedAt_ :: Maybe (Maybe UTCTime) <- maybeFirstRow fromOnly $ DB.query db "SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_id = ? AND conditions_commit == ?" (operatorId, conditionsCommit) + case acceptedAt_ of + Just Nothing -> + DB.execute + db + (q <> "ON CONFLICT (server_operator_id, conditions_commit) DO UPDATE SET accepted_at = ?, auto_accepted = ?") + (operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted, acceptedAt, autoAccepted) + Just (Just _) -> + DB.execute + db + (q <> "ON CONFLICT (server_operator_id, conditions_commit) DO NOTHING") + (operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted) + Nothing -> + DB.execute + db + q + (operatorId, operatorTag, conditionsCommit, acceptedAt, autoAccepted) + where + q = + [sql| + INSERT INTO operator_usage_conditions + (server_operator_id, server_operator_tag, conditions_commit, accepted_at, auto_accepted) + VALUES (?,?,?,?,?) + |] getUsageConditionsById_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UsageConditions getUsageConditionsById_ db conditionsId = diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 851078ec1f..c6ac85dbd3 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -9,6 +9,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat.Store.Shared where @@ -391,14 +392,14 @@ type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Mayb type ContactRow = Only ContactId :. ContactRow' -toContact :: VersionRangeChat -> User -> ContactRow :. MaybeConnectionRow -> Contact -toContact vr user ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) :. connRow) = +toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact +toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} activeConn = toMaybeConnection vr connRow chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} incognito = maybe False connIncognito activeConn mergedPreferences = contactUserPreferences user userPreferences preferences incognito - in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData} + in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, chatTags, uiThemes, chatDeleted, customData} getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile getProfileById db userId profileId = @@ -552,14 +553,14 @@ type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageD type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) -toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo -toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. businessRow :. (uiThemes, customData) :. userMemberRow) = +toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo +toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. businessRow :. (uiThemes, customData) :. userMemberRow) = let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} businessChat = toBusinessChatInfo businessRow - in GroupInfo {groupId, localDisplayName, groupProfile, businessChat, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData} + in GroupInfo {groupId, localDisplayName, groupProfile, businessChat, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, chatTags, uiThemes, customData} toGroupMember :: Int64 -> GroupMemberRow -> GroupMember toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) = @@ -592,3 +593,76 @@ groupInfoQuery = JOIN group_members mu ON mu.group_id = g.group_id JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id) |] + +createChatTag :: DB.Connection -> User -> Maybe Text -> Text -> IO ChatTagId +createChatTag db User {userId} emoji text = do + DB.execute + db + [sql| + INSERT INTO chat_tags (user_id, chat_tag_emoji, chat_tag_text, tag_order) + VALUES (?,?,?, COALESCE((SELECT MAX(tag_order) + 1 FROM chat_tags WHERE user_id = ?), 1)) + |] + (userId, emoji, text, userId) + insertedRowId db + +deleteChatTag :: DB.Connection -> User -> ChatTagId -> IO () +deleteChatTag db User {userId} tId = + DB.execute + db + [sql| + DELETE FROM chat_tags + WHERE user_id = ? AND chat_tag_id = ? + |] + (userId, tId) + +updateChatTag :: DB.Connection -> User -> ChatTagId -> Maybe Text -> Text -> IO () +updateChatTag db User {userId} tId emoji text = + DB.execute + db + [sql| + UPDATE chat_tags + SET chat_tag_emoji = ?, chat_tag_text = ? + WHERE user_id = ? AND chat_tag_id = ? + |] + (emoji, text, userId, tId) + +updateChatTagOrder :: DB.Connection -> User -> ChatTagId -> Int -> IO () +updateChatTagOrder db User {userId} tId order = + DB.execute + db + [sql| + UPDATE chat_tags + SET tag_order = ? + WHERE user_id = ? AND chat_tag_id = ? + |] + (order, userId, tId) + +reorderChatTags :: DB.Connection -> User -> [ChatTagId] -> IO () +reorderChatTags db user tIds = + forM_ (zip [1 ..] tIds) $ \(order, tId) -> + updateChatTagOrder db user tId order + +getUserChatTags :: DB.Connection -> User -> IO [ChatTag] +getUserChatTags db User {userId} = + map toChatTag + <$> DB.query + db + [sql| + SELECT chat_tag_id, chat_tag_emoji, chat_tag_text + FROM chat_tags + WHERE user_id = ? + ORDER BY tag_order + |] + (Only userId) + where + toChatTag :: (ChatTagId, Maybe Text, Text) -> ChatTag + toChatTag (chatTagId, chatTagEmoji, chatTagText) = ChatTag {chatTagId, chatTagEmoji, chatTagText} + +getGroupChatTags :: DB.Connection -> GroupId -> IO [ChatTagId] +getGroupChatTags db groupId = + map fromOnly <$> DB.query db "SELECT chat_tag_id FROM chat_tags_chats WHERE group_id = ?" (Only groupId) + +addGroupChatTags :: DB.Connection -> GroupInfo -> IO GroupInfo +addGroupChatTags db g@GroupInfo {groupId} = do + chatTags <- getGroupChatTags db groupId + pure (g :: GroupInfo) {chatTags} diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index aa6babfcbd..2ff9e60699 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -14,10 +14,11 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Database.SQLite.Simple (SQLError (..)) import qualified Database.SQLite.Simple as DB -import Simplex.Chat (_defaultNtfServers, defaultChatConfig, operatorSimpleXChat) +import Simplex.Chat (defaultChatConfig, operatorSimpleXChat) import Simplex.Chat.Controller import Simplex.Chat.Core import Simplex.Chat.Help (chatWelcome) +import Simplex.Chat.Library.Commands (_defaultNtfServers) import Simplex.Chat.Operators import Simplex.Chat.Options import Simplex.Chat.Terminal.Input diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 4f6d66d2c1..836bcd7ec8 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -29,8 +29,8 @@ import Database.SQLite.Simple (Only (..)) import qualified Database.SQLite.Simple as SQL import Database.SQLite.Simple.QQ (sql) import GHC.Weak (deRefWeak) -import Simplex.Chat import Simplex.Chat.Controller +import Simplex.Chat.Library.Commands import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent import Simplex.Chat.Styled diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 37c5c039c1..6c914c7c6d 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -21,8 +21,8 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) -import Simplex.Chat (execChatCommand, processChatCommand) import Simplex.Chat.Controller +import Simplex.Chat.Library.Commands (execChatCommand, processChatCommand) import Simplex.Chat.Markdown import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent (CIContent (..), SMsgDirection (..)) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 77a02a4bc1..716925a0d7 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -160,6 +160,8 @@ type ContactId = Int64 type ProfileId = Int64 +type ChatTagId = Int64 + data Contact = Contact { contactId :: ContactId, localDisplayName :: ContactName, @@ -176,6 +178,7 @@ data Contact = Contact chatTs :: Maybe UTCTime, contactGroupMemberId :: Maybe GroupMemberId, contactGrpInvSent :: Bool, + chatTags :: [ChatTagId], uiThemes :: Maybe UIThemeEntityOverrides, chatDeleted :: Bool, customData :: Maybe CustomData @@ -380,6 +383,7 @@ data GroupInfo = GroupInfo updatedAt :: UTCTime, chatTs :: Maybe UTCTime, userMemberProfileSentAt :: Maybe UTCTime, + chatTags :: [ChatTagId], uiThemes :: Maybe UIThemeEntityOverrides, customData :: Maybe CustomData } @@ -1637,6 +1641,13 @@ data CommandData = CommandData } deriving (Show) +data ChatTag = ChatTag + { chatTagId :: Int64, + chatTagText :: Text, + chatTagEmoji :: Maybe Text + } + deriving (Show) + -- ad-hoc type for data required for XGrpMemIntro continuation data XGrpMemIntroCont = XGrpMemIntroCont { groupId :: GroupId, @@ -1791,3 +1802,5 @@ $(JQ.deriveJSON defaultJSON ''Contact) $(JQ.deriveJSON defaultJSON ''ContactRef) $(JQ.deriveJSON defaultJSON ''NoteFolder) + +$(JQ.deriveJSON defaultJSON ''ChatTag) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8b6a545637..04a3be148c 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -36,10 +36,11 @@ import Data.Time.Format (defaultTimeLocale, formatTime) import qualified Data.Version as V import qualified Network.HTTP.Types as Q import Numeric (showFFloat) -import Simplex.Chat (defaultChatConfig, maxImageSize) +import Simplex.Chat (defaultChatConfig) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Help +import Simplex.Chat.Library.Commands (maxImageSize) import Simplex.Chat.Markdown import Simplex.Chat.Messages hiding (NewChatItem (..)) import Simplex.Chat.Messages.CIContent @@ -96,6 +97,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [viewJSON chats] CRChats chats -> viewChats ts tz chats CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat] + CRChatTags u tags -> ttyUser u $ [viewJSON tags] CRApiParsedMarkdown ft -> [viewJSON ft] CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure CRServerOperatorConditions (ServerOperatorConditions ops _ ca) -> viewServerOperators ops ca @@ -149,6 +151,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe | otherwise -> [] CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewItemUpdate chat item liveItems ts tz CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci + CRTagsUpdated u _ _ -> ttyUser u ["chat tags updated"] CRChatItemsDeleted u deletions byUser timed -> case deletions of [ChatItemDeletion (AChatItem _ _ chat deletedItem) toItem] -> ttyUser u $ unmuted u chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView @@ -1311,7 +1314,7 @@ viewOpIdTag ServerOperator {operatorId, operatorTag} = case operatorId of viewOpConditions :: ConditionsAcceptance -> Text viewOpConditions = \case - CAAccepted ts -> viewCond "accepted" ts + CAAccepted ts _ -> viewCond "accepted" ts CARequired ts -> viewCond "required" ts where viewCond w ts = w <> maybe "" (parens . tshow) ts diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 8b7e8fcd32..585ef70f6e 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -27,6 +27,7 @@ import Network.Socket import Simplex.Chat import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), defaultSimpleNetCfg) import Simplex.Chat.Core +import Simplex.Chat.Library.Commands import Simplex.Chat.Options import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion) import Simplex.Chat.Store @@ -463,6 +464,8 @@ smpServerCfg = logStatsStartTime = 0, serverStatsLogFile = "tests/smp-server-stats.daily.log", serverStatsBackupFile = Nothing, + prometheusInterval = Nothing, + prometheusMetricsFile = "tests/smp-server-metrics.txt", pendingENDInterval = 500000, ntfDeliveryInterval = 200000, smpServerVRange = supportedServerSMPRelayVRange, diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index c97193186b..98b995e4ec 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -14,8 +14,8 @@ import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Network.HTTP.Types.URI (urlEncode) -import Simplex.Chat (roundedFDCount) import Simplex.Chat.Controller (ChatConfig (..)) +import Simplex.Chat.Library.Internal (roundedFDCount) import Simplex.Chat.Mobile.File import Simplex.Chat.Options (ChatOpts (..)) import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..)) diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 3b861a8417..f347e1a396 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -9,9 +9,9 @@ import Control.Concurrent (threadDelay) import qualified Data.ByteString.Char8 as B import Data.List (intercalate) import qualified Data.Text as T -import System.Directory (copyFile, doesFileExist, removeFile) -import Simplex.Chat (fixedImagePreview) +import Simplex.Chat.Library.Commands (fixedImagePreview) import Simplex.Chat.Types (ImageData (..)) +import System.Directory (copyFile, doesFileExist, removeFile) import Test.Hspec hiding (it) chatForwardTests :: SpecWith FilePath @@ -740,7 +740,7 @@ testMultiForwardFiles = -- IDs to forward let msgId1 = (read msgIdZero :: Int) + 1 - msgIds = intercalate "," $ map (show . (msgId1 +)) [0..5] + msgIds = intercalate "," $ map (show . (msgId1 +)) [0 .. 5] bob ##> ("/_forward plan @2 " <> msgIds) bob <## "Files can be received: 1, 2, 3, 4" bob <## "5 message(s) out of 6 can be forwarded" diff --git a/tests/ValidNames.hs b/tests/ValidNames.hs index 0700d80846..bbc9c853ea 100644 --- a/tests/ValidNames.hs +++ b/tests/ValidNames.hs @@ -1,6 +1,6 @@ module ValidNames where -import Simplex.Chat +import Simplex.Chat.Library.Commands import Test.Hspec validNameTests :: Spec diff --git a/website/langs/ar.json b/website/langs/ar.json index 9274e71850..f257c1c747 100644 --- a/website/langs/ar.json +++ b/website/langs/ar.json @@ -255,5 +255,6 @@ "docs-dropdown-10": "الشفافية", "docs-dropdown-11": "الأسئلة الأكثر شيوعًا", "docs-dropdown-12": "الأمان", - "hero-overlay-card-3-p-3": "قامت Trail of Bits بمراجعة التصميم التعموي لبروتوكولات شبكة SimpleX في يوليو 2024. اقرأ المزيد." + "hero-overlay-card-3-p-3": "قامت Trail of Bits بمراجعة التصميم التعموي لبروتوكولات شبكة SimpleX في يوليو 2024. اقرأ المزيد.", + "docs-dropdown-14": "SimpleX للأعمال التجارية" } diff --git a/website/langs/de.json b/website/langs/de.json index c5d1fceefa..3b1e9d34e8 100644 --- a/website/langs/de.json +++ b/website/langs/de.json @@ -255,5 +255,6 @@ "docs-dropdown-10": "Transparent", "docs-dropdown-11": "FAQ", "docs-dropdown-12": "Sicherheit", - "hero-overlay-card-3-p-3": "Trail of Bits hat das kryptografische Design des Netzwerk-Protokolls von SimpleX im Juli 2024 überprüft. Hier finden Sie weitere Informationen dazu." + "hero-overlay-card-3-p-3": "Trail of Bits hat das kryptografische Design des Netzwerk-Protokolls von SimpleX im Juli 2024 überprüft. Hier finden Sie weitere Informationen dazu.", + "docs-dropdown-14": "SimpleX für geschäftliche Anwendungen" } diff --git a/website/langs/uk.json b/website/langs/uk.json index d055aa68a2..794c65c956 100644 --- a/website/langs/uk.json +++ b/website/langs/uk.json @@ -255,5 +255,6 @@ "docs-dropdown-11": "ПОШИРЕНІ ЗАПИТАННЯ", "docs-dropdown-10": "Прозорість", "docs-dropdown-12": "Безпека", - "hero-overlay-card-3-p-3": "Trail of Bits переглянув криптографічний дизайн мережевих протоколів SimpleX в липні 2024 року. Детальніше." + "hero-overlay-card-3-p-3": "Trail of Bits переглянув криптографічний дизайн мережевих протоколів SimpleX в липні 2024 року. Детальніше.", + "docs-dropdown-14": "SimpleX для бізнесу" } diff --git a/website/src/_includes/blog_previews/20241125.html b/website/src/_includes/blog_previews/20241125.html index 2a73e9ec9b..8e71807c0b 100644 --- a/website/src/_includes/blog_previews/20241125.html +++ b/website/src/_includes/blog_previews/20241125.html @@ -1,5 +1,3 @@ -

-
  • Welcome, Flux — the new servers in v6.2-beta.1!
  • What's the problem?
    • diff --git a/website/src/_includes/blog_previews/20241210.html b/website/src/_includes/blog_previews/20241210.html new file mode 100644 index 0000000000..48962be17a --- /dev/null +++ b/website/src/_includes/blog_previews/20241210.html @@ -0,0 +1,8 @@ +

    v6.2 is released:

    + +
      +
    • SimpleX Chat and Flux made an agreement to include Flux-operated servers into the app to improve metadata privacy in SimpleX network.
      • +
    • Business chats for better privacy and support of your customers.
      • +
    • Better user experience: open on the first unread, jump to quoted messages, see who reacted.
      • +
    • Improving notifications in iOS app.
      • +