android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 12:19:54 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

core: split response to two types, to improve iOS parsing memory usage (#5867)

Browse source 
* core: split response to two types, to improve iOS parsing memory usage

* ios: split core events to separate types

* comment

* limit more events to CLI

* fix parser

* simplemq
This commit is contained in:
Evgeny 2025-05-04 22:14:36 +01:00 • committed by GitHub
parent f5c706f2dd
commit a0d1cca389
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
31 changed files with 1394 additions and 1132 deletions
Download patch file Download diff file Expand all files Collapse all files

497
apps/ios/Shared/Model/AppAPITypes.swift
View file

@ -587,7 +587,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case chatStarted
case chatRunning
case chatStopped
case chatSuspended
case apiChats(user: UserRef, chats: [ChatData])
case apiChat(user: UserRef, chat: ChatData, navInfo: NavigationInfo?)
case chatTags(user: UserRef, userTags: [ChatTag])
@ -606,14 +605,8 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case groupMemberSwitchStarted(user: UserRef, groupInfo: GroupInfo, member: GroupMember, connectionStats: ConnectionStats)
case contactSwitchAborted(user: UserRef, contact: Contact, connectionStats: ConnectionStats)
case groupMemberSwitchAborted(user: UserRef, groupInfo: GroupInfo, member: GroupMember, connectionStats: ConnectionStats)
case contactSwitch(user: UserRef, contact: Contact, switchProgress: SwitchProgress)
case groupMemberSwitch(user: UserRef, groupInfo: GroupInfo, member: GroupMember, switchProgress: SwitchProgress)
case contactRatchetSyncStarted(user: UserRef, contact: Contact, connectionStats: ConnectionStats)
case groupMemberRatchetSyncStarted(user: UserRef, groupInfo: GroupInfo, member: GroupMember, connectionStats: ConnectionStats)
case contactRatchetSync(user: UserRef, contact: Contact, ratchetSyncProgress: RatchetSyncProgress)
case groupMemberRatchetSync(user: UserRef, groupInfo: GroupInfo, member: GroupMember, ratchetSyncProgress: RatchetSyncProgress)
case contactVerificationReset(user: UserRef, contact: Contact)
case groupMemberVerificationReset(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
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)
@ -627,7 +620,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case sentInvitationToContact(user: UserRef, contact: Contact, customUserProfile: Profile?)
case contactAlreadyExists(user: UserRef, contact: Contact)
case contactDeleted(user: UserRef, contact: Contact)
case contactDeletedByContact(user: UserRef, contact: Contact)
case chatCleared(user: UserRef, chatInfo: ChatInfo)
case userProfileNoChange(user: User)
case userProfileUpdated(user: User, fromProfile: Profile, toProfile: Profile, updateSummary: UserProfileUpdateSummary)
@ -640,113 +632,57 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case userContactLinkUpdated(user: User, contactLink: UserContactLink)
case userContactLinkCreated(user: User, connLinkContact: CreatedConnLink)
case userContactLinkDeleted(user: User)
case contactConnected(user: UserRef, contact: Contact, userCustomProfile: Profile?)
case contactConnecting(user: UserRef, contact: Contact)
case contactSndReady(user: UserRef, contact: Contact)
case receivedContactRequest(user: UserRef, contactRequest: UserContactRequest)
case acceptingContactRequest(user: UserRef, contact: Contact)
case contactRequestRejected(user: UserRef)
case contactUpdated(user: UserRef, toContact: Contact)
case groupMemberUpdated(user: UserRef, groupInfo: GroupInfo, fromMember: GroupMember, toMember: GroupMember)
case networkStatus(networkStatus: NetworkStatus, connections: [String])
case networkStatuses(user_: UserRef?, networkStatuses: [ConnNetworkStatus])
case groupSubscribed(user: UserRef, groupInfo: GroupRef)
case memberSubErrors(user: UserRef, memberSubErrors: [MemberSubError])
case groupEmpty(user: UserRef, groupInfo: GroupInfo)
case userContactLinkSubscribed
case newChatItems(user: UserRef, chatItems: [AChatItem])
case groupChatItemsDeleted(user: UserRef, groupInfo: GroupInfo, chatItemIDs: Set<Int64>, byUser: Bool, member_: GroupMember?)
case forwardPlan(user: UserRef, chatItemIds: [Int64], forwardConfirmation: ForwardConfirmation?)
case chatItemsStatusesUpdated(user: UserRef, chatItems: [AChatItem])
case chatItemUpdated(user: UserRef, chatItem: AChatItem)
case chatItemNotChanged(user: UserRef, chatItem: AChatItem)
case chatItemReaction(user: UserRef, added: Bool, reaction: ACIReaction)
case reactionMembers(user: UserRef, memberReactions: [MemberReaction])
case chatItemsDeleted(user: UserRef, chatItemDeletions: [ChatItemDeletion], byUser: Bool)
case contactsList(user: UserRef, contacts: [Contact])
// group events
// group responses
case groupCreated(user: UserRef, groupInfo: GroupInfo)
case sentGroupInvitation(user: UserRef, groupInfo: GroupInfo, contact: Contact, member: GroupMember)
case userAcceptedGroupSent(user: UserRef, groupInfo: GroupInfo, hostContact: Contact?)
case groupLinkConnecting(user: UserRef, groupInfo: GroupInfo, hostMember: GroupMember)
case businessLinkConnecting(user: UserRef, groupInfo: GroupInfo, hostMember: GroupMember, fromContact: Contact)
case userDeletedMembers(user: UserRef, groupInfo: GroupInfo, members: [GroupMember], withMessages: Bool)
case leftMemberUser(user: UserRef, groupInfo: GroupInfo)
case groupMembers(user: UserRef, group: SimpleXChat.Group)
case receivedGroupInvitation(user: UserRef, groupInfo: GroupInfo, contact: Contact, memberRole: GroupMemberRole)
case groupDeletedUser(user: UserRef, groupInfo: GroupInfo)
case joinedGroupMemberConnecting(user: UserRef, groupInfo: GroupInfo, hostMember: GroupMember, member: GroupMember)
case memberRole(user: UserRef, groupInfo: GroupInfo, byMember: GroupMember, member: GroupMember, fromRole: GroupMemberRole, toRole: GroupMemberRole)
case membersRoleUser(user: UserRef, groupInfo: GroupInfo, members: [GroupMember], toRole: GroupMemberRole)
case memberBlockedForAll(user: UserRef, groupInfo: GroupInfo, byMember: GroupMember, member: GroupMember, blocked: Bool)
case membersBlockedForAllUser(user: UserRef, groupInfo: GroupInfo, members: [GroupMember], blocked: Bool)
case deletedMemberUser(user: UserRef, groupInfo: GroupInfo, member: GroupMember, withMessages: Bool)
case deletedMember(user: UserRef, groupInfo: GroupInfo, byMember: GroupMember, deletedMember: GroupMember, withMessages: Bool)
case leftMember(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
case groupDeleted(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
case contactsMerged(user: UserRef, intoContact: Contact, mergedContact: Contact)
case groupInvitation(user: UserRef, groupInfo: GroupInfo) // unused
case userJoinedGroup(user: UserRef, groupInfo: GroupInfo)
case joinedGroupMember(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
case connectedToGroupMember(user: UserRef, groupInfo: GroupInfo, member: GroupMember, memberContact: Contact?)
case groupRemoved(user: UserRef, groupInfo: GroupInfo) // unused
case groupUpdated(user: UserRef, toGroup: GroupInfo)
case groupLinkCreated(user: UserRef, groupInfo: GroupInfo, connLinkContact: CreatedConnLink, memberRole: GroupMemberRole)
case groupLink(user: UserRef, groupInfo: GroupInfo, connLinkContact: CreatedConnLink, memberRole: GroupMemberRole)
case groupLinkDeleted(user: UserRef, groupInfo: GroupInfo)
case newMemberContact(user: UserRef, contact: Contact, groupInfo: GroupInfo, member: GroupMember)
case newMemberContactSentInv(user: UserRef, contact: Contact, groupInfo: GroupInfo, member: GroupMember)
case newMemberContactReceivedInv(user: UserRef, contact: Contact, groupInfo: GroupInfo, member: GroupMember)
// receiving file events
// receiving file responses
case rcvFileAccepted(user: UserRef, chatItem: AChatItem)
case rcvFileAcceptedSndCancelled(user: UserRef, rcvFileTransfer: RcvFileTransfer)
case standaloneFileInfo(fileMeta: MigrationFileLinkData?)
case rcvStandaloneFileCreated(user: UserRef, rcvFileTransfer: RcvFileTransfer)
case rcvFileStart(user: UserRef, chatItem: AChatItem) // send by chats
case rcvFileProgressXFTP(user: UserRef, chatItem_: AChatItem?, receivedSize: Int64, totalSize: Int64, rcvFileTransfer: RcvFileTransfer)
case rcvFileComplete(user: UserRef, chatItem: AChatItem)
case rcvStandaloneFileComplete(user: UserRef, targetPath: String, rcvFileTransfer: RcvFileTransfer)
case rcvFileCancelled(user: UserRef, chatItem_: AChatItem?, rcvFileTransfer: RcvFileTransfer)
case rcvFileSndCancelled(user: UserRef, chatItem: AChatItem, rcvFileTransfer: RcvFileTransfer)
case rcvFileError(user: UserRef, chatItem_: AChatItem?, agentError: AgentErrorType, rcvFileTransfer: RcvFileTransfer)
case rcvFileWarning(user: UserRef, chatItem_: AChatItem?, agentError: AgentErrorType, rcvFileTransfer: RcvFileTransfer)
// sending file events
case sndFileStart(user: UserRef, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileComplete(user: UserRef, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileRcvCancelled(user: UserRef, chatItem_: AChatItem?, sndFileTransfer: SndFileTransfer)
// sending file responses
case sndFileCancelled(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, sndFileTransfers: [SndFileTransfer])
case sndStandaloneFileCreated(user: UserRef, fileTransferMeta: FileTransferMeta) // returned by _upload
case sndFileStartXFTP(user: UserRef, chatItem: AChatItem, fileTransferMeta: FileTransferMeta) // not used
case sndFileProgressXFTP(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, sentSize: Int64, totalSize: Int64)
case sndFileRedirectStartXFTP(user: UserRef, fileTransferMeta: FileTransferMeta, redirectMeta: FileTransferMeta)
case sndFileCompleteXFTP(user: UserRef, chatItem: AChatItem, fileTransferMeta: FileTransferMeta)
case sndStandaloneFileComplete(user: UserRef, fileTransferMeta: FileTransferMeta, rcvURIs: [String])
case sndFileCancelledXFTP(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta)
case sndFileError(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
case sndFileWarning(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
// call events
case callInvitation(callInvitation: RcvCallInvitation)
case callOffer(user: UserRef, contact: Contact, callType: CallType, offer: WebRTCSession, sharedKey: String?, askConfirmation: Bool)
case callAnswer(user: UserRef, contact: Contact, answer: WebRTCSession)
case callExtraInfo(user: UserRef, contact: Contact, extraInfo: WebRTCExtraInfo)
case callEnded(user: UserRef, contact: Contact)
// call invitations
case callInvitations(callInvitations: [RcvCallInvitation])
// notifications
case ntfTokenStatus(status: NtfTknStatus)
case ntfToken(token: DeviceToken, status: NtfTknStatus, ntfMode: NotificationsMode, ntfServer: String)
case ntfConns(ntfConns: [NtfConn])
case connNtfMessages(receivedMsgs: [NtfMsgInfo?])
case ntfMessage(user: UserRef, connEntity: ConnectionEntity, ntfMessage: NtfMsgAckInfo)
case contactConnectionDeleted(user: UserRef, connection: PendingContactConnection)
case contactDisabled(user: UserRef, contact: Contact)
// remote desktop responses/events
// remote desktop responses
case remoteCtrlList(remoteCtrls: [RemoteCtrlInfo])
case remoteCtrlFound(remoteCtrl: RemoteCtrlInfo, ctrlAppInfo_: CtrlAppInfo?, appVersion: String, compatible: Bool)
case remoteCtrlConnecting(remoteCtrl_: RemoteCtrlInfo?, ctrlAppInfo: CtrlAppInfo, appVersion: String)
case remoteCtrlSessionCode(remoteCtrl_: RemoteCtrlInfo?, sessionCode: String)
case remoteCtrlConnected(remoteCtrl: RemoteCtrlInfo)
case remoteCtrlStopped(rcsState: RemoteCtrlSessionState, rcStopReason: RemoteCtrlStopReason)
// pq
case contactPQEnabled(user: UserRef, contact: Contact, pqEnabled: Bool)
// misc
case versionInfo(versionInfo: CoreVersionInfo, chatMigrations: [UpMigration], agentMigrations: [UpMigration])
case cmdOk(user_: UserRef?)
@ -754,7 +690,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case agentServersSummary(user: UserRef, serversSummary: PresentedServersSummary)
case agentSubsSummary(user: UserRef, subsSummary: SMPServerSubs)
case chatCmdError(user_: UserRef?, chatError: ChatError)
case chatError(user_: UserRef?, chatError: ChatError)
case archiveExported(archiveErrors: [ArchiveError])
case archiveImported(archiveErrors: [ArchiveError])
case appSettings(appSettings: AppSettings)
@ -768,7 +703,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case .chatStarted: return "chatStarted"
case .chatRunning: return "chatRunning"
case .chatStopped: return "chatStopped"
case .chatSuspended: return "chatSuspended"
case .apiChats: return "apiChats"
case .apiChat: return "apiChat"
case .chatTags: return "chatTags"
@ -787,14 +721,8 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case .groupMemberSwitchStarted: return "groupMemberSwitchStarted"
case .contactSwitchAborted: return "contactSwitchAborted"
case .groupMemberSwitchAborted: return "groupMemberSwitchAborted"
case .contactSwitch: return "contactSwitch"
case .groupMemberSwitch: return "groupMemberSwitch"
case .contactRatchetSyncStarted: return "contactRatchetSyncStarted"
case .groupMemberRatchetSyncStarted: return "groupMemberRatchetSyncStarted"
case .contactRatchetSync: return "contactRatchetSync"
case .groupMemberRatchetSync: return "groupMemberRatchetSync"
case .contactVerificationReset: return "contactVerificationReset"
case .groupMemberVerificationReset: return "groupMemberVerificationReset"
case .contactCode: return "contactCode"
case .groupMemberCode: return "groupMemberCode"
case .connectionVerified: return "connectionVerified"
@ -808,7 +736,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case .sentInvitationToContact: return "sentInvitationToContact"
case .contactAlreadyExists: return "contactAlreadyExists"
case .contactDeleted: return "contactDeleted"
case .contactDeletedByContact: return "contactDeletedByContact"
case .chatCleared: return "chatCleared"
case .userProfileNoChange: return "userProfileNoChange"
case .userProfileUpdated: return "userProfileUpdated"
@ -821,24 +748,12 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case .userContactLinkUpdated: return "userContactLinkUpdated"
case .userContactLinkCreated: return "userContactLinkCreated"
case .userContactLinkDeleted: return "userContactLinkDeleted"
case .contactConnected: return "contactConnected"
case .contactConnecting: return "contactConnecting"
case .contactSndReady: return "contactSndReady"
case .receivedContactRequest: return "receivedContactRequest"
case .acceptingContactRequest: return "acceptingContactRequest"
case .contactRequestRejected: return "contactRequestRejected"
case .contactUpdated: return "contactUpdated"
case .groupMemberUpdated: return "groupMemberUpdated"
case .networkStatus: return "networkStatus"
case .networkStatuses: return "networkStatuses"
case .groupSubscribed: return "groupSubscribed"
case .memberSubErrors: return "memberSubErrors"
case .groupEmpty: return "groupEmpty"
case .userContactLinkSubscribed: return "userContactLinkSubscribed"
case .newChatItems: return "newChatItems"
case .groupChatItemsDeleted: return "groupChatItemsDeleted"
case .forwardPlan: return "forwardPlan"
case .chatItemsStatusesUpdated: return "chatItemsStatusesUpdated"
case .chatItemUpdated: return "chatItemUpdated"
case .chatItemNotChanged: return "chatItemNotChanged"
case .chatItemReaction: return "chatItemReaction"
@ -848,87 +763,42 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case .groupCreated: return "groupCreated"
case .sentGroupInvitation: return "sentGroupInvitation"
case .userAcceptedGroupSent: return "userAcceptedGroupSent"
case .groupLinkConnecting: return "groupLinkConnecting"
case .businessLinkConnecting: return "businessLinkConnecting"
case .userDeletedMembers: return "userDeletedMembers"
case .leftMemberUser: return "leftMemberUser"
case .groupMembers: return "groupMembers"
case .receivedGroupInvitation: return "receivedGroupInvitation"
case .groupDeletedUser: return "groupDeletedUser"
case .joinedGroupMemberConnecting: return "joinedGroupMemberConnecting"
case .memberRole: return "memberRole"
case .membersRoleUser: return "membersRoleUser"
case .memberBlockedForAll: return "memberBlockedForAll"
case .membersBlockedForAllUser: return "membersBlockedForAllUser"
case .deletedMemberUser: return "deletedMemberUser"
case .deletedMember: return "deletedMember"
case .leftMember: return "leftMember"
case .groupDeleted: return "groupDeleted"
case .contactsMerged: return "contactsMerged"
case .groupInvitation: return "groupInvitation"
case .userJoinedGroup: return "userJoinedGroup"
case .joinedGroupMember: return "joinedGroupMember"
case .connectedToGroupMember: return "connectedToGroupMember"
case .groupRemoved: return "groupRemoved"
case .groupUpdated: return "groupUpdated"
case .groupLinkCreated: return "groupLinkCreated"
case .groupLink: return "groupLink"
case .groupLinkDeleted: return "groupLinkDeleted"
case .newMemberContact: return "newMemberContact"
case .newMemberContactSentInv: return "newMemberContactSentInv"
case .newMemberContactReceivedInv: return "newMemberContactReceivedInv"
case .rcvFileAccepted: return "rcvFileAccepted"
case .rcvFileAcceptedSndCancelled: return "rcvFileAcceptedSndCancelled"
case .standaloneFileInfo: return "standaloneFileInfo"
case .rcvStandaloneFileCreated: return "rcvStandaloneFileCreated"
case .rcvFileStart: return "rcvFileStart"
case .rcvFileProgressXFTP: return "rcvFileProgressXFTP"
case .rcvFileComplete: return "rcvFileComplete"
case .rcvStandaloneFileComplete: return "rcvStandaloneFileComplete"
case .rcvFileCancelled: return "rcvFileCancelled"
case .rcvFileSndCancelled: return "rcvFileSndCancelled"
case .rcvFileError: return "rcvFileError"
case .rcvFileWarning: return "rcvFileWarning"
case .sndFileStart: return "sndFileStart"
case .sndFileComplete: return "sndFileComplete"
case .sndFileCancelled: return "sndFileCancelled"
case .sndStandaloneFileCreated: return "sndStandaloneFileCreated"
case .sndFileStartXFTP: return "sndFileStartXFTP"
case .sndFileProgressXFTP: return "sndFileProgressXFTP"
case .sndFileRedirectStartXFTP: return "sndFileRedirectStartXFTP"
case .sndFileRcvCancelled: return "sndFileRcvCancelled"
case .sndFileCompleteXFTP: return "sndFileCompleteXFTP"
case .sndStandaloneFileComplete: return "sndStandaloneFileComplete"
case .sndFileCancelledXFTP: return "sndFileCancelledXFTP"
case .sndFileError: return "sndFileError"
case .sndFileWarning: return "sndFileWarning"
case .callInvitation: return "callInvitation"
case .callOffer: return "callOffer"
case .callAnswer: return "callAnswer"
case .callExtraInfo: return "callExtraInfo"
case .callEnded: return "callEnded"
case .callInvitations: return "callInvitations"
case .ntfTokenStatus: return "ntfTokenStatus"
case .ntfToken: return "ntfToken"
case .ntfConns: return "ntfConns"
case .connNtfMessages: return "connNtfMessages"
case .ntfMessage: return "ntfMessage"
case .contactConnectionDeleted: return "contactConnectionDeleted"
case .contactDisabled: return "contactDisabled"
case .remoteCtrlList: return "remoteCtrlList"
case .remoteCtrlFound: return "remoteCtrlFound"
case .remoteCtrlConnecting: return "remoteCtrlConnecting"
case .remoteCtrlSessionCode: return "remoteCtrlSessionCode"
case .remoteCtrlConnected: return "remoteCtrlConnected"
case .remoteCtrlStopped: return "remoteCtrlStopped"
case .contactPQEnabled: return "contactPQEnabled"
case .versionInfo: return "versionInfo"
case .cmdOk: return "cmdOk"
case .agentSubsTotal: return "agentSubsTotal"
case .agentServersSummary: return "agentServersSummary"
case .agentSubsSummary: return "agentSubsSummary"
case .chatCmdError: return "chatCmdError"
case .chatError: return "chatError"
case .archiveExported: return "archiveExported"
case .archiveImported: return "archiveImported"
case .appSettings: return "appSettings"
@ -945,7 +815,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case .chatStarted: return noDetails
case .chatRunning: return noDetails
case .chatStopped: return noDetails
case .chatSuspended: return noDetails
case let .apiChats(u, chats): return withUser(u, String(describing: chats))
case let .apiChat(u, chat, navInfo): return withUser(u, "chat: \(String(describing: chat))\nnavInfo: \(String(describing: navInfo))")
case let .chatTags(u, userTags): return withUser(u, "userTags: \(String(describing: userTags))")
@ -966,14 +835,8 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case let .groupMemberSwitchStarted(u, groupInfo, member, connectionStats): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nconnectionStats: \(String(describing: connectionStats))")
case let .contactSwitchAborted(u, contact, connectionStats): return withUser(u, "contact: \(String(describing: contact))\nconnectionStats: \(String(describing: connectionStats))")
case let .groupMemberSwitchAborted(u, groupInfo, member, connectionStats): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nconnectionStats: \(String(describing: connectionStats))")
case let .contactSwitch(u, contact, switchProgress): return withUser(u, "contact: \(String(describing: contact))\nswitchProgress: \(String(describing: switchProgress))")
case let .groupMemberSwitch(u, groupInfo, member, switchProgress): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nswitchProgress: \(String(describing: switchProgress))")
case let .contactRatchetSyncStarted(u, contact, connectionStats): return withUser(u, "contact: \(String(describing: contact))\nconnectionStats: \(String(describing: connectionStats))")
case let .groupMemberRatchetSyncStarted(u, groupInfo, member, connectionStats): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nconnectionStats: \(String(describing: connectionStats))")
case let .contactRatchetSync(u, contact, ratchetSyncProgress): return withUser(u, "contact: \(String(describing: contact))\nratchetSyncProgress: \(String(describing: ratchetSyncProgress))")
case let .groupMemberRatchetSync(u, groupInfo, member, ratchetSyncProgress): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nratchetSyncProgress: \(String(describing: ratchetSyncProgress))")
case let .contactVerificationReset(u, contact): return withUser(u, "contact: \(String(describing: contact))")
case let .groupMemberVerificationReset(u, groupInfo, member): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))")
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)")
@ -987,7 +850,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case let .sentInvitationToContact(u, contact, _): return withUser(u, String(describing: contact))
case let .contactAlreadyExists(u, contact): return withUser(u, String(describing: contact))
case let .contactDeleted(u, contact): return withUser(u, String(describing: contact))
case let .contactDeletedByContact(u, contact): return withUser(u, String(describing: contact))
case let .chatCleared(u, chatInfo): return withUser(u, String(describing: chatInfo))
case .userProfileNoChange: return noDetails
case let .userProfileUpdated(u, _, toProfile, _): return withUser(u, String(describing: toProfile))
@ -1000,29 +862,15 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case let .userContactLinkUpdated(u, contactLink): return withUser(u, contactLink.responseDetails)
case let .userContactLinkCreated(u, connLink): return withUser(u, String(describing: connLink))
case .userContactLinkDeleted: return noDetails
case let .contactConnected(u, contact, _): return withUser(u, String(describing: contact))
case let .contactConnecting(u, contact): return withUser(u, String(describing: contact))
case let .contactSndReady(u, contact): return withUser(u, String(describing: contact))
case let .receivedContactRequest(u, contactRequest): return withUser(u, String(describing: contactRequest))
case let .acceptingContactRequest(u, contact): return withUser(u, String(describing: contact))
case .contactRequestRejected: return noDetails
case let .contactUpdated(u, toContact): return withUser(u, String(describing: toContact))
case let .groupMemberUpdated(u, groupInfo, fromMember, toMember): return withUser(u, "groupInfo: \(groupInfo)\nfromMember: \(fromMember)\ntoMember: \(toMember)")
case let .networkStatus(status, conns): return "networkStatus: \(String(describing: status))\nconnections: \(String(describing: conns))"
case let .networkStatuses(u, statuses): return withUser(u, String(describing: statuses))
case let .groupSubscribed(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .memberSubErrors(u, memberSubErrors): return withUser(u, String(describing: memberSubErrors))
case let .groupEmpty(u, groupInfo): return withUser(u, String(describing: groupInfo))
case .userContactLinkSubscribed: return noDetails
case let .newChatItems(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .groupChatItemsDeleted(u, gInfo, chatItemIDs, byUser, member_):
return withUser(u, "chatItemIDs: \(String(describing: chatItemIDs))\ngroupInfo: \(String(describing: gInfo))\nbyUser: \(byUser)\nmember_: \(String(describing: member_))")
case let .forwardPlan(u, chatItemIds, forwardConfirmation): return withUser(u, "items: \(chatItemIds) forwardConfirmation: \(String(describing: forwardConfirmation))")
case let .chatItemsStatusesUpdated(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .chatItemUpdated(u, chatItem): return withUser(u, String(describing: chatItem))
case let .chatItemNotChanged(u, chatItem): return withUser(u, String(describing: chatItem))
case let .chatItemReaction(u, added, reaction): return withUser(u, "added: \(added)\n\(String(describing: reaction))")
@ -1035,87 +883,42 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
case let .groupCreated(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .sentGroupInvitation(u, groupInfo, contact, member): return withUser(u, "groupInfo: \(groupInfo)\ncontact: \(contact)\nmember: \(member)")
case let .userAcceptedGroupSent(u, groupInfo, hostContact): return withUser(u, "groupInfo: \(groupInfo)\nhostContact: \(String(describing: hostContact))")
case let .groupLinkConnecting(u, groupInfo, hostMember): return withUser(u, "groupInfo: \(groupInfo)\nhostMember: \(String(describing: hostMember))")
case let .businessLinkConnecting(u, groupInfo, hostMember, fromContact): return withUser(u, "groupInfo: \(groupInfo)\nhostMember: \(String(describing: hostMember))\nfromContact: \(String(describing: fromContact))")
case let .userDeletedMembers(u, groupInfo, members, withMessages): return withUser(u, "groupInfo: \(groupInfo)\nmembers: \(members)\nwithMessages: \(withMessages)")
case let .leftMemberUser(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .groupMembers(u, group): return withUser(u, String(describing: group))
case let .receivedGroupInvitation(u, groupInfo, contact, memberRole): return withUser(u, "groupInfo: \(groupInfo)\ncontact: \(contact)\nmemberRole: \(memberRole)")
case let .groupDeletedUser(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .joinedGroupMemberConnecting(u, groupInfo, hostMember, member): return withUser(u, "groupInfo: \(groupInfo)\nhostMember: \(hostMember)\nmember: \(member)")
case let .memberRole(u, groupInfo, byMember, member, fromRole, toRole): return withUser(u, "groupInfo: \(groupInfo)\nbyMember: \(byMember)\nmember: \(member)\nfromRole: \(fromRole)\ntoRole: \(toRole)")
case let .membersRoleUser(u, groupInfo, members, toRole): return withUser(u, "groupInfo: \(groupInfo)\nmembers: \(members)\ntoRole: \(toRole)")
case let .memberBlockedForAll(u, groupInfo, byMember, member, blocked): return withUser(u, "groupInfo: \(groupInfo)\nbyMember: \(byMember)\nmember: \(member)\nblocked: \(blocked)")
case let .membersBlockedForAllUser(u, groupInfo, members, blocked): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(members)\nblocked: \(blocked)")
case let .deletedMemberUser(u, groupInfo, member, withMessages): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)\nwithMessages: \(withMessages)")
case let .deletedMember(u, groupInfo, byMember, deletedMember, withMessages): return withUser(u, "groupInfo: \(groupInfo)\nbyMember: \(byMember)\ndeletedMember: \(deletedMember)\nwithMessages: \(withMessages)")
case let .leftMember(u, groupInfo, member): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)")
case let .groupDeleted(u, groupInfo, member): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)")
case let .contactsMerged(u, intoContact, mergedContact): return withUser(u, "intoContact: \(intoContact)\nmergedContact: \(mergedContact)")
case let .groupInvitation(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .userJoinedGroup(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .joinedGroupMember(u, groupInfo, member): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)")
case let .connectedToGroupMember(u, groupInfo, member, memberContact): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)\nmemberContact: \(String(describing: memberContact))")
case let .groupRemoved(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .groupUpdated(u, toGroup): return withUser(u, String(describing: toGroup))
case let .groupLinkCreated(u, groupInfo, connLinkContact, memberRole): return withUser(u, "groupInfo: \(groupInfo)\nconnLinkContact: \(connLinkContact)\nmemberRole: \(memberRole)")
case let .groupLink(u, groupInfo, connLinkContact, memberRole): return withUser(u, "groupInfo: \(groupInfo)\nconnLinkContact: \(connLinkContact)\nmemberRole: \(memberRole)")
case let .groupLinkDeleted(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .newMemberContact(u, contact, groupInfo, member): return withUser(u, "contact: \(contact)\ngroupInfo: \(groupInfo)\nmember: \(member)")
case let .newMemberContactSentInv(u, contact, groupInfo, member): return withUser(u, "contact: \(contact)\ngroupInfo: \(groupInfo)\nmember: \(member)")
case let .newMemberContactReceivedInv(u, contact, groupInfo, member): return withUser(u, "contact: \(contact)\ngroupInfo: \(groupInfo)\nmember: \(member)")
case let .rcvFileAccepted(u, chatItem): return withUser(u, String(describing: chatItem))
case .rcvFileAcceptedSndCancelled: return noDetails
case let .standaloneFileInfo(fileMeta): return String(describing: fileMeta)
case .rcvStandaloneFileCreated: return noDetails
case let .rcvFileStart(u, chatItem): return withUser(u, String(describing: chatItem))
case let .rcvFileProgressXFTP(u, chatItem, receivedSize, totalSize, _): return withUser(u, "chatItem: \(String(describing: chatItem))\nreceivedSize: \(receivedSize)\ntotalSize: \(totalSize)")
case let .rcvStandaloneFileComplete(u, targetPath, _): return withUser(u, targetPath)
case let .rcvFileComplete(u, chatItem): return withUser(u, String(describing: chatItem))
case let .rcvFileCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .rcvFileSndCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .rcvFileError(u, chatItem, agentError, _): return withUser(u, "agentError: \(String(describing: agentError))\nchatItem: \(String(describing: chatItem))")
case let .rcvFileWarning(u, chatItem, agentError, _): return withUser(u, "agentError: \(String(describing: agentError))\nchatItem: \(String(describing: chatItem))")
case let .sndFileStart(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileComplete(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileCancelled(u, chatItem, _, _): return withUser(u, String(describing: chatItem))
case .sndStandaloneFileCreated: return noDetails
case let .sndFileStartXFTP(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileRcvCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileProgressXFTP(u, chatItem, _, sentSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nsentSize: \(sentSize)\ntotalSize: \(totalSize)")
case let .sndFileRedirectStartXFTP(u, _, redirectMeta): return withUser(u, String(describing: redirectMeta))
case let .sndFileCompleteXFTP(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndStandaloneFileComplete(u, _, rcvURIs): return withUser(u, String(rcvURIs.count))
case let .sndFileCancelledXFTP(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileError(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .sndFileWarning(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .callInvitation(inv): return String(describing: inv)
case let .callOffer(u, contact, callType, offer, sharedKey, askConfirmation): return withUser(u, "contact: \(contact.id)\ncallType: \(String(describing: callType))\nsharedKey: \(sharedKey ?? "")\naskConfirmation: \(askConfirmation)\noffer: \(String(describing: offer))")
case let .callAnswer(u, contact, answer): return withUser(u, "contact: \(contact.id)\nanswer: \(String(describing: answer))")
case let .callExtraInfo(u, contact, extraInfo): return withUser(u, "contact: \(contact.id)\nextraInfo: \(String(describing: extraInfo))")
case let .callEnded(u, contact): return withUser(u, "contact: \(contact.id)")
case let .callInvitations(invs): return String(describing: invs)
case let .ntfTokenStatus(status): return String(describing: status)
case let .ntfToken(token, status, ntfMode, ntfServer): return "token: \(token)\nstatus: \(status.rawValue)\nntfMode: \(ntfMode.rawValue)\nntfServer: \(ntfServer)"
case let .ntfConns(ntfConns): return String(describing: ntfConns)
case let .connNtfMessages(receivedMsgs): return "receivedMsgs: \(String(describing: receivedMsgs))"
case let .ntfMessage(u, connEntity, ntfMessage): return withUser(u, "connEntity: \(String(describing: connEntity))\nntfMessage: \(String(describing: ntfMessage))")
case let .contactConnectionDeleted(u, connection): return withUser(u, String(describing: connection))
case let .contactDisabled(u, contact): return withUser(u, String(describing: contact))
case let .remoteCtrlList(remoteCtrls): return String(describing: remoteCtrls)
case let .remoteCtrlFound(remoteCtrl, ctrlAppInfo_, appVersion, compatible): return "remoteCtrl:\n\(String(describing: remoteCtrl))\nctrlAppInfo_:\n\(String(describing: ctrlAppInfo_))\nappVersion: \(appVersion)\ncompatible: \(compatible)"
case let .remoteCtrlConnecting(remoteCtrl_, ctrlAppInfo, appVersion): return "remoteCtrl_:\n\(String(describing: remoteCtrl_))\nctrlAppInfo:\n\(String(describing: ctrlAppInfo))\nappVersion: \(appVersion)"
case let .remoteCtrlSessionCode(remoteCtrl_, sessionCode): return "remoteCtrl_:\n\(String(describing: remoteCtrl_))\nsessionCode: \(sessionCode)"
case let .remoteCtrlConnected(remoteCtrl): return String(describing: remoteCtrl)
case let .remoteCtrlStopped(rcsState, rcStopReason): return "rcsState: \(String(describing: rcsState))\nrcStopReason: \(String(describing: rcStopReason))"
case let .contactPQEnabled(u, contact, pqEnabled): return withUser(u, "contact: \(String(describing: contact))\npqEnabled: \(pqEnabled)")
case let .versionInfo(versionInfo, chatMigrations, agentMigrations): return "\(String(describing: versionInfo))\n\nchat migrations: \(chatMigrations.map(\.upName))\n\nagent migrations: \(agentMigrations.map(\.upName))"
case .cmdOk: return noDetails
case let .agentSubsTotal(u, subsTotal, hasSession): return withUser(u, "subsTotal: \(String(describing: subsTotal))\nhasSession: \(hasSession)")
case let .agentServersSummary(u, serversSummary): return withUser(u, String(describing: serversSummary))
case let .agentSubsSummary(u, subsSummary): return withUser(u, String(describing: subsSummary))
case let .chatCmdError(u, chatError): return withUser(u, String(describing: chatError))
case let .chatError(u, chatError): return withUser(u, String(describing: chatError))
case let .archiveExported(archiveErrors): return String(describing: archiveErrors)
case let .archiveImported(archiveErrors): return String(describing: archiveErrors)
case let .appSettings(appSettings): return String(describing: appSettings)
@ -1162,10 +965,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
if let jError = jResp["chatCmdError"] as? NSDictionary {
return .chatCmdError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
} else if type == "chatError" {
if let jError = jResp["chatError"] as? NSDictionary {
return .chatError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
}
}
json = serializeJSON(j, options: .prettyPrinted)
@ -1176,7 +975,6 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
var chatError: ChatError? {
switch self {
case let .chatCmdError(_, error): error
case let .chatError(_, error): error
default: nil
}
}
@ -1184,6 +982,289 @@ enum ChatResponse: Decodable, Error, ChatRespProtocol {
var chatErrorType: ChatErrorType? {
switch self {
case let .chatCmdError(_, .error(error)): error
default: nil
}
}
}
enum ChatEvent: Decodable, ChatEventProtocol {
case event(type: String, json: String)
case chatSuspended
case contactSwitch(user: UserRef, contact: Contact, switchProgress: SwitchProgress)
case groupMemberSwitch(user: UserRef, groupInfo: GroupInfo, member: GroupMember, switchProgress: SwitchProgress)
case contactRatchetSync(user: UserRef, contact: Contact, ratchetSyncProgress: RatchetSyncProgress)
case groupMemberRatchetSync(user: UserRef, groupInfo: GroupInfo, member: GroupMember, ratchetSyncProgress: RatchetSyncProgress)
case contactDeletedByContact(user: UserRef, contact: Contact)
case contactConnected(user: UserRef, contact: Contact, userCustomProfile: Profile?)
case contactConnecting(user: UserRef, contact: Contact)
case contactSndReady(user: UserRef, contact: Contact)
case receivedContactRequest(user: UserRef, contactRequest: UserContactRequest)
case contactUpdated(user: UserRef, toContact: Contact)
case groupMemberUpdated(user: UserRef, groupInfo: GroupInfo, fromMember: GroupMember, toMember: GroupMember)
case contactsMerged(user: UserRef, intoContact: Contact, mergedContact: Contact)
case networkStatus(networkStatus: NetworkStatus, connections: [String])
case networkStatuses(user_: UserRef?, networkStatuses: [ConnNetworkStatus])
case newChatItems(user: UserRef, chatItems: [AChatItem])
case chatItemsStatusesUpdated(user: UserRef, chatItems: [AChatItem])
case chatItemUpdated(user: UserRef, chatItem: AChatItem)
case chatItemReaction(user: UserRef, added: Bool, reaction: ACIReaction)
case chatItemsDeleted(user: UserRef, chatItemDeletions: [ChatItemDeletion], byUser: Bool)
// group events
case groupChatItemsDeleted(user: UserRef, groupInfo: GroupInfo, chatItemIDs: Set<Int64>, byUser: Bool, member_: GroupMember?)
case receivedGroupInvitation(user: UserRef, groupInfo: GroupInfo, contact: Contact, memberRole: GroupMemberRole)
case userAcceptedGroupSent(user: UserRef, groupInfo: GroupInfo, hostContact: Contact?)
case groupLinkConnecting(user: UserRef, groupInfo: GroupInfo, hostMember: GroupMember)
case businessLinkConnecting(user: UserRef, groupInfo: GroupInfo, hostMember: GroupMember, fromContact: Contact)
case joinedGroupMemberConnecting(user: UserRef, groupInfo: GroupInfo, hostMember: GroupMember, member: GroupMember)
case memberRole(user: UserRef, groupInfo: GroupInfo, byMember: GroupMember, member: GroupMember, fromRole: GroupMemberRole, toRole: GroupMemberRole)
case memberBlockedForAll(user: UserRef, groupInfo: GroupInfo, byMember: GroupMember, member: GroupMember, blocked: Bool)
case deletedMemberUser(user: UserRef, groupInfo: GroupInfo, member: GroupMember, withMessages: Bool)
case deletedMember(user: UserRef, groupInfo: GroupInfo, byMember: GroupMember, deletedMember: GroupMember, withMessages: Bool)
case leftMember(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
case groupDeleted(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
case userJoinedGroup(user: UserRef, groupInfo: GroupInfo)
case joinedGroupMember(user: UserRef, groupInfo: GroupInfo, member: GroupMember)
case connectedToGroupMember(user: UserRef, groupInfo: GroupInfo, member: GroupMember, memberContact: Contact?)
case groupUpdated(user: UserRef, toGroup: GroupInfo)
case newMemberContactReceivedInv(user: UserRef, contact: Contact, groupInfo: GroupInfo, member: GroupMember)
// receiving file events
case rcvFileAccepted(user: UserRef, chatItem: AChatItem)
case rcvFileAcceptedSndCancelled(user: UserRef, rcvFileTransfer: RcvFileTransfer)
case rcvFileStart(user: UserRef, chatItem: AChatItem) // send by chats
case rcvFileProgressXFTP(user: UserRef, chatItem_: AChatItem?, receivedSize: Int64, totalSize: Int64, rcvFileTransfer: RcvFileTransfer)
case rcvFileComplete(user: UserRef, chatItem: AChatItem)
case rcvStandaloneFileComplete(user: UserRef, targetPath: String, rcvFileTransfer: RcvFileTransfer)
case rcvFileSndCancelled(user: UserRef, chatItem: AChatItem, rcvFileTransfer: RcvFileTransfer)
case rcvFileError(user: UserRef, chatItem_: AChatItem?, agentError: AgentErrorType, rcvFileTransfer: RcvFileTransfer)
case rcvFileWarning(user: UserRef, chatItem_: AChatItem?, agentError: AgentErrorType, rcvFileTransfer: RcvFileTransfer)
// sending file events
case sndFileStart(user: UserRef, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileComplete(user: UserRef, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileRcvCancelled(user: UserRef, chatItem_: AChatItem?, sndFileTransfer: SndFileTransfer)
case sndFileProgressXFTP(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, sentSize: Int64, totalSize: Int64)
case sndFileRedirectStartXFTP(user: UserRef, fileTransferMeta: FileTransferMeta, redirectMeta: FileTransferMeta)
case sndFileCompleteXFTP(user: UserRef, chatItem: AChatItem, fileTransferMeta: FileTransferMeta)
case sndStandaloneFileComplete(user: UserRef, fileTransferMeta: FileTransferMeta, rcvURIs: [String])
case sndFileError(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
case sndFileWarning(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
// call events
case callInvitation(callInvitation: RcvCallInvitation)
case callOffer(user: UserRef, contact: Contact, callType: CallType, offer: WebRTCSession, sharedKey: String?, askConfirmation: Bool)
case callAnswer(user: UserRef, contact: Contact, answer: WebRTCSession)
case callExtraInfo(user: UserRef, contact: Contact, extraInfo: WebRTCExtraInfo)
case callEnded(user: UserRef, contact: Contact)
case contactDisabled(user: UserRef, contact: Contact)
// notification marker
case ntfMessage(user: UserRef, connEntity: ConnectionEntity, ntfMessage: NtfMsgAckInfo)
// remote desktop responses
case remoteCtrlFound(remoteCtrl: RemoteCtrlInfo, ctrlAppInfo_: CtrlAppInfo?, appVersion: String, compatible: Bool)
case remoteCtrlSessionCode(remoteCtrl_: RemoteCtrlInfo?, sessionCode: String)
case remoteCtrlConnected(remoteCtrl: RemoteCtrlInfo)
case remoteCtrlStopped(rcsState: RemoteCtrlSessionState, rcStopReason: RemoteCtrlStopReason)
// pq
case contactPQEnabled(user: UserRef, contact: Contact, pqEnabled: Bool)
case chatError(user_: UserRef?, chatError: ChatError)
var eventType: String {
switch self {
case let .event(type, _): "* \(type)"
case .chatSuspended: "chatSuspended"
case .contactSwitch: "contactSwitch"
case .groupMemberSwitch: "groupMemberSwitch"
case .contactRatchetSync: "contactRatchetSync"
case .groupMemberRatchetSync: "groupMemberRatchetSync"
case .contactDeletedByContact: "contactDeletedByContact"
case .contactConnected: "contactConnected"
case .contactConnecting: "contactConnecting"
case .contactSndReady: "contactSndReady"
case .receivedContactRequest: "receivedContactRequest"
case .contactUpdated: "contactUpdated"
case .groupMemberUpdated: "groupMemberUpdated"
case .contactsMerged: "contactsMerged"
case .networkStatus: "networkStatus"
case .networkStatuses: "networkStatuses"
case .newChatItems: "newChatItems"
case .chatItemsStatusesUpdated: "chatItemsStatusesUpdated"
case .chatItemUpdated: "chatItemUpdated"
case .chatItemReaction: "chatItemReaction"
case .chatItemsDeleted: "chatItemsDeleted"
case .groupChatItemsDeleted: "groupChatItemsDeleted"
case .receivedGroupInvitation: "receivedGroupInvitation"
case .userAcceptedGroupSent: "userAcceptedGroupSent"
case .groupLinkConnecting: "groupLinkConnecting"
case .businessLinkConnecting: "businessLinkConnecting"
case .joinedGroupMemberConnecting: "joinedGroupMemberConnecting"
case .memberRole: "memberRole"
case .memberBlockedForAll: "memberBlockedForAll"
case .deletedMemberUser: "deletedMemberUser"
case .deletedMember: "deletedMember"
case .leftMember: "leftMember"
case .groupDeleted: "groupDeleted"
case .userJoinedGroup: "userJoinedGroup"
case .joinedGroupMember: "joinedGroupMember"
case .connectedToGroupMember: "connectedToGroupMember"
case .groupUpdated: "groupUpdated"
case .newMemberContactReceivedInv: "newMemberContactReceivedInv"
case .rcvFileAccepted: "rcvFileAccepted"
case .rcvFileAcceptedSndCancelled: "rcvFileAcceptedSndCancelled"
case .rcvFileStart: "rcvFileStart"
case .rcvFileProgressXFTP: "rcvFileProgressXFTP"
case .rcvFileComplete: "rcvFileComplete"
case .rcvStandaloneFileComplete: "rcvStandaloneFileComplete"
case .rcvFileSndCancelled: "rcvFileSndCancelled"
case .rcvFileError: "rcvFileError"
case .rcvFileWarning: "rcvFileWarning"
case .sndFileStart: "sndFileStart"
case .sndFileComplete: "sndFileComplete"
case .sndFileRcvCancelled: "sndFileRcvCancelled"
case .sndFileProgressXFTP: "sndFileProgressXFTP"
case .sndFileRedirectStartXFTP: "sndFileRedirectStartXFTP"
case .sndFileCompleteXFTP: "sndFileCompleteXFTP"
case .sndStandaloneFileComplete: "sndStandaloneFileComplete"
case .sndFileError: "sndFileError"
case .sndFileWarning: "sndFileWarning"
case .callInvitation: "callInvitation"
case .callOffer: "callOffer"
case .callAnswer: "callAnswer"
case .callExtraInfo: "callExtraInfo"
case .callEnded: "callEnded"
case .contactDisabled: "contactDisabled"
case .ntfMessage: "ntfMessage"
case .remoteCtrlFound: "remoteCtrlFound"
case .remoteCtrlSessionCode: "remoteCtrlSessionCode"
case .remoteCtrlConnected: "remoteCtrlConnected"
case .remoteCtrlStopped: "remoteCtrlStopped"
case .contactPQEnabled: "contactPQEnabled"
case .chatError: "chatError"
}
}
var details: String {
switch self {
case let .event(_, json): return json
case .chatSuspended: return noDetails
case let .contactSwitch(u, contact, switchProgress): return withUser(u, "contact: \(String(describing: contact))\nswitchProgress: \(String(describing: switchProgress))")
case let .groupMemberSwitch(u, groupInfo, member, switchProgress): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nswitchProgress: \(String(describing: switchProgress))")
case let .contactRatchetSync(u, contact, ratchetSyncProgress): return withUser(u, "contact: \(String(describing: contact))\nratchetSyncProgress: \(String(describing: ratchetSyncProgress))")
case let .groupMemberRatchetSync(u, groupInfo, member, ratchetSyncProgress): return withUser(u, "groupInfo: \(String(describing: groupInfo))\nmember: \(String(describing: member))\nratchetSyncProgress: \(String(describing: ratchetSyncProgress))")
case let .contactDeletedByContact(u, contact): return withUser(u, String(describing: contact))
case let .contactConnected(u, contact, _): return withUser(u, String(describing: contact))
case let .contactConnecting(u, contact): return withUser(u, String(describing: contact))
case let .contactSndReady(u, contact): return withUser(u, String(describing: contact))
case let .receivedContactRequest(u, contactRequest): return withUser(u, String(describing: contactRequest))
case let .contactUpdated(u, toContact): return withUser(u, String(describing: toContact))
case let .groupMemberUpdated(u, groupInfo, fromMember, toMember): return withUser(u, "groupInfo: \(groupInfo)\nfromMember: \(fromMember)\ntoMember: \(toMember)")
case let .contactsMerged(u, intoContact, mergedContact): return withUser(u, "intoContact: \(intoContact)\nmergedContact: \(mergedContact)")
case let .networkStatus(status, conns): return "networkStatus: \(String(describing: status))\nconnections: \(String(describing: conns))"
case let .networkStatuses(u, statuses): return withUser(u, String(describing: statuses))
case let .newChatItems(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .chatItemsStatusesUpdated(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .chatItemUpdated(u, chatItem): return withUser(u, String(describing: chatItem))
case let .chatItemReaction(u, added, reaction): return withUser(u, "added: \(added)\n\(String(describing: reaction))")
case let .chatItemsDeleted(u, items, byUser):
let itemsString = items.map { item in
"deletedChatItem:\n\(String(describing: item.deletedChatItem))\ntoChatItem:\n\(String(describing: item.toChatItem))" }.joined(separator: "\n")
return withUser(u, itemsString + "\nbyUser: \(byUser)")
case let .groupChatItemsDeleted(u, gInfo, chatItemIDs, byUser, member_):
return withUser(u, "chatItemIDs: \(String(describing: chatItemIDs))\ngroupInfo: \(String(describing: gInfo))\nbyUser: \(byUser)\nmember_: \(String(describing: member_))")
case let .receivedGroupInvitation(u, groupInfo, contact, memberRole): return withUser(u, "groupInfo: \(groupInfo)\ncontact: \(contact)\nmemberRole: \(memberRole)")
case let .userAcceptedGroupSent(u, groupInfo, hostContact): return withUser(u, "groupInfo: \(groupInfo)\nhostContact: \(String(describing: hostContact))")
case let .groupLinkConnecting(u, groupInfo, hostMember): return withUser(u, "groupInfo: \(groupInfo)\nhostMember: \(String(describing: hostMember))")
case let .businessLinkConnecting(u, groupInfo, hostMember, fromContact): return withUser(u, "groupInfo: \(groupInfo)\nhostMember: \(String(describing: hostMember))\nfromContact: \(String(describing: fromContact))")
case let .joinedGroupMemberConnecting(u, groupInfo, hostMember, member): return withUser(u, "groupInfo: \(groupInfo)\nhostMember: \(hostMember)\nmember: \(member)")
case let .memberRole(u, groupInfo, byMember, member, fromRole, toRole): return withUser(u, "groupInfo: \(groupInfo)\nbyMember: \(byMember)\nmember: \(member)\nfromRole: \(fromRole)\ntoRole: \(toRole)")
case let .memberBlockedForAll(u, groupInfo, byMember, member, blocked): return withUser(u, "groupInfo: \(groupInfo)\nbyMember: \(byMember)\nmember: \(member)\nblocked: \(blocked)")
case let .deletedMemberUser(u, groupInfo, member, withMessages): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)\nwithMessages: \(withMessages)")
case let .deletedMember(u, groupInfo, byMember, deletedMember, withMessages): return withUser(u, "groupInfo: \(groupInfo)\nbyMember: \(byMember)\ndeletedMember: \(deletedMember)\nwithMessages: \(withMessages)")
case let .leftMember(u, groupInfo, member): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)")
case let .groupDeleted(u, groupInfo, member): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)")
case let .userJoinedGroup(u, groupInfo): return withUser(u, String(describing: groupInfo))
case let .joinedGroupMember(u, groupInfo, member): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)")
case let .connectedToGroupMember(u, groupInfo, member, memberContact): return withUser(u, "groupInfo: \(groupInfo)\nmember: \(member)\nmemberContact: \(String(describing: memberContact))")
case let .groupUpdated(u, toGroup): return withUser(u, String(describing: toGroup))
case let .newMemberContactReceivedInv(u, contact, groupInfo, member): return withUser(u, "contact: \(contact)\ngroupInfo: \(groupInfo)\nmember: \(member)")
case let .rcvFileAccepted(u, chatItem): return withUser(u, String(describing: chatItem))
case .rcvFileAcceptedSndCancelled: return noDetails
case let .rcvFileStart(u, chatItem): return withUser(u, String(describing: chatItem))
case let .rcvFileProgressXFTP(u, chatItem, receivedSize, totalSize, _): return withUser(u, "chatItem: \(String(describing: chatItem))\nreceivedSize: \(receivedSize)\ntotalSize: \(totalSize)")
case let .rcvStandaloneFileComplete(u, targetPath, _): return withUser(u, targetPath)
case let .rcvFileComplete(u, chatItem): return withUser(u, String(describing: chatItem))
case let .rcvFileSndCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .rcvFileError(u, chatItem, agentError, _): return withUser(u, "agentError: \(String(describing: agentError))\nchatItem: \(String(describing: chatItem))")
case let .rcvFileWarning(u, chatItem, agentError, _): return withUser(u, "agentError: \(String(describing: agentError))\nchatItem: \(String(describing: chatItem))")
case let .sndFileStart(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileComplete(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileRcvCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileProgressXFTP(u, chatItem, _, sentSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nsentSize: \(sentSize)\ntotalSize: \(totalSize)")
case let .sndFileRedirectStartXFTP(u, _, redirectMeta): return withUser(u, String(describing: redirectMeta))
case let .sndFileCompleteXFTP(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndStandaloneFileComplete(u, _, rcvURIs): return withUser(u, String(rcvURIs.count))
case let .sndFileError(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .sndFileWarning(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .callInvitation(inv): return String(describing: inv)
case let .callOffer(u, contact, callType, offer, sharedKey, askConfirmation): return withUser(u, "contact: \(contact.id)\ncallType: \(String(describing: callType))\nsharedKey: \(sharedKey ?? "")\naskConfirmation: \(askConfirmation)\noffer: \(String(describing: offer))")
case let .callAnswer(u, contact, answer): return withUser(u, "contact: \(contact.id)\nanswer: \(String(describing: answer))")
case let .callExtraInfo(u, contact, extraInfo): return withUser(u, "contact: \(contact.id)\nextraInfo: \(String(describing: extraInfo))")
case let .callEnded(u, contact): return withUser(u, "contact: \(contact.id)")
case let .contactDisabled(u, contact): return withUser(u, String(describing: contact))
case let .ntfMessage(u, connEntity, ntfMessage): return withUser(u, "connEntity: \(String(describing: connEntity))\nntfMessage: \(String(describing: ntfMessage))")
case let .remoteCtrlFound(remoteCtrl, ctrlAppInfo_, appVersion, compatible): return "remoteCtrl:\n\(String(describing: remoteCtrl))\nctrlAppInfo_:\n\(String(describing: ctrlAppInfo_))\nappVersion: \(appVersion)\ncompatible: \(compatible)"
case let .remoteCtrlSessionCode(remoteCtrl_, sessionCode): return "remoteCtrl_:\n\(String(describing: remoteCtrl_))\nsessionCode: \(sessionCode)"
case let .remoteCtrlConnected(remoteCtrl): return String(describing: remoteCtrl)
case let .remoteCtrlStopped(rcsState, rcStopReason): return "rcsState: \(String(describing: rcsState))\nrcStopReason: \(String(describing: rcStopReason))"
case let .contactPQEnabled(u, contact, pqEnabled): return withUser(u, "contact: \(String(describing: contact))\npqEnabled: \(pqEnabled)")
case let .chatError(u, chatError): return withUser(u, String(describing: chatError))
}
}
private var noDetails: String { "\(eventType): no details" }
static func chatEvent(_ s: String) -> ChatEvent {
let d = s.data(using: .utf8)!
// TODO is there a way to do it without copying the data? e.g:
// let p = UnsafeMutableRawPointer.init(mutating: UnsafeRawPointer(cjson))
// let d = Data.init(bytesNoCopy: p, count: strlen(cjson), deallocator: .free)
do {
let r = // try callWithLargeStack {
try jsonDecoder.decode(APIResponse<ChatEvent>.self, from: d)
// }
return r.resp
} catch {
logger.error("chatResponse jsonDecoder.decode error: \(error.localizedDescription)")
}
var type: String?
var json: String?
if let j = try? JSONSerialization.jsonObject(with: d) as? NSDictionary {
if let jResp = j["resp"] as? NSDictionary, jResp.count == 1 || jResp.count == 2 {
type = jResp.allKeys[0] as? String
if jResp.count == 2 && type == "_owsf" {
type = jResp.allKeys[1] as? String
}
if type == "chatError" {
if let jError = jResp["chatError"] as? NSDictionary {
return .chatError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
}
}
json = serializeJSON(j, options: .prettyPrinted)
}
return ChatEvent.event(type: type ?? "invalid", json: json ?? s)
}
var chatError: ChatError? {
switch self {
case let .chatError(_, error): error
default: nil
}
}
var chatErrorType: ChatErrorType? {
switch self {
case let .chatError(_, .error(error)): error
default: nil
}

45
apps/ios/Shared/Model/SimpleXAPI.swift
View file

@ -20,12 +20,14 @@ private let networkStatusesLock = DispatchQueue(label: "chat.simplex.app.network
enum TerminalItem: Identifiable {
case cmd(Date, ChatCommand)
case resp(Date, ChatResponse)
case event(Date, ChatEvent)
var id: Date {
get {
switch self {
case let .cmd(id, _): return id
case let .resp(id, _): return id
case let .cmd(d, _): return d
case let .resp(d, _): return d
case let .event(d, _): return d
}
}
}
@ -35,6 +37,7 @@ enum TerminalItem: Identifiable {
switch self {
case let .cmd(_, cmd): return "> \(cmd.cmdString.prefix(30))"
case let .resp(_, resp): return "< \(resp.responseType)"
case let .event(_, evt): return "< \(evt.eventType)"
}
}
}
@ -44,6 +47,7 @@ enum TerminalItem: Identifiable {
switch self {
case let .cmd(_, cmd): return cmd.cmdString
case let .resp(_, resp): return resp.details
case let .event(_, evt): return evt.details
}
}
}
@ -112,12 +116,12 @@ func chatSendCmd(_ cmd: ChatCommand, bgTask: Bool = true, bgDelay: Double? = nil
}
}
func chatRecvMsg(_ ctrl: chat_ctrl? = nil) async -> ChatResponse? {
func chatRecvMsg(_ ctrl: chat_ctrl? = nil) async -> ChatEvent? {
await withCheckedContinuation { cont in
_ = withBGTask(bgDelay: msgDelay) { () -> ChatResponse? in
let resp: ChatResponse? = recvSimpleXMsg(ctrl)
cont.resume(returning: resp)
return resp
_ = withBGTask(bgDelay: msgDelay) { () -> ChatEvent? in
let evt: ChatEvent? = recvSimpleXMsg(ctrl)
cont.resume(returning: evt)
return evt
}
}
}
@ -476,8 +480,11 @@ private func createChatItemsErrorAlert(_ r: ChatResponse) {
func apiUpdateChatItem(type: ChatType, id: Int64, itemId: Int64, updatedMessage: UpdatedMessage, live: Bool = false) async throws -> ChatItem {
let r = await chatSendCmd(.apiUpdateChatItem(type: type, id: id, itemId: itemId, updatedMessage: updatedMessage, live: live), bgDelay: msgDelay)
if case let .chatItemUpdated(_, aChatItem) = r { return aChatItem.chatItem }
throw r
switch r {
case let .chatItemUpdated(_, aChatItem): return aChatItem.chatItem
case let .chatItemNotChanged(_, aChatItem): return aChatItem.chatItem
default: throw r
}
}
func apiChatItemReaction(type: ChatType, id: Int64, itemId: Int64, add: Bool, reaction: MsgReaction) async throws -> ChatItem {
@ -1280,6 +1287,10 @@ func receiveFiles(user: any UserLike, fileIds: [Int64], userApprovedRelays: Bool
switch r {
case let .rcvFileAccepted(_, chatItem):
await chatItemSimpleUpdate(user, chatItem)
// TODO when aChatItem added
// case let .rcvFileAcceptedSndCancelled(user, aChatItem, _):
// await chatItemSimpleUpdate(user, aChatItem)
// Task { cleanupFile(aChatItem) }
default:
if let chatError = r.chatErrorType {
switch chatError {
@ -1925,7 +1936,7 @@ class ChatReceiver {
private var receiveMessages = true
private var _lastMsgTime = Date.now
var messagesChannel: ((ChatResponse) -> Void)? = nil
var messagesChannel: ((ChatEvent) -> Void)? = nil
static let shared = ChatReceiver()
@ -1960,13 +1971,13 @@ class ChatReceiver {
}
}
func processReceivedMsg(_ res: ChatResponse) async {
func processReceivedMsg(_ res: ChatEvent) async {
Task {
await TerminalItems.shared.add(.resp(.now, res))
await TerminalItems.shared.add(.event(.now, res))
}
let m = ChatModel.shared
let n = NetworkModel.shared
logger.debug("processReceivedMsg: \(res.responseType)")
logger.debug("processReceivedMsg: \(res.eventType)")
switch res {
case let .contactDeletedByContact(user, contact):
if active(user) && contact.directOrUsed {
@ -2281,6 +2292,10 @@ func processReceivedMsg(_ res: ChatResponse) async {
}
case let .rcvFileAccepted(user, aChatItem): // usually rcvFileAccepted is a response, but it's also an event for XFTP files auto-accepted from NSE
await chatItemSimpleUpdate(user, aChatItem)
// TODO when aChatItem added
// case let .rcvFileAcceptedSndCancelled(user, aChatItem, _): // usually rcvFileAcceptedSndCancelled is a response, but it's also an event for XFTP files auto-accepted from NSE
// await chatItemSimpleUpdate(user, aChatItem)
// Task { cleanupFile(aChatItem) }
case let .rcvFileStart(user, aChatItem):
await chatItemSimpleUpdate(user, aChatItem)
case let .rcvFileComplete(user, aChatItem):
@ -2460,14 +2475,14 @@ func processReceivedMsg(_ res: ChatResponse) async {
}
}
default:
logger.debug("unsupported event: \(res.responseType)")
logger.debug("unsupported event: \(res.eventType)")
}
func withCall(_ contact: Contact, _ perform: (Call) async -> Void) async {
if let call = m.activeCall, call.contact.apiId == contact.apiId {
await perform(call)
} else {
logger.debug("processReceivedMsg: ignoring \(res.responseType), not in call with the contact \(contact.id)")
logger.debug("processReceivedMsg: ignoring \(res.eventType), not in call with the contact \(contact.id)")
}
}
}

12
apps/ios/Shared/Views/Migration/MigrateFromDevice.swift
View file

@ -550,7 +550,7 @@ struct MigrateFromDevice: View {
alert = .error(title: "Upload failed", error: "Check your internet connection and try again")
migrationState = .uploadFailed(totalBytes: totalBytes, archivePath: archivePath)
default:
logger.debug("unsupported event: \(msg.responseType)")
logger.debug("unsupported event: \(msg.eventType)")
}
}
}
@ -733,11 +733,11 @@ func chatStoppedView() -> some View {
private class MigrationChatReceiver {
let ctrl: chat_ctrl
let databaseUrl: URL
let processReceivedMsg: (ChatResponse) async -> Void
let processReceivedMsg: (ChatEvent) async -> Void
private var receiveLoop: Task<Void, Never>?
private var receiveMessages = true
init(ctrl: chat_ctrl, databaseUrl: URL, _ processReceivedMsg: @escaping (ChatResponse) async -> Void) {
init(ctrl: chat_ctrl, databaseUrl: URL, _ processReceivedMsg: @escaping (ChatEvent) async -> Void) {
self.ctrl = ctrl
self.databaseUrl = databaseUrl
self.processReceivedMsg = processReceivedMsg
@ -752,11 +752,11 @@ private class MigrationChatReceiver {
func receiveMsgLoop() async {
// TODO use function that has timeout
if let msg: ChatResponse = await chatRecvMsg(ctrl) {
if let msg: ChatEvent = await chatRecvMsg(ctrl) {
Task {
await TerminalItems.shared.add(.resp(.now, msg))
await TerminalItems.shared.add(.event(.now, msg))
}
logger.debug("processReceivedMsg: \(msg.responseType)")
logger.debug("processReceivedMsg: \(msg.eventType)")
await processReceivedMsg(msg)
}
if self.receiveMessages {

10
apps/ios/Shared/Views/Migration/MigrateToDevice.swift
View file

@ -516,7 +516,7 @@ struct MigrateToDevice: View {
alert = .error(title: "Download failed", error: "File was deleted or link is invalid")
migrationState = .downloadFailed(totalBytes: totalBytes, link: link, archivePath: archivePath)
default:
logger.debug("unsupported event: \(msg.responseType)")
logger.debug("unsupported event: \(msg.eventType)")
}
}
}
@ -751,11 +751,11 @@ private func progressView() -> some View {
private class MigrationChatReceiver {
let ctrl: chat_ctrl
let databaseUrl: URL
let processReceivedMsg: (ChatResponse) async -> Void
let processReceivedMsg: (ChatEvent) async -> Void
private var receiveLoop: Task<Void, Never>?
private var receiveMessages = true
init(ctrl: chat_ctrl, databaseUrl: URL, _ processReceivedMsg: @escaping (ChatResponse) async -> Void) {
init(ctrl: chat_ctrl, databaseUrl: URL, _ processReceivedMsg: @escaping (ChatEvent) async -> Void) {
self.ctrl = ctrl
self.databaseUrl = databaseUrl
self.processReceivedMsg = processReceivedMsg
@ -772,9 +772,9 @@ private class MigrationChatReceiver {
// TODO use function that has timeout
if let msg = await chatRecvMsg(ctrl) {
Task {
await TerminalItems.shared.add(.resp(.now, msg))
await TerminalItems.shared.add(.event(.now, msg))
}
logger.debug("processReceivedMsg: \(msg.responseType)")
logger.debug("processReceivedMsg: \(msg.eventType)")
await processReceivedMsg(msg)
}
if self.receiveMessages {

128
apps/ios/SimpleX NSE/NSEAPITypes.swift
View file

@ -52,21 +52,12 @@ enum NSEChatResponse: Decodable, Error, ChatRespProtocol {
case activeUser(user: User)
case chatStarted
case chatRunning
case chatSuspended
case contactConnected(user: UserRef, contact: Contact, userCustomProfile: Profile?)
case receivedContactRequest(user: UserRef, contactRequest: UserContactRequest)
case newChatItems(user: UserRef, chatItems: [AChatItem])
case rcvFileAccepted(user: UserRef, chatItem: AChatItem)
case rcvFileSndCancelled(user: UserRef, chatItem: AChatItem, rcvFileTransfer: RcvFileTransfer)
case sndFileComplete(user: UserRef, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileRcvCancelled(user: UserRef, chatItem_: AChatItem?, sndFileTransfer: SndFileTransfer)
case callInvitation(callInvitation: RcvCallInvitation)
case ntfConns(ntfConns: [NtfConn])
case connNtfMessages(receivedMsgs: [NtfMsgInfo?])
case ntfMessage(user: UserRef, connEntity: ConnectionEntity, ntfMessage: NtfMsgAckInfo)
case cmdOk(user_: UserRef?)
case chatCmdError(user_: UserRef?, chatError: ChatError)
case chatError(user_: UserRef?, chatError: ChatError)
var responseType: String {
switch self {
@ -74,21 +65,12 @@ enum NSEChatResponse: Decodable, Error, ChatRespProtocol {
case .activeUser: "activeUser"
case .chatStarted: "chatStarted"
case .chatRunning: "chatRunning"
case .chatSuspended: "chatSuspended"
case .contactConnected: "contactConnected"
case .receivedContactRequest: "receivedContactRequest"
case .newChatItems: "newChatItems"
case .rcvFileAccepted: "rcvFileAccepted"
case .rcvFileSndCancelled: "rcvFileSndCancelled"
case .sndFileComplete: "sndFileComplete"
case .sndFileRcvCancelled: "sndFileRcvCancelled"
case .callInvitation: "callInvitation"
case .ntfConns: "ntfConns"
case .connNtfMessages: "connNtfMessages"
case .ntfMessage: "ntfMessage"
case .cmdOk: "cmdOk"
case .chatCmdError: "chatCmdError"
case .chatError: "chatError"
}
}
@ -98,23 +80,12 @@ enum NSEChatResponse: Decodable, Error, ChatRespProtocol {
case let .activeUser(user): return String(describing: user)
case .chatStarted: return noDetails
case .chatRunning: return noDetails
case .chatSuspended: return noDetails
case let .contactConnected(u, contact, _): return withUser(u, String(describing: contact))
case let .receivedContactRequest(u, contactRequest): return withUser(u, String(describing: contactRequest))
case let .newChatItems(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .rcvFileAccepted(u, chatItem): return withUser(u, String(describing: chatItem))
case let .rcvFileSndCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileComplete(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileRcvCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .callInvitation(inv): return String(describing: inv)
case let .ntfConns(ntfConns): return String(describing: ntfConns)
case let .connNtfMessages(receivedMsgs): return "receivedMsgs: \(String(describing: receivedMsgs))"
case let .ntfMessage(u, connEntity, ntfMessage): return withUser(u, "connEntity: \(String(describing: connEntity))\nntfMessage: \(String(describing: ntfMessage))")
case .cmdOk: return noDetails
case let .chatCmdError(u, chatError): return withUser(u, String(describing: chatError))
case let .chatError(u, chatError): return withUser(u, String(describing: chatError))
}
}
@ -144,10 +115,6 @@ enum NSEChatResponse: Decodable, Error, ChatRespProtocol {
if let jError = jResp["chatCmdError"] as? NSDictionary {
return .chatCmdError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
} else if type == "chatError" {
if let jError = jResp["chatError"] as? NSDictionary {
return .chatError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
}
}
json = serializeJSON(j, options: .prettyPrinted)
@ -158,7 +125,6 @@ enum NSEChatResponse: Decodable, Error, ChatRespProtocol {
var chatError: ChatError? {
switch self {
case let .chatCmdError(_, error): error
case let .chatError(_, error): error
default: nil
}
}
@ -166,6 +132,100 @@ enum NSEChatResponse: Decodable, Error, ChatRespProtocol {
var chatErrorType: ChatErrorType? {
switch self {
case let .chatCmdError(_, .error(error)): error
default: nil
}
}
}
enum NSEChatEvent: Decodable, Error, ChatEventProtocol {
case event(type: String, json: String)
case chatSuspended
case contactConnected(user: UserRef, contact: Contact, userCustomProfile: Profile?)
case receivedContactRequest(user: UserRef, contactRequest: UserContactRequest)
case newChatItems(user: UserRef, chatItems: [AChatItem])
case rcvFileSndCancelled(user: UserRef, chatItem: AChatItem, rcvFileTransfer: RcvFileTransfer)
case sndFileComplete(user: UserRef, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
case sndFileRcvCancelled(user: UserRef, chatItem_: AChatItem?, sndFileTransfer: SndFileTransfer)
case callInvitation(callInvitation: RcvCallInvitation)
case ntfMessage(user: UserRef, connEntity: ConnectionEntity, ntfMessage: NtfMsgAckInfo)
case chatError(user_: UserRef?, chatError: ChatError)
var eventType: String {
switch self {
case let .event(type, _): "* \(type)"
case .chatSuspended: "chatSuspended"
case .contactConnected: "contactConnected"
case .receivedContactRequest: "receivedContactRequest"
case .newChatItems: "newChatItems"
case .rcvFileSndCancelled: "rcvFileSndCancelled"
case .sndFileComplete: "sndFileComplete"
case .sndFileRcvCancelled: "sndFileRcvCancelled"
case .callInvitation: "callInvitation"
case .ntfMessage: "ntfMessage"
case .chatError: "chatError"
}
}
var details: String {
switch self {
case let .event(_, json): return json
case .chatSuspended: return noDetails
case let .contactConnected(u, contact, _): return withUser(u, String(describing: contact))
case let .receivedContactRequest(u, contactRequest): return withUser(u, String(describing: contactRequest))
case let .newChatItems(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .rcvFileSndCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileComplete(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .sndFileRcvCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .callInvitation(inv): return String(describing: inv)
case let .ntfMessage(u, connEntity, ntfMessage): return withUser(u, "connEntity: \(String(describing: connEntity))\nntfMessage: \(String(describing: ntfMessage))")
case let .chatError(u, chatError): return withUser(u, String(describing: chatError))
}
}
var noDetails: String { "\(eventType): no details" }
static func chatEvent(_ s: String) -> NSEChatEvent {
let d = s.data(using: .utf8)!
// TODO is there a way to do it without copying the data? e.g:
// let p = UnsafeMutableRawPointer.init(mutating: UnsafeRawPointer(cjson))
// let d = Data.init(bytesNoCopy: p, count: strlen(cjson), deallocator: .free)
do {
let r = try jsonDecoder.decode(APIResponse<NSEChatEvent>.self, from: d)
return r.resp
} catch {
logger.error("chatResponse jsonDecoder.decode error: \(error.localizedDescription)")
}
var type: String?
var json: String?
if let j = try? JSONSerialization.jsonObject(with: d) as? NSDictionary {
if let jResp = j["resp"] as? NSDictionary, jResp.count == 1 || jResp.count == 2 {
type = jResp.allKeys[0] as? String
if jResp.count == 2 && type == "_owsf" {
type = jResp.allKeys[1] as? String
}
if type == "chatError" {
if let jError = jResp["chatError"] as? NSDictionary {
return .chatError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
}
}
json = serializeJSON(j, options: .prettyPrinted)
}
return NSEChatEvent.event(type: type ?? "invalid", json: json ?? s)
}
var chatError: ChatError? {
switch self {
case let .chatError(_, error): error
default: nil
}
}
var chatErrorType: ChatErrorType? {
switch self {
case let .chatError(_, .error(error)): error
default: nil
}

10
apps/ios/SimpleX NSE/NotificationService.swift
View file

@ -789,9 +789,9 @@ func receiveMessages() async {
}
}
func chatRecvMsg() async -> NSEChatResponse? {
func chatRecvMsg() async -> NSEChatEvent? {
await withCheckedContinuation { cont in
let resp: NSEChatResponse? = recvSimpleXMsg()
let resp: NSEChatEvent? = recvSimpleXMsg()
cont.resume(returning: resp)
}
}
@ -799,8 +799,8 @@ func chatRecvMsg() async -> NSEChatResponse? {
private let isInChina = SKStorefront().countryCode == "CHN"
private func useCallKit() -> Bool { !isInChina && callKitEnabledGroupDefault.get() }
func receivedMsgNtf(_ res: NSEChatResponse) async -> (String, NSENotificationData)? {
logger.debug("NotificationService receivedMsgNtf: \(res.responseType)")
func receivedMsgNtf(_ res: NSEChatEvent) async -> (String, NSENotificationData)? {
logger.debug("NotificationService receivedMsgNtf: \(res.eventType)")
switch res {
case let .contactConnected(user, contact, _):
return (contact.id, .contactConnected(user, contact))
@ -849,7 +849,7 @@ func receivedMsgNtf(_ res: NSEChatResponse) async -> (String, NSENotificationDat
logger.error("NotificationService receivedMsgNtf error: \(String(describing: err))")
return nil
default:
logger.debug("NotificationService receivedMsgNtf ignored event: \(res.responseType)")
logger.debug("NotificationService receivedMsgNtf ignored event: \(res.eventType)")
return nil
}
}

114
apps/ios/SimpleX SE/ShareAPI.swift
View file

@ -96,7 +96,7 @@ func apiSuspendChat(expired: Bool) {
if case .cmdOk = r, !expired {
let startTime = CFAbsoluteTimeGetCurrent()
while CFAbsoluteTimeGetCurrent() - startTime < 3 {
let msg: SEChatResponse? = recvSimpleXMsg(messageTimeout: 3_500000)
let msg: SEChatEvent? = recvSimpleXMsg(messageTimeout: 3_500000)
switch msg {
case .chatSuspended:
suspended = false
@ -156,17 +156,10 @@ enum SEChatResponse: Decodable, Error, ChatRespProtocol {
case activeUser(user: User)
case chatStarted
case chatRunning
case chatSuspended
case apiChats(user: UserRef, chats: [ChatData])
case newChatItems(user: UserRef, chatItems: [AChatItem])
case sndFileProgressXFTP(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, sentSize: Int64, totalSize: Int64)
case sndFileCompleteXFTP(user: UserRef, chatItem: AChatItem, fileTransferMeta: FileTransferMeta)
case chatItemsStatusesUpdated(user: UserRef, chatItems: [AChatItem])
case sndFileError(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
case sndFileWarning(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
case cmdOk(user_: UserRef?)
case chatCmdError(user_: UserRef?, chatError: ChatError)
case chatError(user_: UserRef?, chatError: ChatError)
var responseType: String {
switch self {
@ -174,17 +167,10 @@ enum SEChatResponse: Decodable, Error, ChatRespProtocol {
case .activeUser: "activeUser"
case .chatStarted: "chatStarted"
case .chatRunning: "chatRunning"
case .chatSuspended: "chatSuspended"
case .apiChats: "apiChats"
case .newChatItems: "newChatItems"
case .sndFileProgressXFTP: "sndFileProgressXFTP"
case .sndFileCompleteXFTP: "sndFileCompleteXFTP"
case .chatItemsStatusesUpdated: "chatItemsStatusesUpdated"
case .sndFileError: "sndFileError"
case .sndFileWarning: "sndFileWarning"
case .cmdOk: "cmdOk"
case .chatCmdError: "chatCmdError"
case .chatError: "chatError"
}
}
@ -194,21 +180,12 @@ enum SEChatResponse: Decodable, Error, ChatRespProtocol {
case let .activeUser(user): return String(describing: user)
case .chatStarted: return noDetails
case .chatRunning: return noDetails
case .chatSuspended: return noDetails
case let .apiChats(u, chats): return withUser(u, String(describing: chats))
case let .newChatItems(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .sndFileProgressXFTP(u, chatItem, _, sentSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nsentSize: \(sentSize)\ntotalSize: \(totalSize)")
case let .sndFileCompleteXFTP(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .chatItemsStatusesUpdated(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .sndFileError(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .sndFileWarning(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case .cmdOk: return noDetails
case let .chatCmdError(u, chatError): return withUser(u, String(describing: chatError))
case let .chatError(u, chatError): return withUser(u, String(describing: chatError))
}
}
@ -242,10 +219,6 @@ enum SEChatResponse: Decodable, Error, ChatRespProtocol {
if let jError = jResp["chatCmdError"] as? NSDictionary {
return .chatCmdError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
} else if type == "chatError" {
if let jError = jResp["chatError"] as? NSDictionary {
return .chatError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
}
}
json = serializeJSON(j, options: .prettyPrinted)
@ -256,7 +229,6 @@ enum SEChatResponse: Decodable, Error, ChatRespProtocol {
var chatError: ChatError? {
switch self {
case let .chatCmdError(_, error): error
case let .chatError(_, error): error
default: nil
}
}
@ -264,6 +236,90 @@ enum SEChatResponse: Decodable, Error, ChatRespProtocol {
var chatErrorType: ChatErrorType? {
switch self {
case let .chatCmdError(_, .error(error)): error
default: nil
}
}
}
enum SEChatEvent: Decodable, Error, ChatEventProtocol {
case event(type: String, json: String)
case chatSuspended
case sndFileProgressXFTP(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, sentSize: Int64, totalSize: Int64)
case sndFileCompleteXFTP(user: UserRef, chatItem: AChatItem, fileTransferMeta: FileTransferMeta)
case chatItemsStatusesUpdated(user: UserRef, chatItems: [AChatItem])
case sndFileError(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
case sndFileWarning(user: UserRef, chatItem_: AChatItem?, fileTransferMeta: FileTransferMeta, errorMessage: String)
case chatError(user_: UserRef?, chatError: ChatError)
var eventType: String {
switch self {
case let .event(type, _): "* \(type)"
case .chatSuspended: "chatSuspended"
case .sndFileProgressXFTP: "sndFileProgressXFTP"
case .sndFileCompleteXFTP: "sndFileCompleteXFTP"
case .chatItemsStatusesUpdated: "chatItemsStatusesUpdated"
case .sndFileError: "sndFileError"
case .sndFileWarning: "sndFileWarning"
case .chatError: "chatError"
}
}
var details: String {
switch self {
case let .event(_, json): return json
case .chatSuspended: return noDetails
case let .sndFileProgressXFTP(u, chatItem, _, sentSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nsentSize: \(sentSize)\ntotalSize: \(totalSize)")
case let .sndFileCompleteXFTP(u, chatItem, _): return withUser(u, String(describing: chatItem))
case let .chatItemsStatusesUpdated(u, chatItems):
let itemsString = chatItems.map { chatItem in String(describing: chatItem) }.joined(separator: "\n")
return withUser(u, itemsString)
case let .sndFileError(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .sndFileWarning(u, chatItem, _, err): return withUser(u, "error: \(String(describing: err))\nchatItem: \(String(describing: chatItem))")
case let .chatError(u, chatError): return withUser(u, String(describing: chatError))
}
}
var noDetails: String { "\(eventType): no details" }
static func chatEvent(_ s: String) -> SEChatEvent {
let d = s.data(using: .utf8)!
// TODO is there a way to do it without copying the data? e.g:
// let p = UnsafeMutableRawPointer.init(mutating: UnsafeRawPointer(cjson))
// let d = Data.init(bytesNoCopy: p, count: strlen(cjson), deallocator: .free)
do {
let r = try jsonDecoder.decode(APIResponse<SEChatEvent>.self, from: d)
return r.resp
} catch {
logger.error("chatResponse jsonDecoder.decode error: \(error.localizedDescription)")
}
var type: String?
var json: String?
if let j = try? JSONSerialization.jsonObject(with: d) as? NSDictionary {
if let jResp = j["resp"] as? NSDictionary, jResp.count == 1 || jResp.count == 2 {
type = jResp.allKeys[0] as? String
if jResp.count == 2 && type == "_owsf" {
type = jResp.allKeys[1] as? String
}
if type == "chatError" {
if let jError = jResp["chatError"] as? NSDictionary {
return .chatError(user_: decodeUser_(jError), chatError: .invalidJSON(json: errorJson(jError) ?? ""))
}
}
}
json = serializeJSON(j, options: .prettyPrinted)
}
return SEChatEvent.event(type: type ?? "invalid", json: json ?? s)
}
var chatError: ChatError? {
switch self {
case let .chatError(_, error): error
default: nil
}
}
var chatErrorType: ChatErrorType? {
switch self {
case let .chatError(_, .error(error)): error
default: nil
}

4
apps/ios/SimpleX SE/ShareModel.swift
View file

@ -303,7 +303,7 @@ class ShareModel: ObservableObject {
}
}
}
let r: SEChatResponse? = recvSimpleXMsg(messageTimeout: 1_000_000)
let r: SEChatEvent? = recvSimpleXMsg(messageTimeout: 1_000_000)
switch r {
case let .sndFileProgressXFTP(_, ci, _, sentSize, totalSize):
guard isMessage(for: ci) else { continue }
@ -353,8 +353,6 @@ class ShareModel: ObservableObject {
return ErrorAlert(title: "File error", message: "\(fileErrorInfo(ci) ?? errorMessage)")
case let .chatError(_, chatError):
return ErrorAlert(chatError)
case let .chatCmdError(_, chatError):
return ErrorAlert(chatError)
default: continue
}
}

4
apps/ios/SimpleXChat/API.swift
View file

@ -119,10 +119,10 @@ public func sendSimpleXCmd<CR: ChatRespProtocol>(_ cmd: ChatCmdProtocol, _ ctrl:
// in microseconds
public let MESSAGE_TIMEOUT: Int32 = 15_000_000
public func recvSimpleXMsg<CR: ChatRespProtocol>(_ ctrl: chat_ctrl? = nil, messageTimeout: Int32 = MESSAGE_TIMEOUT) -> CR? {
public func recvSimpleXMsg<CEvt: ChatEventProtocol>(_ ctrl: chat_ctrl? = nil, messageTimeout: Int32 = MESSAGE_TIMEOUT) -> CEvt? {
if let cjson = chat_recv_msg_wait(ctrl ?? getChatCtrl(), messageTimeout) {
let s = fromCString(cjson)
return s == "" ? nil : CR.chatResponse(s)
return s == "" ? nil : CEvt.chatEvent(s)
}
return nil
}

8
apps/ios/SimpleXChat/APITypes.swift
View file

@ -33,6 +33,14 @@ public protocol ChatRespProtocol: Decodable, Error {
var chatErrorType: ChatErrorType? { get }
}
public protocol ChatEventProtocol: Decodable, Error {
var eventType: String { get }
var details: String { get }
static func chatEvent(_ s: String) -> Self
var chatError: ChatError? { get }
var chatErrorType: ChatErrorType? { get }
}
public func parseApiChats(_ jResp: NSDictionary) -> (user: UserRef, chats: [ChatData])? {
if let jApiChats = jResp["apiChats"] as? NSDictionary,
let user: UserRef = try? decodeObject(jApiChats["user"] as Any),

24
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
View file

@ -5792,8 +5792,6 @@ sealed class CR {
@Serializable @SerialName("groupMemberRatchetSyncStarted") class GroupMemberRatchetSyncStarted(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember, val connectionStats: ConnectionStats): CR()
@Serializable @SerialName("contactRatchetSync") class ContactRatchetSync(val user: UserRef, val contact: Contact, val ratchetSyncProgress: RatchetSyncProgress): CR()
@Serializable @SerialName("groupMemberRatchetSync") class GroupMemberRatchetSync(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember, val ratchetSyncProgress: RatchetSyncProgress): CR()
@Serializable @SerialName("contactVerificationReset") class ContactVerificationReset(val user: UserRef, val contact: Contact): CR()
@Serializable @SerialName("groupMemberVerificationReset") class GroupMemberVerificationReset(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember): 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()
@ -5835,10 +5833,6 @@ sealed class CR {
// TODO remove above
@Serializable @SerialName("networkStatus") class NetworkStatusResp(val networkStatus: NetworkStatus, val connections: List<String>): CR()
@Serializable @SerialName("networkStatuses") class NetworkStatuses(val user_: UserRef?, val networkStatuses: List<ConnNetworkStatus>): CR()
@Serializable @SerialName("groupSubscribed") class GroupSubscribed(val user: UserRef, val group: GroupRef): CR()
@Serializable @SerialName("memberSubErrors") class MemberSubErrors(val user: UserRef, val memberSubErrors: List<MemberSubError>): CR()
@Serializable @SerialName("groupEmpty") class GroupEmpty(val user: UserRef, val group: GroupInfo): CR()
@Serializable @SerialName("userContactLinkSubscribed") class UserContactLinkSubscribed: CR()
@Serializable @SerialName("newChatItems") class NewChatItems(val user: UserRef, val chatItems: List<AChatItem>): CR()
@Serializable @SerialName("chatItemsStatusesUpdated") class ChatItemsStatusesUpdated(val user: UserRef, val chatItems: List<AChatItem>): CR()
@Serializable @SerialName("chatItemUpdated") class ChatItemUpdated(val user: UserRef, val chatItem: AChatItem): CR()
@ -5869,11 +5863,9 @@ sealed class CR {
@Serializable @SerialName("leftMember") class LeftMember(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember): CR()
@Serializable @SerialName("groupDeleted") class GroupDeleted(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember): CR()
@Serializable @SerialName("contactsMerged") class ContactsMerged(val user: UserRef, val intoContact: Contact, val mergedContact: Contact): CR()
@Serializable @SerialName("groupInvitation") class GroupInvitation(val user: UserRef, val groupInfo: GroupInfo): CR() // unused
@Serializable @SerialName("userJoinedGroup") class UserJoinedGroup(val user: UserRef, val groupInfo: GroupInfo): CR()
@Serializable @SerialName("joinedGroupMember") class JoinedGroupMember(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember): CR()
@Serializable @SerialName("connectedToGroupMember") class ConnectedToGroupMember(val user: UserRef, val groupInfo: GroupInfo, val member: GroupMember, val memberContact: Contact? = null): CR()
@Serializable @SerialName("groupRemoved") class GroupRemoved(val user: UserRef, val groupInfo: GroupInfo): CR() // unused
@Serializable @SerialName("groupUpdated") class GroupUpdated(val user: UserRef, val toGroup: GroupInfo): CR()
@Serializable @SerialName("groupLinkCreated") class GroupLinkCreated(val user: UserRef, val groupInfo: GroupInfo, val connLinkContact: CreatedConnLink, val memberRole: GroupMemberRole): CR()
@Serializable @SerialName("groupLink") class GroupLink(val user: UserRef, val groupInfo: GroupInfo, val connLinkContact: CreatedConnLink, val memberRole: GroupMemberRole): CR()
@ -5980,8 +5972,6 @@ sealed class CR {
is GroupMemberRatchetSyncStarted -> "groupMemberRatchetSyncStarted"
is ContactRatchetSync -> "contactRatchetSync"
is GroupMemberRatchetSync -> "groupMemberRatchetSync"
is ContactVerificationReset -> "contactVerificationReset"
is GroupMemberVerificationReset -> "groupMemberVerificationReset"
is ContactCode -> "contactCode"
is GroupMemberCode -> "groupMemberCode"
is ConnectionVerified -> "connectionVerified"
@ -6021,10 +6011,6 @@ sealed class CR {
is ContactSubSummary -> "contactSubSummary"
is NetworkStatusResp -> "networkStatus"
is NetworkStatuses -> "networkStatuses"
is GroupSubscribed -> "groupSubscribed"
is MemberSubErrors -> "memberSubErrors"
is GroupEmpty -> "groupEmpty"
is UserContactLinkSubscribed -> "userContactLinkSubscribed"
is NewChatItems -> "newChatItems"
is ChatItemsStatusesUpdated -> "chatItemsStatusesUpdated"
is ChatItemUpdated -> "chatItemUpdated"
@ -6054,11 +6040,9 @@ sealed class CR {
is LeftMember -> "leftMember"
is GroupDeleted -> "groupDeleted"
is ContactsMerged -> "contactsMerged"
is GroupInvitation -> "groupInvitation"
is UserJoinedGroup -> "userJoinedGroup"
is JoinedGroupMember -> "joinedGroupMember"
is ConnectedToGroupMember -> "connectedToGroupMember"
is GroupRemoved -> "groupRemoved"
is GroupUpdated -> "groupUpdated"
is GroupLinkCreated -> "groupLinkCreated"
is GroupLink -> "groupLink"
@ -6158,8 +6142,6 @@ sealed class CR {
is GroupMemberRatchetSyncStarted -> withUser(user, "group: ${json.encodeToString(groupInfo)}\nmember: ${json.encodeToString(member)}\nconnectionStats: ${json.encodeToString(connectionStats)}")
is ContactRatchetSync -> withUser(user, "contact: ${json.encodeToString(contact)}\nratchetSyncProgress: ${json.encodeToString(ratchetSyncProgress)}")
is GroupMemberRatchetSync -> withUser(user, "group: ${json.encodeToString(groupInfo)}\nmember: ${json.encodeToString(member)}\nratchetSyncProgress: ${json.encodeToString(ratchetSyncProgress)}")
is ContactVerificationReset -> withUser(user, "contact: ${json.encodeToString(contact)}")
is GroupMemberVerificationReset -> withUser(user, "group: ${json.encodeToString(groupInfo)}\nmember: ${json.encodeToString(member)}")
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")
@ -6199,10 +6181,6 @@ sealed class CR {
is ContactSubSummary -> withUser(user, json.encodeToString(contactSubscriptions))
is NetworkStatusResp -> "networkStatus $networkStatus\nconnections: $connections"
is NetworkStatuses -> withUser(user_, json.encodeToString(networkStatuses))
is GroupSubscribed -> withUser(user, json.encodeToString(group))
is MemberSubErrors -> withUser(user, json.encodeToString(memberSubErrors))
is GroupEmpty -> withUser(user, json.encodeToString(group))
is UserContactLinkSubscribed -> noDetails()
is NewChatItems -> withUser(user, chatItems.joinToString("\n") { json.encodeToString(it) })
is ChatItemsStatusesUpdated -> withUser(user, chatItems.joinToString("\n") { json.encodeToString(it) })
is ChatItemUpdated -> withUser(user, json.encodeToString(chatItem))
@ -6232,11 +6210,9 @@ sealed class CR {
is LeftMember -> withUser(user, "groupInfo: $groupInfo\nmember: $member")
is GroupDeleted -> withUser(user, "groupInfo: $groupInfo\nmember: $member")
is ContactsMerged -> withUser(user, "intoContact: $intoContact\nmergedContact: $mergedContact")
is GroupInvitation -> withUser(user, json.encodeToString(groupInfo))
is UserJoinedGroup -> withUser(user, json.encodeToString(groupInfo))
is JoinedGroupMember -> withUser(user, "groupInfo: $groupInfo\nmember: $member")
is ConnectedToGroupMember -> withUser(user, "groupInfo: $groupInfo\nmember: $member\nmemberContact: $memberContact")
is GroupRemoved -> withUser(user, json.encodeToString(groupInfo))
is GroupUpdated -> withUser(user, json.encodeToString(toGroup))
is GroupLinkCreated -> withUser(user, "groupInfo: $groupInfo\nconnLinkContact: $connLinkContact\nmemberRole: $memberRole")
is GroupLink -> withUser(user, "groupInfo: $groupInfo\nconnLinkContact: $connLinkContact\nmemberRole: $memberRole")

8
apps/simplex-bot-advanced/Main.hs
View file

@ -43,12 +43,12 @@ mySquaringBot :: User -> ChatController -> IO ()
mySquaringBot _user cc = do
initializeBotAddress cc
race_ (forever $ void getLine) . forever $ do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
case resp of
CRContactConnected _ contact _ -> do
(_, evt) <- atomically . readTBQueue $ outputQ cc
case evt of
CEvtContactConnected _ contact _ -> do
contactConnected contact
sendMessage cc contact welcomeMessage
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
CEvtNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
let msg = ciContentToText mc
number_ = readMaybe (T.unpack msg) :: Maybe Integer
sendMessage cc contact $ case number_ of

41
apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
View file

@ -11,7 +11,6 @@ import Control.Concurrent (forkIO)
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Text as T
import Broadcast.Options
import Simplex.Chat.Bot
@ -38,39 +37,31 @@ broadcastBot :: BroadcastBotOpts -> User -> ChatController -> IO ()
broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _user cc = do
initializeBotAddress cc
race_ (forever $ void getLine) . forever $ do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
case resp of
CRContactConnected _ ct _ -> do
(_, evt) <- atomically . readTBQueue $ outputQ cc
case evt of
CEvtContactConnected _ ct _ -> do
contactConnected ct
sendMessage cc ct welcomeMessage
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc}) : _}
| publisher `elem` publishers ->
if allowContent mc
then do
sendChatCmd cc ListContacts >>= \case
CRContactsList _ cts -> void . forkIO $ do
sendChatCmd cc (SendMessageBroadcast mc) >>= \case
CRBroadcastSent {successes, failures} ->
sendReply $ "Forwarded to " <> tshow successes <> " contact(s), " <> tshow failures <> " errors"
r -> putStrLn $ "Error broadcasting message: " <> show r
r -> putStrLn $ "Error getting contacts list: " <> show r
else sendReply "!1 Message is not supported!"
| otherwise -> do
sendReply prohibitedMessage
deleteMessage cc ct $ chatItemId' ci
CEvtNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc}) : _}
| sender `notElem` publishers -> do
sendReply prohibitedMessage
deleteMessage cc ct $ chatItemId' ci
| allowContent mc ->
void $ forkIO $
sendChatCmd cc (SendMessageBroadcast mc) >>= \case
CRBroadcastSent {successes, failures} ->
sendReply $ "Forwarded to " <> tshow successes <> " contact(s), " <> tshow failures <> " errors"
r -> putStrLn $ "Error broadcasting message: " <> show r
| otherwise ->
sendReply "!1 Message is not supported!"
where
sendReply = sendComposedMessage cc ct (Just $ chatItemId' ci) . MCText
publisher = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
sender = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
allowContent = \case
MCText _ -> True
MCLink {} -> True
MCImage {} -> True
_ -> False
broadcastTo Contact {activeConn = Nothing} = False
broadcastTo ct'@Contact {activeConn = Just conn@Connection {connStatus}} =
(connStatus == ConnSndReady || connStatus == ConnReady)
&& not (connDisabled conn)
&& contactId' ct' /= contactId' ct
_ -> pure ()
where
contactConnected ct = putStrLn $ T.unpack (localDisplayName' ct) <> " connected"

39
apps/simplex-chat/Server.hs
View file

@ -2,9 +2,11 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Server where
@ -13,6 +15,7 @@ import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import GHC.Generics (Generic)
@ -23,11 +26,25 @@ import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Library.Commands
import Simplex.Chat.Options
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Transport.Server (runLocalTCPServer)
import Simplex.Messaging.Util (raceAny_)
import UnliftIO.Exception
import UnliftIO.STM
data ChatSrvRequest = ChatSrvRequest {corrId :: Text, cmd :: Text}
deriving (Generic, FromJSON)
data ChatSrvResponse r = ChatSrvResponse {corrId :: Maybe Text, resp :: r}
data AChatSrvResponse = forall r. ToJSON (ChatSrvResponse r) => ACR (ChatSrvResponse r)
$(pure [])
instance ToJSON r => ToJSON (ChatSrvResponse r) where
toEncoding = $(JQ.mkToEncoding defaultJSON ''ChatSrvResponse)
toJSON = $(JQ.mkToJSON defaultJSON ''ChatSrvResponse)
simplexChatServer :: ServiceName -> ChatConfig -> ChatOpts -> IO ()
simplexChatServer chatPort cfg opts =
simplexChatCore cfg opts . const $ runChatServer defaultChatServerConfig {chatPort}
@ -44,19 +61,9 @@ defaultChatServerConfig =
clientQSize = 1
}
data ChatSrvRequest = ChatSrvRequest {corrId :: Text, cmd :: Text}
deriving (Generic, FromJSON)
data ChatSrvResponse = ChatSrvResponse {corrId :: Maybe Text, resp :: ChatResponse}
deriving (Generic)
instance ToJSON ChatSrvResponse where
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
data ChatClient = ChatClient
{ rcvQ :: TBQueue (Text, ChatCommand),
sndQ :: TBQueue ChatSrvResponse
sndQ :: TBQueue AChatSrvResponse
}
newChatServerClient :: Natural -> STM ChatClient
@ -78,14 +85,14 @@ runChatServer ChatServerConfig {chatPort, clientQSize} cc = do
getConnection sock = WS.makePendingConnection sock WS.defaultConnectionOptions >>= WS.acceptRequest
send ws ChatClient {sndQ} =
forever $
atomically (readTBQueue sndQ) >>= WS.sendTextData ws . J.encode
atomically (readTBQueue sndQ) >>= \(ACR r) -> WS.sendTextData ws (J.encode r)
client ChatClient {rcvQ, sndQ} = forever $ do
atomically (readTBQueue rcvQ)
>>= processCommand
>>= atomically . writeTBQueue sndQ
>>= atomically . writeTBQueue sndQ . ACR
output ChatClient {sndQ} = forever $ do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
atomically $ writeTBQueue sndQ ChatSrvResponse {corrId = Nothing, resp}
(_, resp) <- atomically . readTBQueue $ outputQ cc
atomically $ writeTBQueue sndQ $ ACR ChatSrvResponse {corrId = Nothing, resp}
receive ws ChatClient {rcvQ, sndQ} = forever $ do
s <- WS.receiveData ws
case J.decodeStrict' s of
@ -96,7 +103,7 @@ runChatServer ChatServerConfig {chatPort, clientQSize} cc = do
Left e -> sendError (Just corrId) e
Nothing -> sendError Nothing "invalid request"
where
sendError corrId e = atomically $ writeTBQueue sndQ ChatSrvResponse {corrId, resp = chatCmdError Nothing e}
sendError corrId e = atomically $ writeTBQueue sndQ $ ACR ChatSrvResponse {corrId, resp = chatCmdError Nothing e}
processCommand (corrId, cmd) =
runReaderT (runExceptT $ processChatCommand cmd) cc >>= \case
Right resp -> response resp

37
apps/simplex-directory-service/src/Directory/Events.hs
View file

@ -63,41 +63,40 @@ data DirectoryEvent
| DELogChatResponse Text
deriving (Show)
crDirectoryEvent :: ChatResponse -> Maybe DirectoryEvent
crDirectoryEvent :: ChatEvent -> Maybe DirectoryEvent
crDirectoryEvent = \case
CRContactConnected {contact} -> Just $ DEContactConnected contact
CRReceivedGroupInvitation {contact, groupInfo, fromMemberRole, memberRole} -> Just $ DEGroupInvitation {contact, groupInfo, fromMemberRole, memberRole}
CRUserJoinedGroup {groupInfo, hostMember} -> (\contactId -> DEServiceJoinedGroup {contactId, groupInfo, hostMember}) <$> memberContactId hostMember
CRGroupUpdated {fromGroup, toGroup, member_} -> (\member -> DEGroupUpdated {member, fromGroup, toGroup}) <$> member_
CRJoinedGroupMember {groupInfo, member = m}
CEvtContactConnected {contact} -> Just $ DEContactConnected contact
CEvtReceivedGroupInvitation {contact, groupInfo, fromMemberRole, memberRole} -> Just $ DEGroupInvitation {contact, groupInfo, fromMemberRole, memberRole}
CEvtUserJoinedGroup {groupInfo, hostMember} -> (\contactId -> DEServiceJoinedGroup {contactId, groupInfo, hostMember}) <$> memberContactId hostMember
CEvtGroupUpdated {fromGroup, toGroup, member_} -> (\member -> DEGroupUpdated {member, fromGroup, toGroup}) <$> member_
CEvtJoinedGroupMember {groupInfo, member = m}
| pending m -> Just $ DEPendingMember groupInfo m
| otherwise -> Nothing
CRNewChatItems {chatItems = AChatItem _ _ (GroupChat g) ci : _} -> case ci of
CEvtNewChatItems {chatItems = AChatItem _ _ (GroupChat g) ci : _} -> case ci of
ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent (MCText t)} | pending m -> Just $ DEPendingMemberMsg g m (chatItemId' ci) t
_ -> Nothing
CRMemberRole {groupInfo, member, toRole}
CEvtMemberRole {groupInfo, member, toRole}
| groupMemberId' member == groupMemberId' (membership groupInfo) -> Just $ DEServiceRoleChanged groupInfo toRole
| otherwise -> (\ctId -> DEContactRoleChanged groupInfo ctId toRole) <$> memberContactId member
CRDeletedMember {groupInfo, deletedMember} -> (`DEContactRemovedFromGroup` groupInfo) <$> memberContactId deletedMember
CRLeftMember {groupInfo, member} -> (`DEContactLeftGroup` groupInfo) <$> memberContactId member
CRDeletedMemberUser {groupInfo} -> Just $ DEServiceRemovedFromGroup groupInfo
CRGroupDeleted {groupInfo} -> Just $ DEGroupDeleted groupInfo
CRChatItemUpdated {chatItem = AChatItem _ SMDRcv (DirectChat ct) _} -> Just $ DEItemEditIgnored ct
CRChatItemsDeleted {chatItemDeletions = ((ChatItemDeletion (AChatItem _ SMDRcv (DirectChat ct) _) _) : _), byUser = False} -> Just $ DEItemDeleteIgnored ct
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc, meta = CIMeta {itemLive}}) : _} ->
CEvtDeletedMember {groupInfo, deletedMember} -> (`DEContactRemovedFromGroup` groupInfo) <$> memberContactId deletedMember
CEvtLeftMember {groupInfo, member} -> (`DEContactLeftGroup` groupInfo) <$> memberContactId member
CEvtDeletedMemberUser {groupInfo} -> Just $ DEServiceRemovedFromGroup groupInfo
CEvtGroupDeleted {groupInfo} -> Just $ DEGroupDeleted groupInfo
CEvtChatItemUpdated {chatItem = AChatItem _ SMDRcv (DirectChat ct) _} -> Just $ DEItemEditIgnored ct
CEvtChatItemsDeleted {chatItemDeletions = ((ChatItemDeletion (AChatItem _ SMDRcv (DirectChat ct) _) _) : _), byUser = False} -> Just $ DEItemDeleteIgnored ct
CEvtNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc, meta = CIMeta {itemLive}}) : _} ->
Just $ case (mc, itemLive) of
(MCText t, Nothing) -> DEContactCommand ct ciId $ fromRight err $ A.parseOnly (directoryCmdP <* A.endOfInput) $ T.dropWhileEnd isSpace t
_ -> DEUnsupportedMessage ct ciId
where
ciId = chatItemId' ci
err = ADC SDRUser DCUnknownCommand
CRMessageError {severity, errorMessage} -> Just $ DELogChatResponse $ "message error: " <> severity <> ", " <> errorMessage
CRChatCmdError {chatError} -> Just $ DELogChatResponse $ "chat cmd error: " <> tshow chatError
CRChatError {chatError} -> case chatError of
CEvtMessageError {severity, errorMessage} -> Just $ DELogChatResponse $ "message error: " <> severity <> ", " <> errorMessage
CEvtChatError {chatError} -> case chatError of
ChatErrorAgent {agentError = BROKER _ NETWORK} -> Nothing
ChatErrorAgent {agentError = BROKER _ TIMEOUT} -> Nothing
_ -> Just $ DELogChatResponse $ "chat error: " <> tshow chatError
CRChatErrors {chatErrors} -> Just $ DELogChatResponse $ "chat errors: " <> T.intercalate ", " (map tshow chatErrors)
CEvtChatErrors {chatErrors} -> Just $ DELogChatResponse $ "chat errors: " <> T.intercalate ", " (map tshow chatErrors)
_ -> Nothing
where
pending m = memberStatus m == GSMemPendingApproval

4
apps/simplex-directory-service/src/Directory/Service.hs
View file

@ -153,7 +153,7 @@ directoryService :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> C
directoryService st opts@DirectoryOpts {testing} env user cc = do
initializeBotAddress' (not testing) cc
race_ (forever $ void getLine) . forever $ do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
(_, resp) <- atomically . readTBQueue $ outputQ cc
directoryServiceEvent st opts env user cc resp
acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))
@ -197,7 +197,7 @@ readBlockedWordsConfig DirectoryOpts {blockedFragmentsFile, blockedWordsFile, na
unless testing $ putStrLn $ "Blocked fragments: " <> show (length blockedFragments) <> ", blocked words: " <> show (length blockedWords) <> ", spelling rules: " <> show (M.size spelling)
pure BlockedWordsConfig {blockedFragments, blockedWords, extensionRules, spelling}
directoryServiceEvent :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> ChatResponse -> IO ()
directoryServiceEvent :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> ChatEvent -> IO ()
directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} env@ServiceState {searchRequests} user@User {userId} cc event =
forM_ (crDirectoryEvent event) $ \case
DEContactConnected ct -> deContactConnected ct

2
cabal.project
View file

@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 3d10c9bf9e4d8196d39162ff8712f6b729b8c247
tag: a632eea75b677cf2b146ad06ee875307d0321f23
source-repository-package
type: git

6
packages/simplex-chat-client/typescript/src/response.ts
View file

@ -84,7 +84,6 @@ export type ChatResponse =
| CRGroupRemoved
| CRGroupDeleted
| CRGroupUpdated
| CRUserContactLinkSubscribed
| CRUserContactLinkSubError
| CRContactConnectionDeleted
| CRMessageError
@ -182,7 +181,6 @@ type ChatResponseTag =
| "groupRemoved"
| "groupDeleted"
| "groupUpdated"
| "userContactLinkSubscribed"
| "userContactLinkSubError"
| "newContactConnection"
| "contactConnectionDeleted"
@ -721,10 +719,6 @@ export interface CRGroupUpdated extends CR {
member_?: GroupMember
}
export interface CRUserContactLinkSubscribed extends CR {
type: "userContactLinkSubscribed"
}
export interface CRUserContactLinkSubError extends CR {
type: "userContactLinkSubError"
chatError: ChatError

2
scripts/nix/sha256map.nix
View file

@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."3d10c9bf9e4d8196d39162ff8712f6b729b8c247" = "1nnr6klv240da97qmrzlh8jywpimcnlrxnxnjrm2rd0w0w7gvra1";
"https://github.com/simplex-chat/simplexmq.git"."a632eea75b677cf2b146ad06ee875307d0321f23" = "03vk7214941f5jwmf7sp26lxzh4c1xl89wqmlky379d6gwypbzy6";
"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";

8
src/Simplex/Chat/Bot.hs
View file

@ -33,12 +33,12 @@ chatBotRepl :: String -> (Contact -> String -> IO String) -> User -> ChatControl
chatBotRepl welcome answer _user cc = do
initializeBotAddress cc
race_ (forever $ void getLine) . forever $ do
(_, _, resp) <- atomically . readTBQueue $ outputQ cc
case resp of
CRContactConnected _ contact _ -> do
(_, event) <- atomically . readTBQueue $ outputQ cc
case event of
CEvtContactConnected _ contact _ -> do
contactConnected contact
void $ sendMessage cc contact $ T.pack welcome
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
CEvtNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
let msg = T.unpack $ ciContentToText mc
void $ sendMessage cc contact . T.pack =<< answer contact msg
_ -> pure ()

316
src/Simplex/Chat/Controller.hs
View file

@ -55,7 +55,6 @@ import Numeric.Natural
import qualified Paths_simplex_chat as SC
import Simplex.Chat.AppSettings
import Simplex.Chat.Call
import Simplex.Chat.Markdown (MarkdownList)
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Operators
@ -86,7 +85,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgId, NMsgMeta (..), NtfServer, ProtocolType (..), QueueId, SMPMsgMeta (..), SubscriptionMode (..), XFTPServer)
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), MsgId, NMsgMeta (..), NtfServer, ProtocolType (..), QueueId, SMPMsgMeta (..), SubscriptionMode (..), XFTPServer)
import Simplex.Messaging.TMap (TMap)
import Simplex.Messaging.Transport (TLS, simplexMQVersion)
import Simplex.Messaging.Transport.Client (SocksProxyWithAuth, TransportHost)
@ -176,7 +175,7 @@ data ChatHooks = ChatHooks
preCmdHook :: Maybe (ChatController -> ChatCommand -> IO (Either ChatResponse ChatCommand)),
-- eventHook can be used to additionally process or modify events,
-- it is called before the event is sent to the user (or to the UI).
eventHook :: Maybe (ChatController -> ChatResponse -> IO ChatResponse),
eventHook :: Maybe (ChatController -> ChatEvent -> IO ChatEvent),
-- acceptMember hook can be used to accept or reject member connecting via group link without API calls
acceptMember :: Maybe (GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole)))
}
@ -224,7 +223,7 @@ data ChatController = ChatController
random :: TVar ChaChaDRG,
eventSeq :: TVar Int,
inputQ :: TBQueue String,
outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse),
outputQ :: TBQueue (Maybe RemoteHostId, ChatEvent),
connNetworkStatuses :: TMap AgentConnId NetworkStatus,
subscriptionMode :: TVar SubscriptionMode,
chatLock :: Lock,
@ -548,7 +547,7 @@ data ChatCommand
| QuitChat
| ShowVersion
| DebugLocks
| DebugEvent ChatResponse
| DebugEvent ChatEvent
| GetAgentSubsTotal UserId
| GetAgentServersSummary UserId
| ResetAgentServersStats
@ -608,7 +607,6 @@ data ChatResponse
| CRChatStarted
| CRChatRunning
| CRChatStopped
| CRChatSuspended
| CRApiChats {user :: User, chats :: [AChat]}
| CRChats {chats :: [AChat]}
| CRApiChat {user :: User, chat :: AChat, navInfo :: Maybe NavigationInfo}
@ -616,7 +614,6 @@ data ChatResponse
| CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]}
| CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
| CRChatItemId User (Maybe ChatItemId)
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
| CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
| CRServerOperatorConditions {conditions :: ServerOperatorConditions}
| CRUserServers {user :: User, userServers :: [UserOperatorServers]}
@ -632,30 +629,20 @@ data ChatResponse
| CRGroupMemberSwitchStarted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
| CRContactSwitchAborted {user :: User, contact :: Contact, connectionStats :: ConnectionStats}
| CRGroupMemberSwitchAborted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
| CRContactSwitch {user :: User, contact :: Contact, switchProgress :: SwitchProgress}
| CRGroupMemberSwitch {user :: User, groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
| CRContactRatchetSyncStarted {user :: User, contact :: Contact, connectionStats :: ConnectionStats}
| CRGroupMemberRatchetSyncStarted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
| CRContactRatchetSync {user :: User, contact :: Contact, ratchetSyncProgress :: RatchetSyncProgress}
| CRGroupMemberRatchetSync {user :: User, groupInfo :: GroupInfo, member :: GroupMember, ratchetSyncProgress :: RatchetSyncProgress}
| CRContactVerificationReset {user :: User, contact :: Contact}
| CRGroupMemberVerificationReset {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| 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}
| CRChatItemNotChanged {user :: User, chatItem :: AChatItem}
| CRChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction}
| CRReactionMembers {user :: User, memberReactions :: [MemberReaction]}
| CRChatItemsDeleted {user :: User, chatItemDeletions :: [ChatItemDeletion], byUser :: Bool, timed :: Bool}
| CRGroupChatItemsDeleted {user :: User, groupInfo :: GroupInfo, chatItemIDs :: [ChatItemId], byUser :: Bool, member_ :: Maybe GroupMember}
| CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
| CRBroadcastSent {user :: User, msgContent :: MsgContent, successes :: Int, failures :: Int, timestamp :: UTCTime}
| CRMsgIntegrityError {user :: User, msgError :: MsgErrorType}
| CRCmdAccepted {corr :: CorrId}
| CRCmdOk {user_ :: Maybe User}
| CRChatHelp {helpSection :: HelpSection}
| CRWelcome {user :: User}
@ -666,8 +653,6 @@ data ChatResponse
| CRUserContactLinkUpdated {user :: User, contactLink :: UserContactLink}
| CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
| CRGroupLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRBusinessLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, fromContact :: Contact}
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool}
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
@ -684,134 +669,54 @@ data ChatResponse
| CRSentConfirmation {user :: User, connection :: PendingContactConnection}
| CRSentInvitation {user :: User, connection :: PendingContactConnection, customUserProfile :: Maybe Profile}
| CRSentInvitationToContact {user :: User, contact :: Contact, customUserProfile :: Maybe Profile}
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
| CRGroupMemberUpdated {user :: User, groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember}
| CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
| CRContactDeleted {user :: User, contact :: Contact}
| CRContactDeletedByContact {user :: User, contact :: Contact}
| CRChatCleared {user :: User, chatInfo :: AChatInfo}
| CRUserContactLinkCreated {user :: User, connLinkContact :: CreatedLinkContact}
| CRUserContactLinkDeleted {user :: User}
| CRReceivedContactRequest {user :: User, contactRequest :: UserContactRequest}
| CRAcceptingContactRequest {user :: User, contact :: Contact}
| CRAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}
| CRContactAlreadyExists {user :: User, contact :: Contact}
| CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
| CRBusinessRequestAlreadyAccepted {user :: User, groupInfo :: GroupInfo}
| CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
| CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
| CRForwardPlan {user :: User, itemsCount :: Int, chatItemIds :: [ChatItemId], forwardConfirmation :: Maybe ForwardConfirmation}
| CRRcvFileDescrReady {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer, rcvFileDescr :: RcvFileDescr}
| CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
-- TODO add chatItem :: AChatItem
| CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRStandaloneFileInfo {fileMeta :: Maybe J.Value}
| CRRcvStandaloneFileCreated {user :: User, rcvFileTransfer :: RcvFileTransfer} -- returned by _download
| CRRcvFileStart {user :: User, chatItem :: AChatItem} -- sent by chats
| CRRcvFileProgressXFTP {user :: User, chatItem_ :: Maybe AChatItem, receivedSize :: Int64, totalSize :: Int64, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
| CRRcvStandaloneFileComplete {user :: User, targetPath :: FilePath, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileCancelled {user :: User, chatItem_ :: Maybe AChatItem, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileSndCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileError {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileWarning {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
| CRSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileRcvCancelled {user :: User, chatItem_ :: Maybe AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileCancelled {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
| CRSndStandaloneFileCreated {user :: User, fileTransferMeta :: FileTransferMeta} -- returned by _upload
| CRSndFileStartXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} -- not used
| CRSndFileProgressXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
| CRSndFileRedirectStartXFTP {user :: User, fileTransferMeta :: FileTransferMeta, redirectMeta :: FileTransferMeta}
| CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CRSndStandaloneFileComplete {user :: User, fileTransferMeta :: FileTransferMeta, rcvURIs :: [Text]}
| CRSndFileCancelledXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta}
| CRSndFileError {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, errorMessage :: Text}
| CRSndFileWarning {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, errorMessage :: Text}
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile, updateSummary :: UserProfileUpdateSummary}
| CRUserProfileImage {user :: User, profile :: Profile}
| CRContactAliasUpdated {user :: User, toContact :: Contact}
| CRGroupAliasUpdated {user :: User, toGroup :: GroupInfo}
| CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection}
| CRContactPrefsUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
| CRContactConnecting {user :: User, contact :: Contact}
| CRContactConnected {user :: User, contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactSndReady {user :: User, contact :: Contact}
| CRContactAnotherClient {user :: User, contact :: Contact}
| CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
| CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactSubError {user :: User, contact :: Contact, chatError :: ChatError}
| CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
| CRNetworkStatus {networkStatus :: NetworkStatus, connections :: [AgentConnId]}
| CRNetworkStatuses {user_ :: Maybe User, networkStatuses :: [ConnNetworkStatus]}
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRGroupInvitation {user :: User, shortGroupInfo :: ShortGroupInfo}
| CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
| CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
| CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRMembersRoleUser {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], toRole :: GroupMemberRole}
| CRMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
| CRMembersBlockedForAllUser {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], blocked :: Bool}
| CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember, withMessages :: Bool}
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, withMessages :: Bool}
| CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember}
| CRUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember}
| CRUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember}
| CRGroupEmpty {user :: User, shortGroupInfo :: ShortGroupInfo}
| CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
| CRGroupProfile {user :: User, groupInfo :: GroupInfo}
| CRGroupDescription {user :: User, groupInfo :: GroupInfo} -- only used in CLI
| CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connLinkContact :: CreatedLinkContact, memberRole :: GroupMemberRole}
| CRGroupLink {user :: User, groupInfo :: GroupInfo, connLinkContact :: CreatedLinkContact, memberRole :: GroupMemberRole}
| CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
| CRAcceptingGroupJoinRequestMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRNoMemberContactCreating {user :: User, groupInfo :: GroupInfo, member :: GroupMember} -- only used in CLI
| CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CRNewMemberContactReceivedInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CRContactAndMemberAssociated {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember, updatedContact :: Contact}
| CRMemberSubError {user :: User, shortGroupInfo :: ShortGroupInfo, memberToSubscribe :: ShortGroupMember, chatError :: ChatError}
| CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
| CRGroupSubscribed {user :: User, shortGroupInfo :: ShortGroupInfo}
| CRPendingSubSummary {user :: User, pendingSubscriptions :: [PendingSubStatus]}
| CRSndFileSubError {user :: User, sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
| CRRcvFileSubError {user :: User, rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
| CRCallInvitation {callInvitation :: RcvCallInvitation}
| CRCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
| CRCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession}
| CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
| CRCallEnded {user :: User, contact :: Contact}
| CRCallInvitations {callInvitations :: [RcvCallInvitation]}
| CRUserContactLinkSubscribed -- TODO delete
| CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete
| CRNtfTokenStatus {status :: NtfTknStatus}
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode, ntfServer :: NtfServer}
| CRNtfConns {ntfConns :: [NtfConn]}
| CRConnNtfMessages {receivedMsgs :: NonEmpty (Maybe NtfMsgInfo)}
| CRNtfMessage {user :: User, connEntity :: ConnectionEntity, ntfMessage :: NtfMsgAckInfo}
| CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
| CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
| CRCurrentRemoteHost {remoteHost_ :: Maybe RemoteHostInfo}
| CRRemoteHostStarted {remoteHost_ :: Maybe RemoteHostInfo, invitation :: Text, ctrlPort :: String, localAddrs :: NonEmpty RCCtrlAddress}
| CRRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
| CRNewRemoteHost {remoteHost :: RemoteHostInfo}
| CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
| CRRemoteHostStopped {remoteHostId_ :: Maybe RemoteHostId, rhsState :: RemoteHostSessionState, rhStopReason :: RemoteHostStopReason}
| CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
| CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
| CRRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo, ctrlAppInfo_ :: Maybe CtrlAppInfo, appVersion :: AppVersion, compatible :: Bool}
| CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo, ctrlAppInfo :: CtrlAppInfo, appVersion :: AppVersion}
| CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
| CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
| CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason}
| CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption}
| CRSQLResult {rows :: [Text]}
#if !defined(dbPostgres)
| CRArchiveExported {archiveErrors :: [ArchiveError]}
@ -826,25 +731,134 @@ data ChatResponse
| CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]}
| CRAgentSubsDetails {agentSubs :: SubscriptionsInfo}
| CRAgentQueuesInfo {agentQueuesInfo :: AgentQueuesInfo}
| CRContactDisabled {user :: User, contact :: Contact}
| CRConnectionDisabled {connectionEntity :: ConnectionEntity}
| CRConnectionInactive {connectionEntity :: ConnectionEntity, inactive :: Bool}
| CRAgentRcvQueuesDeleted {deletedRcvQueues :: NonEmpty DeletedRcvQueue}
| CRAgentConnsDeleted {agentConnIds :: NonEmpty AgentConnId}
| CRAgentUserDeleted {agentUserId :: Int64}
| CRMessageError {user :: User, severity :: Text, errorMessage :: Text}
| CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
| CRChatError {user_ :: Maybe User, chatError :: ChatError}
| CRChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
| CRAppSettings {appSettings :: AppSettings}
| CRTimedAction {action :: String, durationMilliseconds :: Int64}
| CRCustomChatResponse {user_ :: Maybe User, response :: Text}
| CRTerminalEvent TerminalEvent
deriving (Show)
data ChatEvent
= CEvtChatSuspended
| CEvtContactSwitch {user :: User, contact :: Contact, switchProgress :: SwitchProgress}
| CEvtGroupMemberSwitch {user :: User, groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
| CEvtContactRatchetSync {user :: User, contact :: Contact, ratchetSyncProgress :: RatchetSyncProgress}
| CEvtGroupMemberRatchetSync {user :: User, groupInfo :: GroupInfo, member :: GroupMember, ratchetSyncProgress :: RatchetSyncProgress}
| CEvtNewChatItems {user :: User, chatItems :: [AChatItem]} -- there is the same command response
| CEvtChatItemsStatusesUpdated {user :: User, chatItems :: [AChatItem]}
| CEvtChatItemUpdated {user :: User, chatItem :: AChatItem} -- there is the same command response
| CEvtChatItemNotChanged {user :: User, chatItem :: AChatItem} -- there is the same command response
| CEvtChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction} -- there is the same command response
| CEvtGroupChatItemsDeleted {user :: User, groupInfo :: GroupInfo, chatItemIDs :: [ChatItemId], byUser :: Bool, member_ :: Maybe GroupMember} -- there is the same command response
| CEvtChatItemsDeleted {user :: User, chatItemDeletions :: [ChatItemDeletion], byUser :: Bool, timed :: Bool} -- there is the same command response
| CEvtChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
| CEvtUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact} -- there is the same command response
| CEvtGroupLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CEvtBusinessLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, fromContact :: Contact}
| CEvtSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember} -- there is the same command response
| CEvtContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
| CEvtGroupMemberUpdated {user :: User, groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember}
| CEvtContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
| CEvtContactDeletedByContact {user :: User, contact :: Contact}
| CEvtReceivedContactRequest {user :: User, contactRequest :: UserContactRequest}
| CEvtAcceptingContactRequest {user :: User, contact :: Contact} -- there is the same command response
| CEvtAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}
| CEvtContactRequestAlreadyAccepted {user :: User, contact :: Contact}
| CEvtBusinessRequestAlreadyAccepted {user :: User, groupInfo :: GroupInfo}
| CEvtRcvFileDescrReady {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer, rcvFileDescr :: RcvFileDescr}
| CEvtRcvFileAccepted {user :: User, chatItem :: AChatItem} -- there is the same command response
-- TODO add chatItem :: AChatItem
| CEvtRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer} -- there is the same command response
| CEvtRcvFileStart {user :: User, chatItem :: AChatItem} -- sent by chats
| CEvtRcvFileProgressXFTP {user :: User, chatItem_ :: Maybe AChatItem, receivedSize :: Int64, totalSize :: Int64, rcvFileTransfer :: RcvFileTransfer}
| CEvtRcvFileComplete {user :: User, chatItem :: AChatItem}
| CEvtRcvStandaloneFileComplete {user :: User, targetPath :: FilePath, rcvFileTransfer :: RcvFileTransfer}
| CEvtRcvFileSndCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
| CEvtRcvFileError {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
| CEvtRcvFileWarning {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
| CEvtSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CEvtSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CEvtSndFileRcvCancelled {user :: User, chatItem_ :: Maybe AChatItem, sndFileTransfer :: SndFileTransfer}
| CEvtSndFileStartXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} -- not used
| CEvtSndFileProgressXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
| CEvtSndFileRedirectStartXFTP {user :: User, fileTransferMeta :: FileTransferMeta, redirectMeta :: FileTransferMeta}
| CEvtSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CEvtSndStandaloneFileComplete {user :: User, fileTransferMeta :: FileTransferMeta, rcvURIs :: [Text]}
| CEvtSndFileCancelledXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta}
| CEvtSndFileError {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, errorMessage :: Text}
| CEvtSndFileWarning {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, errorMessage :: Text}
| CEvtContactConnecting {user :: User, contact :: Contact}
| CEvtContactConnected {user :: User, contact :: Contact, userCustomProfile :: Maybe Profile}
| CEvtContactSndReady {user :: User, contact :: Contact}
| CEvtContactAnotherClient {user :: User, contact :: Contact}
| CEvtSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
| CEvtContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
| CEvtContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
| CEvtContactSubError {user :: User, contact :: Contact, chatError :: ChatError}
| CEvtContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
| CEvtUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
| CEvtNetworkStatus {networkStatus :: NetworkStatus, connections :: [AgentConnId]}
| CEvtNetworkStatuses {user_ :: Maybe User, networkStatuses :: [ConnNetworkStatus]} -- there is the same command response
| CEvtHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CEvtHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CEvtReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
| CEvtUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CEvtJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember} -- there is the same command response
| CEvtJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
| CEvtMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CEvtMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
| CEvtConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
| CEvtDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember, withMessages :: Bool}
| CEvtDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, withMessages :: Bool}
| CEvtLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CEvtUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember}
| CEvtUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember}
| CEvtUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember}
| CEvtGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CEvtGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember} -- there is the same command response
| CEvtAcceptingGroupJoinRequestMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CEvtNoMemberContactCreating {user :: User, groupInfo :: GroupInfo, member :: GroupMember} -- only used in CLI
| CEvtNewMemberContactReceivedInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CEvtContactAndMemberAssociated {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember, updatedContact :: Contact}
| CEvtCallInvitation {callInvitation :: RcvCallInvitation}
| CEvtCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
| CEvtCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession}
| CEvtCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
| CEvtCallEnded {user :: User, contact :: Contact}
| CEvtNtfMessage {user :: User, connEntity :: ConnectionEntity, ntfMessage :: NtfMsgAckInfo}
| CEvtRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
| CEvtNewRemoteHost {remoteHost :: RemoteHostInfo}
| CEvtRemoteHostConnected {remoteHost :: RemoteHostInfo}
| CEvtRemoteHostStopped {remoteHostId_ :: Maybe RemoteHostId, rhsState :: RemoteHostSessionState, rhStopReason :: RemoteHostStopReason}
| CEvtRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo, ctrlAppInfo_ :: Maybe CtrlAppInfo, appVersion :: AppVersion, compatible :: Bool}
| CEvtRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
| CEvtRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason}
| CEvtContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption}
| CEvtContactDisabled {user :: User, contact :: Contact}
| CEvtConnectionDisabled {connectionEntity :: ConnectionEntity}
| CEvtConnectionInactive {connectionEntity :: ConnectionEntity, inactive :: Bool}
| CEvtAgentRcvQueuesDeleted {deletedRcvQueues :: NonEmpty DeletedRcvQueue}
| CEvtAgentConnsDeleted {agentConnIds :: NonEmpty AgentConnId}
| CEvtAgentUserDeleted {agentUserId :: Int64}
| CEvtMessageError {user :: User, severity :: Text, errorMessage :: Text}
| CEvtChatError {user_ :: Maybe User, chatError :: ChatError}
| CEvtChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
| CEvtTimedAction {action :: String, durationMilliseconds :: Int64}
| CEvtTerminalEvent TerminalEvent
deriving (Show)
data TerminalEvent
= TEGroupLinkRejected {user :: User, groupInfo :: GroupInfo, groupRejectionReason :: GroupRejectionReason}
| TERejectingGroupJoinRequestMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, groupRejectionReason :: GroupRejectionReason}
| TENewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| TEContactVerificationReset {user :: User, contact :: Contact}
| TEGroupMemberVerificationReset {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| TEGroupEmpty {user :: User, shortGroupInfo :: ShortGroupInfo}
| TEGroupSubscribed {user :: User, shortGroupInfo :: ShortGroupInfo}
| TEGroupInvitation {user :: User, shortGroupInfo :: ShortGroupInfo}
| TEMemberSubError {user :: User, shortGroupInfo :: ShortGroupInfo, memberToSubscribe :: ShortGroupMember, chatError :: ChatError}
| TEMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
| TEPendingSubSummary {user :: User, pendingSubscriptions :: [PendingSubStatus]}
| TESndFileSubError {user :: User, sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
| TERcvFileSubError {user :: User, rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
deriving (Show)
data DeletedRcvQueue = DeletedRcvQueue
@ -856,49 +870,37 @@ data DeletedRcvQueue = DeletedRcvQueue
deriving (Show)
-- some of these can only be used as command responses
allowRemoteEvent :: ChatResponse -> Bool
allowRemoteEvent :: ChatEvent -> Bool
allowRemoteEvent = \case
CRChatStarted -> False
CRChatRunning -> False
CRChatStopped -> False
CRChatSuspended -> False
CRRemoteHostList _ -> False
CRCurrentRemoteHost _ -> False
CRRemoteHostStarted {} -> False
CRRemoteHostSessionCode {} -> False
CRNewRemoteHost _ -> False
CRRemoteHostConnected _ -> False
CRRemoteHostStopped {} -> False
CRRemoteFileStored {} -> False
CRRemoteCtrlList _ -> False
CRRemoteCtrlFound {} -> False
CRRemoteCtrlConnecting {} -> False
CRRemoteCtrlSessionCode {} -> False
CRRemoteCtrlConnected _ -> False
CRRemoteCtrlStopped {} -> False
CRSQLResult _ -> False
#if !defined(dbPostgres)
CRSlowSQLQueries {} -> False
#endif
CEvtChatSuspended -> False
CEvtRemoteHostSessionCode {} -> False
CEvtNewRemoteHost _ -> False
CEvtRemoteHostConnected _ -> False
CEvtRemoteHostStopped {} -> False
CEvtRemoteCtrlFound {} -> False
CEvtRemoteCtrlSessionCode {} -> False
CEvtRemoteCtrlStopped {} -> False
_ -> True
logResponseToFile :: ChatResponse -> Bool
logResponseToFile = \case
CRContactsDisconnected {} -> True
CRContactsSubscribed {} -> True
CRContactSubError {} -> True
CRMemberSubError {} -> True
CRSndFileSubError {} -> True
CRRcvFileSubError {} -> True
CRHostConnected {} -> True
CRHostDisconnected {} -> True
CRConnectionDisabled {} -> True
CRAgentRcvQueuesDeleted {} -> True
CRAgentConnsDeleted {} -> True
CRAgentUserDeleted {} -> True
CRChatCmdError {} -> True
CRChatError {} -> True
CRMessageError {} -> True
logEventToFile :: ChatEvent -> Bool
logEventToFile = \case
CEvtContactsDisconnected {} -> True
CEvtContactsSubscribed {} -> True
CEvtContactSubError {} -> True
CEvtHostConnected {} -> True
CEvtHostDisconnected {} -> True
CEvtConnectionDisabled {} -> True
CEvtAgentRcvQueuesDeleted {} -> True
CEvtAgentConnsDeleted {} -> True
CEvtAgentUserDeleted {} -> True
-- CEvtChatCmdError {} -> True -- TODO this should be separately logged to file
CEvtChatError {} -> True
CEvtMessageError {} -> True
CEvtTerminalEvent te -> case te of
TEMemberSubError {} -> True
TESndFileSubError {} -> True
TERcvFileSubError {} -> True
_ -> False
_ -> False
-- (Maybe GroupMemberId) can later be changed to GroupSndScope = GSSAll | GSSAdmins | GSSMember GroupMemberId
@ -1406,7 +1408,7 @@ data RemoteCtrlSession
tls :: TLS,
rcsSession :: RCCtrlSession,
http2Server :: Async (),
remoteOutputQ :: TBQueue ChatResponse
remoteOutputQ :: TBQueue ChatEvent
}
data RemoteCtrlSessionState
@ -1512,15 +1514,15 @@ throwChatError :: ChatErrorType -> CM a
throwChatError = throwError . ChatError
toViewTE :: TerminalEvent -> CM ()
toViewTE = toView . CRTerminalEvent
toViewTE = toView . CEvtTerminalEvent
{-# INLINE toViewTE #-}
-- | Emit local events.
toView :: ChatResponse -> CM ()
toView :: ChatEvent -> CM ()
toView = lift . toView'
{-# INLINE toView #-}
toView' :: ChatResponse -> CM' ()
toView' :: ChatEvent -> CM' ()
toView' ev = do
cc@ChatController {outputQ = localQ, remoteCtrlSession = session, config = ChatConfig {chatHooks}} <- ask
event <- case eventHook chatHooks of
@ -1531,7 +1533,7 @@ toView' ev = do
Just (_, RCSessionConnected {remoteOutputQ})
| allowRemoteEvent event -> writeTBQueue remoteOutputQ event
-- TODO potentially, it should hold some events while connecting
_ -> writeTBQueue localQ (Nothing, Nothing, event)
_ -> writeTBQueue localQ (Nothing, event)
withStore' :: (DB.Connection -> IO a) -> CM a
withStore' action = withStore $ liftIO . action
@ -1660,6 +1662,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "TE") ''TerminalEvent)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CEvt") ''ChatEvent)
$(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
$(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig)

170
src/Simplex/Chat/Library/Commands.hs
View file

@ -225,8 +225,8 @@ 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
flip catchChatError (toView . CEvtChatError (Just user)) $
toView =<< receiveFileEvt' user ft False Nothing Nothing
restoreCalls :: CM' ()
restoreCalls = do
@ -502,7 +502,7 @@ processChatCommand' vr = \case
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)
unless (null errs) $ toView $ CEvtChatErrors (Just user) (map ChatErrorStore errs)
pure $ CRApiChats user previews
APIGetChat (ChatRef cType cId) contentFilter pagination search -> withUser $ \user -> case cType of
-- TODO optimize queries calculating ChatStats, currently they're disabled
@ -665,9 +665,9 @@ processChatCommand' vr = \case
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
CIDMInternalMark -> markDirectCIsDeleted user ct items True =<< liftIO getCurrentTime
deletions <- case mode of
CIDMInternal -> deleteDirectCIs user ct items
CIDMInternalMark -> markDirectCIsDeleted user ct items =<< liftIO getCurrentTime
CIDMBroadcast -> do
assertDeletable items
assertDirectAllowed user MDSnd ct XMsgDel_
@ -676,13 +676,14 @@ processChatCommand' vr = \case
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
then deleteDirectCIs user ct items
else markDirectCIsDeleted user ct items =<< liftIO getCurrentTime
pure $ CRChatItemsDeleted user deletions True False
CTGroup -> withGroupLock "deleteChatItem" chatId $ do
(gInfo, items) <- getCommandGroupChatItems user chatId itemIds
case mode of
CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime
CIDMInternalMark -> markGroupCIsDeleted user gInfo items True Nothing =<< liftIO getCurrentTime
deletions <- case mode of
CIDMInternal -> deleteGroupCIs user gInfo items Nothing =<< liftIO getCurrentTime
CIDMInternalMark -> markGroupCIsDeleted user gInfo items Nothing =<< liftIO getCurrentTime
CIDMBroadcast -> do
ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
assertDeletable items
@ -692,6 +693,7 @@ processChatCommand' vr = \case
-- TODO [knocking] validate: only current members or only single pending approval member
mapM_ (sendGroupMessages user gInfo ms) events
delGroupChatItems user gInfo items False
pure $ CRChatItemsDeleted user deletions True False
CTLocal -> do
(nf, items) <- getCommandLocalChatItems user chatId itemIds
deleteLocalCIs user nf items True False
@ -714,7 +716,8 @@ processChatCommand' vr = \case
APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do
(gInfo, items) <- getCommandGroupChatItems user gId itemIds
ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
delGroupChatItemsForMembers user gInfo ms items
deletions <- delGroupChatItemsForMembers user gInfo ms items
pure $ CRChatItemsDeleted user deletions True False
APIArchiveReceivedReports gId -> withUser $ \user -> withFastStore $ \db -> do
g <- getGroupInfo db vr user gId
deleteTs <- liftIO getCurrentTime
@ -723,12 +726,13 @@ processChatCommand' vr = \case
APIDeleteReceivedReports gId itemIds mode -> withUser $ \user -> withGroupLock "deleteReports" gId $ do
(gInfo, items) <- getCommandGroupChatItems user gId itemIds
unless (all isRcvReport items) $ throwChatError $ CECommandError "some items are not received reports"
case mode of
CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime
CIDMInternalMark -> markGroupCIsDeleted user gInfo items True Nothing =<< liftIO getCurrentTime
deletions <- case mode of
CIDMInternal -> deleteGroupCIs user gInfo items Nothing =<< liftIO getCurrentTime
CIDMInternalMark -> markGroupCIsDeleted user gInfo items Nothing =<< liftIO getCurrentTime
CIDMBroadcast -> do
ms <- withFastStore' $ \db -> getGroupModerators db vr user gInfo
delGroupChatItemsForMembers user gInfo ms items
pure $ CRChatItemsDeleted user deletions True False
where
isRcvReport = \case
CChatItem _ ChatItem {content = CIRcvMsgContent (MCReport {})} -> True
@ -1166,7 +1170,7 @@ processChatCommand' vr = \case
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]
toView $ CEvtNewChatItems 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
@ -1293,7 +1297,7 @@ processChatCommand' vr = \case
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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure $ CRNtfConns $ catMaybes ntfMsgs
where
getMsgConn :: DB.Connection -> NotificationInfo -> IO (Maybe NtfConn)
@ -1404,7 +1408,7 @@ processChatCommand' vr = \case
oldTTL = fromMaybe globalTTL oldTTL_
when (newTTL > 0 && (newTTL < oldTTL || oldTTL == 0)) $ do
lift $ setExpireCIFlag user False
expireChat user globalTTL `catchChatError` (toView . CRChatError (Just user))
expireChat user globalTTL `catchChatError` (toView . CEvtChatError (Just user))
lift $ setChatItemsExpiration user globalTTL ttlCount
ok user
where
@ -1474,7 +1478,7 @@ processChatCommand' vr = \case
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))
withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchChatError` (toView . CEvtChatError (Just user))
ok user
_ -> pure $ chatCmdError (Just user) "not supported"
APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do
@ -1865,10 +1869,10 @@ processChatCommand' vr = \case
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
toView $ CEvtNoMemberContactCreating user g m
processChatCommand (APICreateMemberContact gId mId) >>= \case
cr@(CRNewMemberContact _ Contact {contactId} _ _) -> do
toView cr
CRNewMemberContact _ ct@Contact {contactId} _ _ -> do
toViewTE $ TENewMemberContact user ct g m
processChatCommand $ APISendMemberContactInvitation contactId (Just mc)
cr -> pure cr
Just ctId -> do
@ -2015,7 +2019,7 @@ processChatCommand' vr = \case
updateGroupMemberStatus db userId fromMember GSMemInvited
updateGroupMemberStatus db userId membership GSMemInvited
throwError e
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CEvtChatError (Just user))
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
Nothing -> throwChatError $ CEContactNotActive ct
APIAcceptMember groupId gmId role -> withUser $ \user -> do
@ -2042,9 +2046,9 @@ processChatCommand' vr = \case
assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
(errs1, changed1) <- changeRoleInvitedMems user gInfo invitedMems
(errs2, changed2, acis) <- changeRoleCurrentMems user g currentMems
unless (null acis) $ toView $ CRNewChatItems user acis
unless (null acis) $ toView $ CEvtNewChatItems user acis
let errs = errs1 <> errs2
unless (null errs) $ toView $ CRChatErrors (Just user) errs
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole} -- same order is not guaranteed
where
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
@ -2130,9 +2134,9 @@ processChatCommand' vr = \case
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False
when (length cis_ /= length blockMems) $ logError "blockMembers: blockMems and cis_ length mismatch"
let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
unless (null acis) $ toView $ CRNewChatItems user acis
unless (null acis) $ toView $ CEvtNewChatItems user acis
(errs, blocked) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updateGroupMemberBlocked db user gInfo mrs) blockMems)
unless (null errs) $ toView $ CRChatErrors (Just user) errs
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
-- TODO not batched - requires agent batch api
forM_ blocked $ \m -> toggleNtf user m (not blockFlag)
pure CRMembersBlockedForAllUser {user, groupInfo = gInfo, members = blocked, blocked = blockFlag}
@ -2156,8 +2160,8 @@ processChatCommand' vr = \case
let (errs3, deleted3, acis3) = concatTuples rs
acis = acis2 <> acis3
errs = errs1 <> errs2 <> errs3
unless (null acis) $ toView $ CRNewChatItems user acis
unless (null errs) $ toView $ CRChatErrors (Just user) errs
unless (null acis) $ toView $ CEvtNewChatItems user acis
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
when withMessages $ deleteMessages user gInfo $ currentMems <> pendingMems
pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2 <> deleted3) withMessages -- same order is not guaranteed
where
@ -2218,7 +2222,7 @@ processChatCommand' vr = \case
-- TODO [knocking] send to pending approval members (move `memberCurrent` filter from sendGroupMessages_ to call sites)
msg <- sendGroupMessage' user gInfo members XGrpLeave
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
toView $ CEvtNewChatItems 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
@ -2324,7 +2328,7 @@ processChatCommand' vr = \case
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]
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci]
pure $ CRNewMemberContactSentInv user ct' g m
_ -> throwChatError CEGroupMemberNotActive
CreateGroupLink gName mRole short -> withUser $ \user -> do
@ -2353,7 +2357,7 @@ processChatCommand' vr = \case
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)
unless (null errs) $ toView $ CEvtChatErrors (Just user) (map ChatErrorStore errs)
pure $ CRChats previews
LastMessages (Just chatName) count search -> withUser $ \user -> do
chatRef <- getChatRef user chatName
@ -2594,19 +2598,9 @@ processChatCommand' vr = \case
-- 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
{-# INLINE procCmd #-}
ok_ = pure $ CRCmdOk Nothing
ok = pure . CRCmdOk . Just
getChatRef :: User -> ChatName -> CM ChatRef
@ -2768,7 +2762,7 @@ processChatCommand' vr = \case
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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts
lift $ createContactsSndFeatureItems user' changedCts'
pure
@ -2808,7 +2802,7 @@ processChatCommand' vr = \case
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))
void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` (toView . CEvtChatError (Just user))
lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
pure $ CRContactPrefsUpdated user ct ct'
runUpdateGroupProfile :: User -> Group -> GroupProfile -> CM ChatResponse
@ -2832,7 +2826,7 @@ processChatCommand' vr = \case
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]
toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat g') ci]
createGroupFeatureChangedItems user cd CISndGroupFeature g g'
pure $ CRGroupUpdated user g g' Nothing
checkValidName :: GroupName -> CM ()
@ -2847,7 +2841,7 @@ processChatCommand' vr = \case
when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
delGroupChatItemsForMembers :: User -> GroupInfo -> [GroupMember] -> [CChatItem 'CTGroup] -> CM ChatResponse
delGroupChatItemsForMembers :: User -> GroupInfo -> [GroupMember] -> [CChatItem 'CTGroup] -> CM [ChatItemDeletion]
delGroupChatItemsForMembers user gInfo ms items = do
assertDeletable gInfo items
assertUserGroupRole gInfo GRAdmin -- TODO GRModerator when most users migrate
@ -2876,16 +2870,16 @@ processChatCommand' vr = \case
CIGroupRcv GroupMember {memberId} -> (msgId, memberId)
CIGroupSnd -> (msgId, membershipMemId)
delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> CM ChatResponse
delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> CM [ChatItemDeletion]
delGroupChatItems user gInfo@GroupInfo {membership} items moderation = do
deletedTs <- liftIO getCurrentTime
when moderation $ do
ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci membership deletedTs)
unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds True (Just membership)
unless (null ciIds) $ toView $ CEvtGroupChatItemsDeleted user gInfo ciIds True (Just membership)
let m = if moderation then Just membership else Nothing
if groupFeatureMemberAllowed SGFFullDelete membership gInfo
then deleteGroupCIs user gInfo items True False m deletedTs
else markGroupCIsDeleted user gInfo items True m deletedTs
then deleteGroupCIs user gInfo items m deletedTs
else markGroupCIsDeleted user gInfo items m deletedTs
updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName gName update = withUser $ \user -> do
g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db ->
@ -2962,7 +2956,7 @@ processChatCommand' vr = \case
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]
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci]
forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci)
drgRandomBytes :: Int -> CM ByteString
@ -3011,7 +3005,7 @@ processChatCommand' vr = \case
deleteCIFiles user filesInfo
withAgent (\a -> deleteUser a (aUserId user) delSMPQueues)
`catchChatError` \case
e@(ChatErrorAgent NO_USER _) -> toView $ CRChatError (Just user) e
e@(ChatErrorAgent NO_USER _) -> toView $ CEvtChatError (Just user) e
e -> throwError e
withFastStore' (`deleteUserRecord` user)
when (activeUser user) $ chatWriteVar currentUser Nothing
@ -3064,7 +3058,7 @@ processChatCommand' vr = \case
connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
connectWithPlan user@User {userId} incognito ccLink plan
| connectionPlanProceed plan = do
case plan of CPError e -> toView $ CRChatError (Just user) e; _ -> pure ()
case plan of CPError e -> toView $ CEvtChatError (Just user) e; _ -> pure ()
case plan of
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
processChatCommand $ APIConnectContactViaAddress userId incognito contactId
@ -3364,7 +3358,7 @@ processChatCommand' vr = \case
case contactOrGroup of
CGContact Contact {activeConn} -> forM_ activeConn $ \conn ->
withFastStore' $ \db -> createSndFTDescrXFTP db user Nothing conn ft dummyFileDescr
CGGroup _ ms -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CRChatError (Just user))
CGGroup _ ms -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CEvtChatError (Just user))
where
-- we are not sending files to pending members, same as with inline files
saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
@ -3388,18 +3382,18 @@ processChatCommand' vr = \case
-- no errors
([], _) -> pure ()
-- at least one item is successfully created
(errs, _ci : _) -> toView $ CRChatErrors (Just user) errs
(errs, _ci : _) -> toView $ CEvtChatErrors (Just user) errs
-- single error
([err], []) -> throwError err
-- multiple errors
(errs@(err : _), []) -> do
toView $ CRChatErrors (Just user) errs
toView $ CEvtChatErrors (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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure (ct, items)
where
getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect))
@ -3408,7 +3402,7 @@ processChatCommand' vr = \case
getCommandGroupChatItems user gId itemIds = do
gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
(errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db gInfo) (L.toList itemIds))
unless (null errs) $ toView $ CRChatErrors (Just user) errs
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure (gInfo, items)
where
getGroupCI :: DB.Connection -> GroupInfo -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
@ -3417,7 +3411,7 @@ processChatCommand' vr = \case
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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure (nf, items)
where
getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal))
@ -3542,7 +3536,7 @@ startExpireCIThread user@User {userId} = do
liftIO $ threadDelay' delay
interval <- asks $ ciExpirationInterval . config
forever $ do
flip catchChatError' (toView' . CRChatError (Just user)) $ do
flip catchChatError' (toView' . CEvtChatError (Just user)) $ do
expireFlags <- asks expireCIFlags
atomically $ TM.lookup userId expireFlags >>= \b -> unless (b == Just True) retry
lift waitChatStartedAndActivated
@ -3574,7 +3568,7 @@ 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
toView' $ CEvtChatError Nothing $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) Nothing
E.throwIO e
where
process :: (ACorrId, AEntityId, AEvt) -> CM' ()
@ -3584,7 +3578,7 @@ agentSubscriber = do
SAERcvFile -> processAgentMsgRcvFile corrId entId msg
SAESndFile -> processAgentMsgSndFile corrId entId msg
where
run action = action `catchChatError'` (toView' . CRChatError Nothing)
run action = action `catchChatError'` (toView' . CEvtChatError Nothing)
type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType ()))
@ -3689,9 +3683,9 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
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)
toView . CEvtContactSubSummary user $ map (uncurry ContactSubStatus) cRs
when ce $ mapM_ (toView . uncurry (CEvtContactSubError user)) cErrors
notifyAPI = toView . CEvtNetworkStatuses (Just user) . map (uncurry ConnNetworkStatus)
statuses = M.foldrWithKey' addStatus [] cts
where
addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)]
@ -3708,44 +3702,44 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
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
contactLinkSubsToView rs = toView . CEvtUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs
groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [ShortGroup] -> Map ConnId ShortGroupMember -> Bool -> CM ()
groupSubsToView rs gs ms ce = do
mapM_ groupSub $
sortOn (\(ShortGroup ShortGroupInfo {groupName = g} _) -> g) gs
toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs
toViewTE . TEMemberSubSummary user $ map (uncurry MemberSubStatus) mRs
where
mRs = resultsFor rs ms
groupSub :: ShortGroup -> CM ()
groupSub (ShortGroup g@ShortGroupInfo {groupId = gId, membershipStatus} members) = do
when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors
toView groupEvent
when ce $ mapM_ (toViewTE . uncurry (TEMemberSubError user g)) mErrors
toViewTE groupEvent
where
mErrors :: [(ShortGroupMember, ChatError)]
mErrors =
sortOn (\(ShortGroupMember {memberName = n}, _) -> n)
. filterErrors
$ filter (\(ShortGroupMember {groupId}, _) -> groupId == gId) mRs
groupEvent :: ChatResponse
groupEvent :: TerminalEvent
groupEvent
| membershipStatus == GSMemInvited = CRGroupInvitation user g
| null members = CRGroupEmpty user g
| otherwise = CRGroupSubscribed user g
| membershipStatus == GSMemInvited = TEGroupInvitation user g
| null members = TEGroupEmpty user g
| otherwise = TEGroupSubscribed 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
forM_ err_ $ toViewTE . TESndFileSubError 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
rcvFileSubsToView rs = mapM_ (toViewTE . uncurry (TERcvFileSubError user)) . filterErrors . resultsFor rs
pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> CM ()
pendingConnSubsToView rs = toView . CRPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs
pendingConnSubsToView rs = toViewTE . TEPendingSubSummary 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) $> []
withStore_ a = withStore' (`a` user) `catchChatError` \e -> toView (CEvtChatError (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)]
@ -3767,28 +3761,28 @@ cleanupManager = do
liftIO $ threadDelay' initialDelay
stepDelay <- asks (cleanupManagerStepDelay . config)
forever $ do
flip catchChatError (toView . CRChatError Nothing) $ do
flip catchChatError (toView . CEvtChatError 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)
cleanupMessages `catchChatError` (toView . CEvtChatError Nothing)
-- TODO possibly, also cleanup async commands
cleanupProbes `catchChatError` (toView . CRChatError Nothing)
cleanupProbes `catchChatError` (toView . CEvtChatError Nothing)
liftIO $ threadDelay' $ diffToMicroseconds interval
where
runWithoutInitialDelay cleanupInterval = flip catchChatError (toView . CRChatError Nothing) $ do
runWithoutInitialDelay cleanupInterval = flip catchChatError (toView . CEvtChatError 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))
forM_ us $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CEvtChatError (Just u))
forM_ us' $ \u -> cleanupTimedItems cleanupInterval u `catchChatError` (toView . CEvtChatError (Just u))
cleanupUser cleanupInterval stepDelay user = do
cleanupTimedItems cleanupInterval user `catchChatError` (toView . CRChatError (Just user))
cleanupTimedItems cleanupInterval user `catchChatError` (toView . CEvtChatError (Just user))
liftIO $ threadDelay' stepDelay
-- TODO remove in future versions: legacy step - contacts are no longer marked as deleted
cleanupDeletedContacts user `catchChatError` (toView . CRChatError (Just user))
cleanupDeletedContacts user `catchChatError` (toView . CEvtChatError (Just user))
liftIO $ threadDelay' stepDelay
cleanupTimedItems cleanupInterval user = do
ts <- liftIO getCurrentTime
@ -3800,7 +3794,7 @@ cleanupManager = do
contacts <- withStore' $ \db -> getDeletedContacts db vr user
forM_ contacts $ \ct ->
withStore (\db -> deleteContactWithoutGroups db user ct)
`catchChatError` (toView . CRChatError (Just user))
`catchChatError` (toView . CEvtChatError (Just user))
cleanupMessages = do
ts <- liftIO getCurrentTime
let cutoffTs = addUTCTime (-(30 * nominalDay)) ts
@ -3826,7 +3820,7 @@ expireChatItems user@User {userId} globalTTL sync = do
loop :: [Int64] -> (Int64 -> CM ()) -> CM ()
loop [] _ = pure ()
loop (a : as) process = continue $ do
process a `catchChatError` (toView . CRChatError (Just user))
process a `catchChatError` (toView . CEvtChatError (Just user))
loop as process
continue :: CM () -> CM ()
continue a =

117
src/Simplex/Chat/Library/Internal.hs
View file

@ -188,7 +188,7 @@ 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))
withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CEvtChatError (Just user))
prepareGroupMsg :: DB.Connection -> User -> GroupInfo -> MsgContent -> Map MemberName MsgMention -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> ExceptT StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
prepareGroupMsg db user g@GroupInfo {membership} mc mentions quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of
@ -441,25 +441,25 @@ deleteFilesLocally files =
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
deleteDirectCIs :: User -> Contact -> [CChatItem 'CTDirect] -> CM [ChatItemDeletion]
deleteDirectCIs user ct items = 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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure deletions
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
deleteGroupCIs :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> UTCTime -> CM [ChatItemDeletion]
deleteGroupCIs user gInfo items 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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure deletions
where
deleteItem :: DB.Connection -> CChatItem 'CTGroup -> IO ChatItemDeletion
deleteItem db (CChatItem md ci) = do
@ -491,7 +491,7 @@ 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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure $ CRChatItemsDeleted user deletions byUser timed
where
deleteItem db (CChatItem md ci) = do
@ -505,25 +505,26 @@ 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
markDirectCIsDeleted :: User -> Contact -> [CChatItem 'CTDirect] -> UTCTime -> CM [ChatItemDeletion]
markDirectCIsDeleted user ct items 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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure deletions
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
markGroupCIsDeleted :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> UTCTime -> CM [ChatItemDeletion]
markGroupCIsDeleted user gInfo items 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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure deletions
-- pure $ CRChatItemsDeleted user deletions byUser False
where
markDeleted db (CChatItem md ci) = do
ci' <- markGroupChatItemDeleted db user gInfo ci byGroupMember_ deletedTs
@ -569,7 +570,7 @@ updateCallItemStatus user ct@Contact {contactId} Call {chatItemId} receivedStatu
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')
toView $ CEvtChatItemUpdated user (AChatItem SCTDirect msgDir (DirectChat ct) ci')
callStatusItemContent :: User -> Contact -> ChatItemId -> WebRTCCallStatus -> CM (Maybe ACIContent)
callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do
@ -617,11 +618,25 @@ receiveFile' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath
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
-- TODO AChatItem in Cancelled events
processError e
| rctFileCancelled e = pure $ CRRcvFileAcceptedSndCancelled user ft
| otherwise = throwError e
receiveFileEvt' :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM ChatEvent
receiveFileEvt' user ft userApprovedRelays rcvInline_ filePath_ = do
(CEvtRcvFileAccepted user <$> acceptFileReceive user ft userApprovedRelays rcvInline_ filePath_) `catchChatError` processError
where
-- TODO AChatItem in Cancelled events
processError e
| rctFileCancelled e = pure $ CEvtRcvFileAcceptedSndCancelled user ft
| otherwise = throwError e
rctFileCancelled :: ChatError -> Bool
rctFileCancelled = \case
ChatErrorAgent (SMP _ SMP.AUTH) _ -> True
ChatErrorAgent (CONN DUPLICATE) _ -> True
_ -> False
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
@ -728,7 +743,7 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation
forM_ aci_ $ \aci -> do
cleanupACIFile aci
toView $ CRChatItemUpdated user aci
toView $ CEvtChatItemUpdated user aci
throwChatError $ CEFileNotApproved fileId unknownSrvs
cleanupACIFile :: AChatItem -> CM ()
@ -782,7 +797,7 @@ startReceivingFile user fileId = do
liftIO $ updateRcvFileStatus db fileId FSConnected
liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
getChatItemByFileId db vr user fileId
toView $ CRRcvFileStart user ci
toView $ CEvtRcvFileStart user ci
getRcvFilePath :: FileTransferId -> Maybe FilePath -> String -> Bool -> CM FilePath
getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
@ -983,7 +998,7 @@ introduceToGroup vr user gInfo@GroupInfo {groupId, membership} m@GroupMember {ac
forM_ (L.nonEmpty events) $ \events' ->
sendGroupMemberMessages user conn events' groupId
else forM_ shuffledIntros $ \intro ->
processIntro intro `catchChatError` (toView . CRChatError (Just user))
processIntro intro `catchChatError` (toView . CEvtChatError (Just user))
memberIntro :: GroupMember -> ChatMsgEvent 'Json
memberIntro reMember =
let mInfo = memberInfo reMember
@ -1006,7 +1021,7 @@ introduceToGroup vr user gInfo@GroupInfo {groupId, membership} m@GroupMember {ac
(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
unless (null errors) $ toView $ CEvtChatErrors (Just user) errors
let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_
forM_ (L.nonEmpty events') $ \events'' ->
sendGroupMemberMessages user conn events'' groupId
@ -1140,12 +1155,14 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do
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
deletions <- deleteDirectCIs user ct [ci]
toView $ CEvtChatItemsDeleted user deletions True True
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"
deletions <- deleteGroupCIs user gInfo [ci] Nothing deletedTs
toView $ CEvtChatItemsDeleted user deletions True True
_ -> toView . CEvtChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType"
startUpdatedTimedItemThread :: User -> ChatRef -> ChatItem c d -> ChatItem c d -> CM ()
startUpdatedTimedItemThread user chatRef ci ci' =
@ -1169,7 +1186,7 @@ createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' =
ct' = ct {activeConn = Just conn'} :: Contact
when (contactPQEnabled ct /= contactPQEnabled ct') $ do
createInternalChatItem user (CDDirectSnd ct') ciContent Nothing
toView $ CRContactPQEnabled user ct' pqSndEnabled'
toView $ CEvtContactPQEnabled user ct' pqSndEnabled'
pure (ct', conn')
updateContactPQRcv :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection)
@ -1185,7 +1202,7 @@ updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled'
ct' = ct {activeConn = Just conn'} :: Contact
when (contactPQEnabled ct /= contactPQEnabled ct') $ do
createInternalChatItem user (CDDirectRcv ct') ciContent Nothing
toView $ CRContactPQEnabled user ct' pqRcvEnabled'
toView $ CEvtContactPQEnabled user ct' pqRcvEnabled'
pure (ct', conn')
updatePeerChatVRange :: Connection -> VersionRangeChat -> CM Connection
@ -1270,7 +1287,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentCo
liftIO $ updateSndFileStatus db ft FSComplete
liftIO $ deleteSndFileChunks db ft
updateDirectCIFileStatus db vr user fileId CIFSSndComplete
toView $ CRSndFileComplete user ci ft
toView $ CEvtSndFileComplete user ci ft
lift $ closeFileHandle fileId sndFiles
deleteAgentConnectionAsync user acId
@ -1320,7 +1337,7 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs, fileInvitati
removeFile fsFilePath `catchChatError` \_ -> pure ()
renameFile tmpFile fsFilePath
Left e -> do
toView $ CRChatError Nothing e
toView $ CEvtChatError Nothing e
removeFile tmpFile `catchChatError` \_ -> pure ()
withStore' (`removeFileCryptoArgs` fileId)
where
@ -1345,7 +1362,7 @@ isFileActive fileId files = do
cancelRcvFileTransfer :: User -> RcvFileTransfer -> CM (Maybe ConnId)
cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} =
cancel' `catchChatError` (\e -> toView (CRChatError (Just user) e) $> fileConnId)
cancel' `catchChatError` (\e -> toView (CEvtChatError (Just user) e) $> fileConnId)
where
cancel' = do
lift $ closeFileHandle fileId rcvFiles
@ -1363,13 +1380,13 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInlin
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))
`catchChatError` (toView . CEvtChatError (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))
lift (agentXFTPDeleteSndFileRemote user xsf fileId) `catchChatError` (toView . CEvtChatError (Just user))
pure []
-- TODO v6.0 remove
@ -1377,7 +1394,7 @@ 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)
else cancel' `catchChatError` (\e -> toView (CEvtChatError (Just user) e) $> fileConnId)
where
cancel' = do
withStore' $ \db -> do
@ -1498,7 +1515,7 @@ 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
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
forM_ (L.nonEmpty msgs) $ \msgs' ->
batchSendConnMessages user conn MsgFlags {notification = True} msgs'
@ -1627,7 +1644,7 @@ sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> Non
sendGroupMessages user gInfo members events = do
-- TODO [knocking] when sending to all, send profile update to pending approval members too, then filter for next step?
when shouldSendProfileUpdate $
sendProfileUpdate `catchChatError` (toView . CRChatError (Just user))
sendProfileUpdate `catchChatError` (toView . CEvtChatError (Just user))
sendGroupMessages_ user gInfo members events
where
User {profile = p, userMemberProfileUpdatedAt} = user
@ -1786,7 +1803,7 @@ memberSendAction gInfo events members m@GroupMember {memberRole, memberStatus} =
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))
messageMember msg `catchChatError` (toView . CEvtChatError (Just user))
where
messageMember :: SndMessage -> CM ()
messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case
@ -1850,7 +1867,7 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me
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"
else toView $ CEvtMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id"
throwError e
_ -> throwError e
@ -1974,7 +1991,7 @@ deleteAgentConnectionAsync user acId = deleteAgentConnectionAsync' user acId Fal
deleteAgentConnectionAsync' :: User -> ConnId -> Bool -> CM ()
deleteAgentConnectionAsync' user acId waitDelivery = do
withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchChatError` (toView . CRChatError (Just user))
withAgent (\a -> deleteConnectionAsync a waitDelivery acId) `catchChatError` (toView . CEvtChatError (Just user))
deleteAgentConnectionsAsync :: User -> [ConnId] -> CM ()
deleteAgentConnectionsAsync user acIds = deleteAgentConnectionsAsync' user acIds False
@ -1982,7 +1999,7 @@ deleteAgentConnectionsAsync user acIds = deleteAgentConnectionsAsync' user acIds
deleteAgentConnectionsAsync' :: User -> [ConnId] -> Bool -> CM ()
deleteAgentConnectionsAsync' _ [] _ = pure ()
deleteAgentConnectionsAsync' user acIds waitDelivery = do
withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchChatError` (toView . CRChatError (Just user))
withAgent (\a -> deleteConnectionsAsync a waitDelivery acIds) `catchChatError` (toView . CEvtChatError (Just user))
agentXFTPDeleteRcvFile :: RcvFileId -> FileTransferId -> CM ()
agentXFTPDeleteRcvFile aFileId fileId = do
@ -2083,8 +2100,8 @@ createContactsFeatureItems ::
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
unless (null errs) $ toView' $ CEvtChatErrors (Just user) errs
toView' $ CEvtNewChatItems user acis
where
contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, [CIContent d])
contactChangedFeatures (Contact {mergedPreferences = cups}, ct'@Contact {mergedPreferences = cups'}) = do
@ -2129,7 +2146,7 @@ createGroupFeatureItems user cd ciContent GroupInfo {fullGroupPreferences} =
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]
[Right aci] -> toView $ CEvtNewChatItems user [aci]
[Left e] -> throwError e
rs -> throwChatError $ CEInternalError $ "createInternalChatItem: expected 1 result, got " <> show (length rs)
@ -2165,7 +2182,7 @@ createLocalChatItems ::
createLocalChatItems user cd itemsData createdAt = do
withStore' $ \db -> updateChatTs db user cd createdAt
(errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) $ L.toList itemsData)
unless (null errs) $ toView $ CRChatErrors (Just user) errs
unless (null errs) $ toView $ CEvtChatErrors (Just user) errs
pure items
where
createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) -> IO (ChatItem 'CTLocal 'MDSnd)
@ -2254,5 +2271,5 @@ timeItToView s action = do
a <- action
t2 <- liftIO getCurrentTime
let diff = diffToMilliseconds $ diffUTCTime t2 t1
toView' $ CRTimedAction s diff
toView' $ CEvtTimedAction s diff
pure a

345
src/Simplex/Chat/Library/Subscriber.hs
View file

File diff suppressed because it is too large Load diff

25
src/Simplex/Chat/Mobile.hs
View file

@ -51,7 +51,7 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..), Migrati
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), BasicAuth (..), CorrId (..), ProtoServerWithAuth (..), ProtocolServer (..))
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..))
import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
import System.IO (utf8)
import System.Timeout (timeout)
@ -72,10 +72,14 @@ data DBMigrationResult
$(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "DBM") ''DBMigrationResult)
data APIResponse = APIResponse {corr :: Maybe CorrId, remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
data APIResponse = APIResponse {remoteHostId :: Maybe RemoteHostId, resp :: ChatResponse}
data APIEvent = APIEvent {remoteHostId :: Maybe RemoteHostId, resp :: ChatEvent}
$(JQ.deriveToJSON defaultJSON ''APIResponse)
$(JQ.deriveToJSON defaultJSON ''APIEvent)
foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
foreign export ccall "chat_migrate_init_key" cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> CInt -> Ptr (StablePtr ChatController) -> IO CJSONString
@ -286,21 +290,16 @@ chatSendCmd :: ChatController -> B.ByteString -> IO JSONByteString
chatSendCmd cc = chatSendRemoteCmd cc Nothing
chatSendRemoteCmd :: ChatController -> Maybe RemoteHostId -> B.ByteString -> IO JSONByteString
chatSendRemoteCmd cc rh s = J.encode . APIResponse Nothing rh <$> runReaderT (execChatCommand rh s) cc
chatSendRemoteCmd cc rh s = J.encode . APIResponse rh <$> runReaderT (execChatCommand rh s) cc
chatRecvMsg :: ChatController -> IO JSONByteString
chatRecvMsg ChatController {outputQ} = json <$> readChatResponse
where
json (corr, remoteHostId, resp) = J.encode APIResponse {corr, remoteHostId, resp}
readChatResponse = do
out@(_, _, cr) <- atomically $ readTBQueue outputQ
if filterEvent cr then pure out else readChatResponse
filterEvent = \case
CRGroupSubscribed {} -> False
CRGroupEmpty {} -> False
CRMemberSubSummary {} -> False
CRPendingSubSummary {} -> False
_ -> True
json (remoteHostId, resp) = J.encode APIEvent {remoteHostId, resp}
readChatResponse =
atomically (readTBQueue outputQ) >>= \case
(_, CEvtTerminalEvent {}) -> readChatResponse
out -> pure out
chatRecvMsgWait :: ChatController -> Int -> IO JSONByteString
chatRecvMsgWait cc time = fromMaybe "" <$> timeout time (chatRecvMsg cc)

22
src/Simplex/Chat/Remote.hs
View file

@ -192,7 +192,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
RHSessionConnecting _inv rhs' -> Right ((), RHSessionPendingConfirmation sessionCode tls rhs')
_ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
let rh_' = (\rh -> (rh :: RemoteHostInfo) {sessionState = Just RHSPendingConfirmation {sessionCode}}) <$> remoteHost_
toView CRRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
toView CEvtRemoteHostSessionCode {remoteHost_ = rh_', sessionCode}
(RCHostSession {sessionKeys}, rhHello, pairing') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars'
hostInfo@HostAppInfo {deviceName = hostDeviceName} <-
liftError (ChatErrorRemoteHost rhKey) $ parseHostAppInfo rhHello
@ -203,7 +203,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
let rhKey' = RHId remoteHostId -- rhKey may be invalid after upserting on RHNew
when (rhKey' /= rhKey) $ do
atomically $ writeTVar rhKeyVar rhKey'
toView $ CRNewRemoteHost rhi
toView $ CEvtNewRemoteHost rhi
-- set up HTTP transport and remote profile protocol
disconnected <- toIO $ onDisconnected rhKey' sseq
httpClient <- liftError' (httpError remoteHostId) $ attachRevHTTP2Client disconnected tls
@ -213,7 +213,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
RHSessionConfirmed _ RHPendingSession {rchClient} -> Right ((), RHSessionConnected {rchClient, tls, rhClient, pollAction, storePath})
_ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
toView $ CRRemoteHostConnected rhi {sessionState = Just RHSConnected {sessionCode}}
toView $ CEvtRemoteHostConnected rhi {sessionState = Just RHSConnected {sessionCode}}
upsertRemoteHost :: RCHostPairing -> Maybe RemoteHostInfo -> Maybe RCCtrlAddress -> Text -> SessionSeq -> RemoteHostSessionState -> CM RemoteHostInfo
upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ rcAddr_ hostDeviceName sseq state = do
KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
@ -235,7 +235,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
oq <- asks outputQ
forever $ do
r_ <- liftRH rhId $ remoteRecv rhClient 10000000
forM r_ $ \r -> atomically $ writeTBQueue oq (Nothing, Just rhId, r)
forM r_ $ \r -> atomically $ writeTBQueue oq (Just rhId, r)
httpError :: RemoteHostId -> HTTP2ClientError -> ChatError
httpError rhId = ChatErrorRemoteHost (RHId rhId) . RHEProtocolError . RPEHTTP2 . tshow
@ -271,7 +271,7 @@ cancelRemoteHostSession handlerInfo_ rhKey = do
forM_ deregistered $ \session -> do
liftIO $ cancelRemoteHost handlingError session `catchAny` (logError . tshow)
forM_ (snd <$> handlerInfo_) $ \rhStopReason ->
toView CRRemoteHostStopped {remoteHostId_, rhsState = rhsSessionState session, rhStopReason}
toView CEvtRemoteHostStopped {remoteHostId_, rhsState = rhsSessionState session, rhStopReason}
where
handlingError = isJust handlerInfo_
remoteHostId_ = case rhKey of
@ -417,7 +417,7 @@ findKnownRemoteCtrl = do
Just rc -> pure rc
atomically $ putTMVar foundCtrl (rc, inv)
let compatible = isJust $ compatibleAppVersion hostAppVersionRange . appVersionRange =<< ctrlAppInfo_
toView CRRemoteCtrlFound {remoteCtrl = remoteCtrlInfo rc (Just RCSSearching), ctrlAppInfo_, appVersion = currentAppVersion, compatible}
toView CEvtRemoteCtrlFound {remoteCtrl = remoteCtrlInfo rc (Just RCSSearching), ctrlAppInfo_, appVersion = currentAppVersion, compatible}
updateRemoteCtrlSession sseq $ \case
RCSessionStarting -> Right RCSessionSearching {action, foundCtrl}
_ -> Left $ ChatErrorRemoteCtrl RCEBadState
@ -482,7 +482,7 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
let remoteCtrlId_ = remoteCtrlId' <$> rc_
in Right RCSessionPendingConfirmation {remoteCtrlId_, ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation}
_ -> Left $ ChatErrorRemoteCtrl RCEBadState
toView CRRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` Just RCSPendingConfirmation {sessionCode}) <$> rc_, sessionCode}
toView CEvtRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` Just RCSPendingConfirmation {sessionCode}) <$> rc_, sessionCode}
checkAppVersion CtrlAppInfo {appVersionRange} =
case compatibleAppVersion hostAppVersionRange appVersionRange of
Just (AppCompatible v) -> pure v
@ -496,7 +496,7 @@ parseCtrlAppInfo :: JT.Value -> CM CtrlAppInfo
parseCtrlAppInfo ctrlAppInfo = do
liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo
handleRemoteCommand :: (ByteString -> CM' ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> CM' ()
handleRemoteCommand :: (ByteString -> CM' ChatResponse) -> RemoteCrypto -> TBQueue ChatEvent -> HTTP2Request -> CM' ()
handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
logDebug "handleRemoteCommand"
liftIO (tryRemoteError' parseRequest) >>= \case
@ -527,7 +527,7 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
send resp
attach sfKN send
flush
Left e -> toView' . CRChatError Nothing . ChatErrorRemoteCtrl $ RCEProtocolError e
Left e -> toView' . CEvtChatError Nothing . ChatErrorRemoteCtrl $ RCEProtocolError e
takeRCStep :: RCStepTMVar a -> CM a
takeRCStep = liftError' (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar
@ -556,7 +556,7 @@ handleSend execChatCommand command = do
-- convert errors thrown in execChatCommand into error responses to prevent aborting the protocol wrapper
RRChatResponse <$> execChatCommand (encodeUtf8 command)
handleRecv :: Int -> TBQueue ChatResponse -> IO RemoteResponse
handleRecv :: Int -> TBQueue ChatEvent -> IO RemoteResponse
handleRecv time events = do
logDebug $ "Recv: " <> tshow time
RRChatEvent <$> (timeout time . atomically $ readTBQueue events)
@ -675,7 +675,7 @@ cancelActiveRemoteCtrl handlerInfo_ = handleAny (logError . tshow) $ do
forM_ session_ $ \session -> do
liftIO $ cancelRemoteCtrl handlingError session
forM_ (snd <$> handlerInfo_) $ \rcStopReason ->
toView CRRemoteCtrlStopped {rcsState = rcsSessionState session, rcStopReason}
toView CEvtRemoteCtrlStopped {rcsState = rcsSessionState session, rcStopReason}
where
handlingError = isJust handlerInfo_

6
src/Simplex/Chat/Remote/Protocol.hs
View file

@ -65,7 +65,7 @@ data RemoteCommand
data RemoteResponse
= RRChatResponse {chatResponse :: ChatResponse}
| RRChatEvent {chatEvent :: Maybe ChatResponse} -- 'Nothing' on poll timeout
| RRChatEvent {chatEvent :: Maybe ChatEvent} -- 'Nothing' on poll timeout
| RRFileStored {filePath :: String}
| RRFile {fileSize :: Word32, fileDigest :: FileDigest} -- provides attachment , fileDigest :: FileDigest
| RRProtocolError {remoteProcotolError :: RemoteProtocolError} -- The protocol error happened on the server side
@ -115,10 +115,10 @@ remoteSend c cmd =
RRChatResponse cr -> pure cr
r -> badResponse r
remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatEvent)
remoteRecv c ms =
sendRemoteCommand' c Nothing RCRecv {wait = ms} >>= \case
RRChatEvent cr_ -> pure cr_
RRChatEvent cEvt_ -> pure cEvt_
r -> badResponse r
remoteStoreFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath

1
src/Simplex/Chat/Terminal/Input.hs
View file

@ -81,7 +81,6 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
CRGroupDeletedUser u g -> whenCurrUser cc u $ unsetActiveGroup ct g
CRSentGroupInvitation u g _ _ -> whenCurrUser cc u $ setActiveGroup ct g
CRChatCmdError _ _ -> when (isMessage cmd) $ echo s
CRChatError _ _ -> when (isMessage cmd) $ echo s
CRCmdOk _ -> case cmd of
Right APIDeleteUser {} -> setActive ct ""
_ -> pure ()

13
src/Simplex/Chat/Terminal/Main.hs
View file

@ -10,12 +10,12 @@ import Data.Maybe (fromMaybe)
import Data.Time.Clock (getCurrentTime)
import Data.Time.LocalTime (getCurrentTimeZone)
import Network.Socket
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (..), PresetServers (..), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatEvent (..), PresetServers (..), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
import Simplex.Chat.Core
import Simplex.Chat.Options
import Simplex.Chat.Options.DB
import Simplex.Chat.Terminal
import Simplex.Chat.View (serializeChatResponse, smpProxyModeStr)
import Simplex.Chat.View (ChatResponseEvent, serializeChatResponse, smpProxyModeStr)
import Simplex.Messaging.Client (NetworkConfig (..), SocksMode (..))
import System.Directory (getAppUserDataDirectory)
import System.Exit (exitFailure)
@ -43,13 +43,14 @@ simplexChatCLI' cfg opts@ChatOpts {chatCmd, chatCmdLog, chatCmdDelay, chatServer
simplexChatTerminal cfg opts t
runCommand user cc = do
when (chatCmdLog /= CCLNone) . void . forkIO . forever $ do
(_, _, r') <- atomically . readTBQueue $ outputQ cc
case r' of
CRNewChatItems {} -> printResponse r'
_ -> when (chatCmdLog == CCLAll) $ printResponse r'
(_, r) <- atomically . readTBQueue $ outputQ cc
case r of
CEvtNewChatItems {} -> printResponse r
_ -> when (chatCmdLog == CCLAll) $ printResponse r
sendChatCmdStr cc chatCmd >>= printResponse
threadDelay $ chatCmdDelay * 1000000
where
printResponse :: ChatResponseEvent r => r -> IO ()
printResponse r = do
ts <- getCurrentTime
tz <- getCurrentTimeZone

48
src/Simplex/Chat/Terminal/Output.hs
View file

@ -146,19 +146,19 @@ withTermLock ChatTerminal {termLock} action = do
runTerminalOutput :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} ChatOpts {markRead} = do
forever $ do
(_, outputRH, r) <- atomically $ readTBQueue outputQ
(outputRH, r) <- atomically $ readTBQueue outputQ
case r of
CRNewChatItems u (ci : _) -> when markRead $ markChatItemRead u ci -- At the moment of writing received items are created one at a time
CRChatItemUpdated u ci -> when markRead $ markChatItemRead u ci
CRRemoteHostConnected {remoteHost = RemoteHostInfo {remoteHostId}} -> getRemoteUser remoteHostId
CRRemoteHostStopped {remoteHostId_} -> mapM_ removeRemoteUser remoteHostId_
CEvtNewChatItems u (ci : _) -> when markRead $ markChatItemRead u ci -- At the moment of writing received items are created one at a time
CEvtChatItemUpdated u ci -> when markRead $ markChatItemRead u ci
CEvtRemoteHostConnected {remoteHost = RemoteHostInfo {remoteHostId}} -> getRemoteUser remoteHostId
CEvtRemoteHostStopped {remoteHostId_} -> mapM_ removeRemoteUser remoteHostId_
_ -> pure ()
let printResp = case logFilePath of
Just path -> if logResponseToFile r then logResponse path else printToTerminal ct
let printEvent = case logFilePath of
Just path -> if logEventToFile r then logResponse path else printToTerminal ct
_ -> printToTerminal ct
liveItems <- readTVarIO showLiveItems
responseString ct cc liveItems outputRH r >>= printResp
responseNotification ct cc r
responseString ct cc liveItems outputRH r >>= printEvent
chatEventNotification ct cc r
where
markChatItemRead u (AChatItem _ _ chat ci@ChatItem {chatDir, meta = CIMeta {itemStatus}}) =
case (chatDirNtf u chat chatDir (isUserMention ci), itemStatus) of
@ -174,10 +174,10 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
cr -> logError $ "Unexpected reply while getting remote user: " <> tshow cr
removeRemoteUser rhId = atomically $ TM.delete rhId (currentRemoteUsers ct)
responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO ()
responseNotification t@ChatTerminal {sendNotification} cc = \case
chatEventNotification :: ChatTerminal -> ChatController -> ChatEvent -> IO ()
chatEventNotification t@ChatTerminal {sendNotification} cc = \case
-- At the moment of writing received items are created one at a time
CRNewChatItems u ((AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) : _) ->
CEvtNewChatItems u ((AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) : _) ->
when (chatDirNtf u cInfo chatDir $ isUserMention ci) $ do
whenCurrUser cc u $ setActiveChat t cInfo
case (cInfo, chatDir) of
@ -186,29 +186,29 @@ responseNotification t@ChatTerminal {sendNotification} cc = \case
_ -> pure ()
where
text = msgText mc formattedText
CRChatItemUpdated u (AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent _}) ->
CEvtChatItemUpdated u (AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent _}) ->
whenCurrUser cc u $ when (chatDirNtf u cInfo chatDir $ isUserMention ci) $ setActiveChat t cInfo
CRContactConnected u ct _ -> when (contactNtf u ct False) $ do
CEvtContactConnected u ct _ -> when (contactNtf u ct False) $ do
whenCurrUser cc u $ setActiveContact t ct
sendNtf (viewContactName ct <> "> ", "connected")
CRContactSndReady u ct ->
CEvtContactSndReady u ct ->
whenCurrUser cc u $ setActiveContact t ct
CRContactAnotherClient u ct -> do
CEvtContactAnotherClient u ct -> do
whenCurrUser cc u $ unsetActiveContact t ct
when (contactNtf u ct False) $ sendNtf (viewContactName ct <> "> ", "connected to another client")
CRContactsDisconnected srv _ -> serverNtf srv "disconnected"
CRContactsSubscribed srv _ -> serverNtf srv "connected"
CRReceivedGroupInvitation u g ct _ _ ->
CEvtContactsDisconnected srv _ -> serverNtf srv "disconnected"
CEvtContactsSubscribed srv _ -> serverNtf srv "connected"
CEvtReceivedGroupInvitation u g ct _ _ ->
when (contactNtf u ct False) $
sendNtf ("#" <> viewGroupName g <> " " <> viewContactName ct <> "> ", "invited you to join the group")
CRUserJoinedGroup u g _ -> when (groupNtf u g False) $ do
CEvtUserJoinedGroup u g _ -> when (groupNtf u g False) $ do
whenCurrUser cc u $ setActiveGroup t g
sendNtf ("#" <> viewGroupName g, "you are connected to group")
CRJoinedGroupMember u g m ->
CEvtJoinedGroupMember u g m ->
when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
CRConnectedToGroupMember u g m _ ->
CEvtConnectedToGroupMember u g m _ ->
when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
CRReceivedContactRequest u UserContactRequest {localDisplayName = n} ->
CEvtReceivedContactRequest u UserContactRequest {localDisplayName = n} ->
when (userNtf u) $ sendNtf (viewName n <> ">", "wants to connect to you")
_ -> pure ()
where
@ -274,7 +274,7 @@ whenCurrUser cc u a = do
printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO ()
printRespToTerminal ct cc liveItems outputRH r = responseString ct cc liveItems outputRH r >>= printToTerminal ct
responseString :: ChatTerminal -> ChatController -> Bool -> Maybe RemoteHostId -> ChatResponse -> IO [StyledString]
responseString :: ChatResponseEvent r => ChatTerminal -> ChatController -> Bool -> Maybe RemoteHostId -> r -> IO [StyledString]
responseString ct cc liveItems outputRH r = do
cu <- getCurrentUser ct cc
ts <- getCurrentTime

460
src/Simplex/Chat/View.hs
View file

@ -7,6 +7,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
@ -86,22 +87,27 @@ data WCallCommand
$(JQ.deriveToJSON (taggedObjectJSON $ dropPrefix "WCCall") ''WCallCommand)
serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> String
serializeChatResponse :: ChatResponseEvent r => (Maybe RemoteHostId, Maybe User) -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> r -> String
serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
class ChatResponseEvent r where
responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> r -> [StyledString]
instance ChatResponseEvent ChatResponse where responseToView = chatResponseToView
instance ChatResponseEvent ChatEvent where responseToView = chatEventToView
chatResponseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveItems ts tz outputRH = \case
CRActiveUser User {profile, uiThemes} -> viewUserProfile (fromLocalProfile profile) <> viewUITheme uiThemes
CRUsersList users -> viewUsersList users
CRChatStarted -> ["chat started"]
CRChatRunning -> ["chat is running"]
CRChatStopped -> ["chat stopped"]
CRChatSuspended -> ["chat suspended"]
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
CRUserServers u uss -> ttyUser u $ concatMap viewUserServers uss <> (if testView then [] else serversUserHelp)
@ -120,52 +126,23 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
CRGroupMemberSwitchStarted {} -> ["switch started"]
CRContactSwitchAborted {} -> ["switch aborted"]
CRGroupMemberSwitchAborted {} -> ["switch aborted"]
CRContactSwitch u ct progress -> ttyUser u $ viewContactSwitch ct progress
CRGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress
CRContactRatchetSyncStarted {} -> ["connection synchronization started"]
CRGroupMemberRatchetSyncStarted {} -> ["connection synchronization started"]
CRContactRatchetSync u ct progress -> ttyUser u $ viewContactRatchetSync ct progress
CRGroupMemberRatchetSync u g m progress -> ttyUser u $ viewGroupMemberRatchetSync g m progress
CRContactVerificationReset u ct -> ttyUser u $ viewContactVerificationReset ct
CRGroupMemberVerificationReset u g m -> ttyUser u $ viewGroupMemberVerificationReset g m
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
CRNewChatItems u chatItems
| length chatItems > 20 ->
if
| all (\aci -> aChatItemDir aci == MDRcv) chatItems -> ttyUser u [sShow (length chatItems) <> " new messages"]
| all (\aci -> aChatItemDir aci == MDSnd) chatItems -> ttyUser u [sShow (length chatItems) <> " messages sent"]
| otherwise -> ttyUser u [sShow (length chatItems) <> " new messages created"]
| otherwise ->
concatMap
(\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item)
chatItems
CRNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz
CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
CRChatItemsStatusesUpdated u chatItems
| length chatItems <= 20 ->
concatMap
(\ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts)
chatItems
| testView && showReceipts ->
ttyUser u [sShow (length chatItems) <> " message statuses updated"]
| 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
deletions' -> ttyUser u [sShow (length deletions') <> " messages deleted"]
CRGroupChatItemsDeleted u g ciIds byUser member_ -> ttyUser u [ttyGroup' g <> ": " <> sShow (length ciIds) <> " messages deleted by " <> if byUser then "user" else "member" <> maybe "" (\m -> " " <> ttyMember m) member_]
CRChatItemsDeleted u deletions byUser timed -> ttyUser u $ viewChatItemsDeleted (unmuted u) deletions byUser timed ts tz testView
CRGroupChatItemsDeleted u g ciIds byUser member_ -> ttyUser u $ viewGroupChatItemsDeleted g ciIds byUser member_
CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction u chat reaction $ viewItemReaction showReactions chat reaction added ts tz
CRReactionMembers u memberReactions -> ttyUser u $ viewReactionMembers memberReactions
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
CRBroadcastSent u mc s f t -> ttyUser u $ viewSentBroadcast mc s f ts tz t
CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr
CRCmdAccepted _ -> []
CRCmdOk u_ -> ttyUser' u_ ["ok"]
CRChatHelp section -> case section of
HSMain -> chatHelpInfo
@ -187,18 +164,12 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView
CRGroupMembers u g -> ttyUser u $ viewGroupMembers g
CRGroupsList u gs -> ttyUser u $ viewGroupsList gs
CRSentGroupInvitation u g c _ ->
ttyUser u $
case contactConn c of
Just Connection {viaGroupLink}
| viaGroupLink -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
| otherwise -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
Nothing -> []
CRSentGroupInvitation u g c _ -> ttyUser u $ viewSentGroupInvitation g c
CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
CRUserProfile u p -> ttyUser u $ viewUserProfile p
CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u'
CRUserPrivacy u u' -> ttyUserPrefix hu outputRH u $ viewUserPrivacy u u'
CRVersionInfo info _ _ -> viewVersionInfo logLevel info
CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation ccLink
CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c
@ -208,29 +179,18 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
CRSentInvitation u _ customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRSentInvitationToContact u _c customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
CRContactDeletedByContact u c -> ttyUser u [ttyFullContact c <> " deleted contact with you"]
CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
CRAcceptingContactRequest u c -> ttyUser u $ viewAcceptingContactRequest c
CRAcceptingBusinessRequest u g -> ttyUser u $ viewAcceptingBusinessRequest g
CRContactAlreadyExists u c -> ttyUser u [ttyFullContact c <> ": contact already exists"]
CRContactRequestAlreadyAccepted u c -> ttyUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
CRBusinessRequestAlreadyAccepted u g -> ttyUser u [ttyFullGroup g <> ": sent you a duplicate connection request, but you are already connected, no action needed"]
CRUserContactLinkCreated u ccLink -> ttyUser u $ connReqContact_ "Your new chat address is created!" ccLink
CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
CRGroupLinkConnecting u g _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CRBusinessLinkConnecting u g _ _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CRUserDeletedMembers u g members wm -> case members of
[m] -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group" <> withMessages wm]
mems' -> ttyUser u [ttyGroup' g <> ": you removed " <> sShow (length mems') <> " members from the group" <> withMessages wm]
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
CRUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
CRUnknownMemberAnnounced u g _ um m -> ttyUser u [ttyGroup' g <> ": unknown member " <> ttyMember um <> " updated to " <> ttyMember m]
CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
CRForwardPlan u count itemIds fc -> ttyUser u $ viewForwardPlan count itemIds fc
CRRcvFileDescrReady _ _ _ _ -> []
CRRcvFileProgressXFTP {} -> []
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts
@ -241,110 +201,27 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c
CRGroupAliasUpdated u g -> ttyUser u $ viewGroupAliasUpdated g
CRConnectionAliasUpdated u c -> ttyUser u $ viewConnectionAliasUpdated c
CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
CRGroupMemberUpdated {} -> []
CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
CRRcvStandaloneFileCreated u ft -> ttyUser u $ receivingFileStandalone "started" ft
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
CRRcvStandaloneFileComplete u _ ft -> ttyUser u $ receivingFileStandalone "completed" ft
CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
CRRcvFileError u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
CRRcvFileError u Nothing e ft -> ttyUser u $ receivingFileStandalone "error" ft <> [sShow e]
CRRcvFileWarning u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "warning: " ci <> [sShow e]
CRRcvFileWarning u Nothing e ft -> ttyUser u $ receivingFileStandalone "warning: " ft <> [sShow e]
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndStandaloneFileCreated u ft -> ttyUser u $ uploadingFileStandalone "started" ft
CRSndFileStartXFTP {} -> []
CRSndFileProgressXFTP {} -> []
CRSndFileRedirectStartXFTP u ft ftRedirect -> ttyUser u $ standaloneUploadRedirect ft ftRedirect
CRSndStandaloneFileComplete u ft uris -> ttyUser u $ standaloneUploadComplete ft uris
CRSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadingFile "completed" ci
CRSndFileCancelledXFTP {} -> []
CRSndFileError u Nothing ft e -> ttyUser u $ uploadingFileStandalone "error" ft <> [plain e]
CRSndFileError u (Just ci) _ e -> ttyUser u $ uploadingFile "error" ci <> [plain e]
CRSndFileWarning u Nothing ft e -> ttyUser u $ uploadingFileStandalone "warning: " ft <> [plain e]
CRSndFileWarning u (Just ci) _ e -> ttyUser u $ uploadingFile "warning: " ci <> [plain e]
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
CRStandaloneFileInfo info_ -> maybe ["no file information in URI"] (\j -> [viewJSON j]) info_
CRContactConnecting u _ -> ttyUser u []
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
CRContactSndReady u ct -> ttyUser u [ttyFullContact ct <> ": you can send messages to contact"]
CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"]
CRSubscriptionEnd u acEntity ->
let Connection {connId} = entityConnection acEntity
in ttyUser u [sShow connId <> ": END"]
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e]
CRContactSubSummary u summary ->
ttyUser u $ [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
where
(errors, subscribed) = partition (isJust . contactError) summary
CRUserContactSubSummary u summary ->
ttyUser u $
map addressSS addresses
<> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors")
where
(addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary
addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
(groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
CRNetworkStatus status conns -> if testView then [plain $ show (length conns) <> " connections " <> netStatusStr status] else []
CRNetworkStatuses u statuses -> if testView then ttyUser' u $ viewNetworkStatuses statuses else []
CRGroupInvitation u g -> ttyUser u [groupInvitationSub g]
CRReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r
CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
CRJoinedGroupMemberConnecting u g host m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
CRConnectedToGroupMember u g m _ -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
CRMembersRoleUser u g members r' -> ttyUser u $ viewMemberRoleUserChanged g members r'
CRMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
CRMembersBlockedForAllUser u g members blocked -> ttyUser u $ viewMembersBlockedForAllUser g members blocked
CRDeletedMemberUser u g by wm -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group" <> withMessages wm] <> groupPreserved g
CRDeletedMember u g by m wm -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group" <> withMessages wm]
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
CRGroupEmpty u ShortGroupInfo {groupName = g} -> ttyUser u [ttyGroup g <> ": group is empty"]
CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the local copy of the group"]
CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
CRGroupDescription u g -> ttyUser u $ viewGroupDescription g
CRGroupLinkCreated u g ccLink mRole -> ttyUser u $ groupLink_ "Group link is created!" g ccLink mRole
CRGroupLink u g ccLink mRole -> ttyUser u $ groupLink_ "Group link:" g ccLink mRole
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
CRAcceptingGroupJoinRequestMember _ g m -> [ttyFullMember m <> ": accepting request to join group " <> ttyGroup' g <> "..."]
CRNoMemberContactCreating u g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " does not have direct connection, creating"]
CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"]
CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]
CRNewMemberContactReceivedInv u ct g m -> ttyUser u [ttyGroup' g <> " " <> ttyMember m <> " is creating direct contact " <> ttyContact' ct <> " with you"]
CRContactAndMemberAssociated u ct g m ct' -> ttyUser u $ viewContactAndMemberAssociated ct g m ct'
CRMemberSubError u ShortGroupInfo {groupName = g} ShortGroupMember {memberName = n} e -> ttyUser u [ttyGroup g <> " member " <> ttyContact n <> " error: " <> sShow e]
CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed u ShortGroupInfo {groupName = g} -> ttyUser u $ viewGroupSubscribed g
CRPendingSubSummary u _ -> ttyUser u []
CRSndFileSubError u SndFileTransfer {fileId, fileName} e ->
ttyUser u ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRRcvFileSubError u RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
ttyUser u ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRCallInvitation RcvCallInvitation {user, contact, callType, sharedKey} -> ttyUser user $ viewCallInvitation contact callType sharedKey
CRCallOffer {user = u, contact, callType, offer, sharedKey} -> ttyUser u $ viewCallOffer contact callType offer sharedKey
CRCallAnswer {user = u, contact, answer} -> ttyUser u $ viewCallAnswer contact answer
CRCallExtraInfo {user = u, contact} -> ttyUser u ["call extra info from " <> ttyContact' contact]
CRCallEnded {user = u, contact} -> ttyUser u ["call with " <> ttyContact' contact <> " ended"]
CRCallInvitations _ -> []
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> ttyUser u ["connection :" <> sShow pccConnId <> " deleted"]
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
CRNtfToken _ status mode srv -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode) <> ", server: " <> sShow srv]
CRNtfConns {ntfConns} -> map (\NtfConn {agentConnId, expectedMsg_} -> plain $ show agentConnId <> " " <> show expectedMsg_) ntfConns
CRConnNtfMessages ntfMsgs -> [sShow ntfMsgs]
CRNtfMessage {} -> []
CRCurrentRemoteHost rhi_ ->
[ maybe
"Using local profile"
@ -359,40 +236,16 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
]
where
started = " started on " <> B.unpack (strEncode address) <> ":" <> ctrlPort
CRRemoteHostSessionCode {remoteHost_, sessionCode} ->
[ maybe "new remote host connecting" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " connecting") remoteHost_,
"Compare session code with host:",
plain sessionCode
]
CRNewRemoteHost RemoteHostInfo {remoteHostId = rhId, hostDeviceName} -> ["new remote host " <> sShow rhId <> " added: " <> plain hostDeviceName]
CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
CRRemoteHostStopped {remoteHostId_} ->
[ maybe "new remote host" (mappend "remote host " . sShow) remoteHostId_ <> " stopped"
]
CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
[plain $ "file " <> filePath <> " stored on remote host " <> show rhId]
<> maybe [] ((: []) . cryptoFileArgsStr testView) cfArgs_
CRRemoteCtrlList cs -> viewRemoteCtrls cs
CRRemoteCtrlFound {remoteCtrl = RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName}, ctrlAppInfo_, appVersion, compatible} ->
[ ("remote controller " <> sShow remoteCtrlId <> " found: ")
<> maybe (deviceName <> "not compatible") (\info -> viewRemoteCtrl info appVersion compatible) ctrlAppInfo_
]
<> ["use " <> highlight ("/confirm remote ctrl " <> show remoteCtrlId) <> " to connect" | isJust ctrlAppInfo_ && compatible]
where
deviceName = if T.null ctrlDeviceName then "" else plain ctrlDeviceName <> ", "
CRRemoteCtrlConnecting {remoteCtrl_, ctrlAppInfo, appVersion} ->
[ (maybe "connecting new remote controller" (\RemoteCtrlInfo {remoteCtrlId} -> "connecting remote controller " <> sShow remoteCtrlId) remoteCtrl_ <> ": ")
<> viewRemoteCtrl ctrlAppInfo appVersion True
]
CRRemoteCtrlSessionCode {remoteCtrl_, sessionCode} ->
[ maybe "new remote controller connected" (\RemoteCtrlInfo {remoteCtrlId} -> "remote controller " <> sShow remoteCtrlId <> " connected") remoteCtrl_,
"Compare session code with controller and use:",
"/verify remote ctrl " <> plain sessionCode -- TODO maybe pass rcId
]
CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} ->
["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName]
CRRemoteCtrlStopped {rcStopReason} -> viewRemoteCtrlStopped rcStopReason
CRContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption enabled"]
CRSQLResult rows -> map plain rows
#if !defined(dbPostgres)
CRArchiveExported archiveErrs -> if null archiveErrs then ["ok"] else ["archive export errors: " <> plain (show archiveErrs)]
@ -433,41 +286,18 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
[ "agent queues info:",
plain . LB.unpack $ J.encode agentQueuesInfo
]
CRContactDisabled u c -> ttyUser u ["[" <> ttyContact' c <> "] connection is disabled, to enable: " <> highlight ("/enable " <> viewContactName c) <> ", to delete: " <> highlight ("/d " <> viewContactName c)]
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
CRConnectionInactive entity inactive -> viewConnectionEntityInactive entity inactive
CRAgentRcvQueuesDeleted delQs -> ["completed deleting rcv queues: " <> sShow (length delQs) | logLevel <= CLLInfo]
CRAgentConnsDeleted acIds -> ["completed deleting connections: " <> sShow (length acIds) | logLevel <= CLLInfo]
CRAgentUserDeleted auId -> ["completed deleting user" <> if logLevel <= CLLInfo then ", agent user id: " <> sShow auId else ""]
CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError True logLevel testView e
CRChatError u e -> ttyUser' u $ viewChatError False logLevel testView e
CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError False logLevel testView) errs
CRAppSettings as -> ["app settings: " <> viewJSON as]
CRTimedAction _ _ -> []
CRCustomChatResponse u r -> ttyUser' u $ map plain $ T.lines r
CRTerminalEvent te -> case te of
TERejectingGroupJoinRequestMember _ g m reason -> [ttyFullMember m <> ": rejecting request to join group " <> ttyGroup' g <> ", reason: " <> sShow reason]
TEGroupLinkRejected u g reason -> ttyUser u [ttyGroup' g <> ": join rejected, reason: " <> sShow reason]
where
ttyUser :: User -> [StyledString] -> [StyledString]
ttyUser user@User {showNtfs, activeUser, viewPwdHash} ss
| (showNtfs && isNothing viewPwdHash) || activeUser = ttyUserPrefix user ss
| (showNtfs && isNothing viewPwdHash) || activeUser = ttyUserPrefix hu outputRH user ss
| otherwise = []
ttyUserPrefix :: User -> [StyledString] -> [StyledString]
ttyUserPrefix _ [] = []
ttyUserPrefix User {userId, localDisplayName = u} ss
| null prefix = ss
| otherwise = prependFirst ("[" <> mconcat prefix <> "] ") ss
where
prefix = intersperse ", " $ remotePrefix <> userPrefix
remotePrefix = [maybe "local" (("remote: " <>) . highlight . show) outputRH | outputRH /= currentRH]
userPrefix = ["user: " <> highlight u | Just userId /= currentUserId]
currentUserId = (\User {userId = uId} -> uId) <$> user_
ttyUser' :: Maybe User -> [StyledString] -> [StyledString]
ttyUser' = maybe id ttyUser
ttyUserPrefix' :: Maybe User -> [StyledString] -> [StyledString]
ttyUserPrefix' = maybe id ttyUserPrefix
ttyUserPrefix' = maybe id $ ttyUserPrefix hu outputRH
testViewChats :: [AChat] -> [StyledString]
testViewChats chats = [sShow $ map toChatView chats]
where
@ -498,10 +328,6 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
testViewItem (CChatItem _ ci@ChatItem {meta = CIMeta {itemText}}) membership_ =
let deleted_ = maybe "" (\t -> " [" <> t <> "]") (chatItemDeletedText ci membership_)
in itemText <> deleted_
viewErrorsSummary :: [a] -> StyledString -> [StyledString]
viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
contactList :: [ContactRef] -> String
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
unmuted :: User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]
unmuted u chat ci@ChatItem {chatDir} = unmuted' u chat chatDir $ isUserMention ci
unmutedReaction :: User -> ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString]
@ -513,6 +339,203 @@ responseToView hu@(currentRH, user_) cfg@ChatConfig {logLevel, showReactions, sh
| otherwise = []
withMessages wm = if wm then " with all messages" else ""
ttyUserPrefix :: (Maybe RemoteHostId, Maybe User) -> Maybe RemoteHostId -> User -> [StyledString] -> [StyledString]
ttyUserPrefix _ _ _ [] = []
ttyUserPrefix (currentRH, user_) outputRH User {userId, localDisplayName = u} ss
| null prefix = ss
| otherwise = prependFirst ("[" <> mconcat prefix <> "] ") ss
where
prefix = intersperse ", " $ remotePrefix <> userPrefix
remotePrefix = [maybe "local" (("remote: " <>) . highlight . show) outputRH | outputRH /= currentRH]
userPrefix = ["user: " <> highlight u | Just userId /= currentUserId]
currentUserId = (\User {userId = uId} -> uId) <$> user_
viewErrorsSummary :: [a] -> StyledString -> [StyledString]
viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
contactList :: [ContactRef] -> String
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
chatEventToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatEvent -> [StyledString]
chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
CEvtChatSuspended -> ["chat suspended"]
CEvtContactSwitch u ct progress -> ttyUser u $ viewContactSwitch ct progress
CEvtGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress
CEvtContactRatchetSync u ct progress -> ttyUser u $ viewContactRatchetSync ct progress
CEvtGroupMemberRatchetSync u g m progress -> ttyUser u $ viewGroupMemberRatchetSync g m progress
CEvtNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz
CEvtChatItemsStatusesUpdated u chatItems
| length chatItems <= 20 ->
concatMap
(\ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts)
chatItems
| testView && showReceipts ->
ttyUser u [sShow (length chatItems) <> " message statuses updated"]
| otherwise -> []
CEvtChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewItemUpdate chat item liveItems ts tz
CEvtChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
CEvtChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction u chat reaction $ viewItemReaction showReactions chat reaction added ts tz
CEvtChatItemsDeleted u deletions byUser timed -> ttyUser u $ viewChatItemsDeleted (unmuted u) deletions byUser timed ts tz testView
CEvtGroupChatItemsDeleted u g ciIds byUser member_ -> ttyUser u $ viewGroupChatItemsDeleted g ciIds byUser member_
CEvtChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
CEvtUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
CEvtSentGroupInvitation u g c _ -> ttyUser u $ viewSentGroupInvitation g c
CEvtContactDeletedByContact u c -> ttyUser u [ttyFullContact c <> " deleted contact with you"]
CEvtAcceptingContactRequest u c -> ttyUser u $ viewAcceptingContactRequest c
CEvtAcceptingBusinessRequest u g -> ttyUser u $ viewAcceptingBusinessRequest g
CEvtContactRequestAlreadyAccepted u c -> ttyUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
CEvtBusinessRequestAlreadyAccepted u g -> ttyUser u [ttyFullGroup g <> ": sent you a duplicate connection request, but you are already connected, no action needed"]
CEvtGroupLinkConnecting u g _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CEvtBusinessLinkConnecting u g _ _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CEvtUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
CEvtUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
CEvtUnknownMemberAnnounced u g _ um m -> ttyUser u [ttyGroup' g <> ": unknown member " <> ttyMember um <> " updated to " <> ttyMember m]
CEvtRcvFileDescrReady _ _ _ _ -> []
CEvtRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
CEvtRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
CEvtRcvFileProgressXFTP {} -> []
CEvtContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
CEvtGroupMemberUpdated {} -> []
CEvtContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
CEvtReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
CEvtRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
CEvtRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
CEvtRcvStandaloneFileComplete u _ ft -> ttyUser u $ receivingFileStandalone "completed" ft
CEvtRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
CEvtRcvFileError u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
CEvtRcvFileError u Nothing e ft -> ttyUser u $ receivingFileStandalone "error" ft <> [sShow e]
CEvtRcvFileWarning u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "warning: " ci <> [sShow e]
CEvtRcvFileWarning u Nothing e ft -> ttyUser u $ receivingFileStandalone "warning: " ft <> [sShow e]
CEvtSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
CEvtSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CEvtSndFileStartXFTP {} -> []
CEvtSndFileProgressXFTP {} -> []
CEvtSndFileRedirectStartXFTP u ft ftRedirect -> ttyUser u $ standaloneUploadRedirect ft ftRedirect
CEvtSndStandaloneFileComplete u ft uris -> ttyUser u $ standaloneUploadComplete ft uris
CEvtSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadingFile "completed" ci
CEvtSndFileCancelledXFTP {} -> []
CEvtSndFileError u Nothing ft e -> ttyUser u $ uploadingFileStandalone "error" ft <> [plain e]
CEvtSndFileError u (Just ci) _ e -> ttyUser u $ uploadingFile "error" ci <> [plain e]
CEvtSndFileWarning u Nothing ft e -> ttyUser u $ uploadingFileStandalone "warning: " ft <> [plain e]
CEvtSndFileWarning u (Just ci) _ e -> ttyUser u $ uploadingFile "warning: " ci <> [plain e]
CEvtSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
CEvtContactConnecting u _ -> ttyUser u []
CEvtContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
CEvtContactSndReady u ct -> ttyUser u [ttyFullContact ct <> ": you can send messages to contact"]
CEvtContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"]
CEvtSubscriptionEnd u acEntity ->
let Connection {connId} = entityConnection acEntity
in ttyUser u [sShow connId <> ": END"]
CEvtContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CEvtContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CEvtContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e]
CEvtContactSubSummary u summary ->
ttyUser u $ [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
where
(errors, subscribed) = partition (isJust . contactError) summary
CEvtUserContactSubSummary u summary ->
ttyUser u $
map addressSS addresses
<> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors")
where
(addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary
addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
(groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
CEvtNetworkStatus status conns -> if testView then [plain $ show (length conns) <> " connections " <> netStatusStr status] else []
CEvtNetworkStatuses u statuses -> if testView then ttyUser' u $ viewNetworkStatuses statuses else []
CEvtReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r
CEvtUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
CEvtJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
CEvtHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
CEvtHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
CEvtJoinedGroupMemberConnecting u g host m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
CEvtConnectedToGroupMember u g m _ -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
CEvtMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
CEvtMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
CEvtDeletedMemberUser u g by wm -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group" <> withMessages wm] <> groupPreserved g
CEvtDeletedMember u g by m wm -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group" <> withMessages wm]
CEvtLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
CEvtGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the local copy of the group"]
CEvtGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
CEvtAcceptingGroupJoinRequestMember _ g m -> [ttyFullMember m <> ": accepting request to join group " <> ttyGroup' g <> "..."]
CEvtNoMemberContactCreating u g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " does not have direct connection, creating"]
CEvtNewMemberContactReceivedInv u ct g m -> ttyUser u [ttyGroup' g <> " " <> ttyMember m <> " is creating direct contact " <> ttyContact' ct <> " with you"]
CEvtContactAndMemberAssociated u ct g m ct' -> ttyUser u $ viewContactAndMemberAssociated ct g m ct'
CEvtCallInvitation RcvCallInvitation {user, contact, callType, sharedKey} -> ttyUser user $ viewCallInvitation contact callType sharedKey
CEvtCallOffer {user = u, contact, callType, offer, sharedKey} -> ttyUser u $ viewCallOffer contact callType offer sharedKey
CEvtCallAnswer {user = u, contact, answer} -> ttyUser u $ viewCallAnswer contact answer
CEvtCallExtraInfo {user = u, contact} -> ttyUser u ["call extra info from " <> ttyContact' contact]
CEvtCallEnded {user = u, contact} -> ttyUser u ["call with " <> ttyContact' contact <> " ended"]
CEvtNtfMessage {} -> []
CEvtRemoteHostSessionCode {remoteHost_, sessionCode} ->
[ maybe "new remote host connecting" (\RemoteHostInfo {remoteHostId = rhId} -> "remote host " <> sShow rhId <> " connecting") remoteHost_,
"Compare session code with host:",
plain sessionCode
]
CEvtNewRemoteHost RemoteHostInfo {remoteHostId = rhId, hostDeviceName} -> ["new remote host " <> sShow rhId <> " added: " <> plain hostDeviceName]
CEvtRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
CEvtRemoteHostStopped {remoteHostId_} ->
[ maybe "new remote host" (mappend "remote host " . sShow) remoteHostId_ <> " stopped"
]
CEvtRemoteCtrlFound {remoteCtrl = RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName}, ctrlAppInfo_, appVersion, compatible} ->
[ ("remote controller " <> sShow remoteCtrlId <> " found: ")
<> maybe (deviceName <> "not compatible") (\info -> viewRemoteCtrl info appVersion compatible) ctrlAppInfo_
]
<> ["use " <> highlight ("/confirm remote ctrl " <> show remoteCtrlId) <> " to connect" | isJust ctrlAppInfo_ && compatible]
where
deviceName = if T.null ctrlDeviceName then "" else plain ctrlDeviceName <> ", "
CEvtRemoteCtrlSessionCode {remoteCtrl_, sessionCode} ->
[ maybe "new remote controller connected" (\RemoteCtrlInfo {remoteCtrlId} -> "remote controller " <> sShow remoteCtrlId <> " connected") remoteCtrl_,
"Compare session code with controller and use:",
"/verify remote ctrl " <> plain sessionCode -- TODO maybe pass rcId
]
CEvtRemoteCtrlStopped {rcStopReason} -> viewRemoteCtrlStopped rcStopReason
CEvtContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption enabled"]
CEvtContactDisabled u c -> ttyUser u ["[" <> ttyContact' c <> "] connection is disabled, to enable: " <> highlight ("/enable " <> viewContactName c) <> ", to delete: " <> highlight ("/d " <> viewContactName c)]
CEvtConnectionDisabled entity -> viewConnectionEntityDisabled entity
CEvtConnectionInactive entity inactive -> viewConnectionEntityInactive entity inactive
CEvtAgentRcvQueuesDeleted delQs -> ["completed deleting rcv queues: " <> sShow (length delQs) | logLevel <= CLLInfo]
CEvtAgentConnsDeleted acIds -> ["completed deleting connections: " <> sShow (length acIds) | logLevel <= CLLInfo]
CEvtAgentUserDeleted auId -> ["completed deleting user" <> if logLevel <= CLLInfo then ", agent user id: " <> sShow auId else ""]
CEvtMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
CEvtChatError u e -> ttyUser' u $ viewChatError False logLevel testView e
CEvtChatErrors u errs -> ttyUser' u $ concatMap (viewChatError False logLevel testView) errs
CEvtTimedAction _ _ -> []
CEvtTerminalEvent te -> case te of
TERejectingGroupJoinRequestMember _ g m reason -> [ttyFullMember m <> ": rejecting request to join group " <> ttyGroup' g <> ", reason: " <> sShow reason]
TEGroupLinkRejected u g reason -> ttyUser u [ttyGroup' g <> ": join rejected, reason: " <> sShow reason]
TENewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"]
TEContactVerificationReset u ct -> ttyUser u $ viewContactVerificationReset ct
TEGroupMemberVerificationReset u g m -> ttyUser u $ viewGroupMemberVerificationReset g m
TEGroupSubscribed u ShortGroupInfo {groupName = g} -> ttyUser u $ viewGroupSubscribed g
TEGroupInvitation u g -> ttyUser u [groupInvitationSub g]
TEGroupEmpty u ShortGroupInfo {groupName = g} -> ttyUser u [ttyGroup g <> ": group is empty"]
TEMemberSubError u ShortGroupInfo {groupName = g} ShortGroupMember {memberName = n} e -> ttyUser u [ttyGroup g <> " member " <> ttyContact n <> " error: " <> sShow e]
TEMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
TEPendingSubSummary u _ -> ttyUser u []
TESndFileSubError u SndFileTransfer {fileId, fileName} e ->
ttyUser u ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
TERcvFileSubError u RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
ttyUser u ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
where
ttyUser :: User -> [StyledString] -> [StyledString]
ttyUser user@User {showNtfs, activeUser, viewPwdHash} ss
| (showNtfs && isNothing viewPwdHash) || activeUser = ttyUserPrefix hu outputRH user ss
| otherwise = []
ttyUser' :: Maybe User -> [StyledString] -> [StyledString]
ttyUser' = maybe id ttyUser
withMessages wm = if wm then " with all messages" else ""
unmuted :: User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]
unmuted u chat ci@ChatItem {chatDir} = unmuted' u chat chatDir $ isUserMention ci
unmutedReaction :: User -> ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString]
unmutedReaction u chat CIReaction {chatDir} = unmuted' u chat chatDir False
unmuted' :: User -> ChatInfo c -> CIDirection c d -> Bool -> [StyledString] -> [StyledString]
unmuted' u chat chatDir mention s
| chatDirNtf u chat chatDir mention = s
| testView = map (<> " <muted>") s
| otherwise = []
userNtf :: User -> Bool
userNtf User {showNtfs, activeUser} = showNtfs || activeUser
@ -592,6 +615,23 @@ viewChats ts tz = concatMap chatPreview . reverse
GroupChat g -> [" " <> ttyToGroup g]
_ -> []
viewChatItems ::
(User -> [StyledString] -> [StyledString]) ->
(forall c d. User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]) ->
User ->
[AChatItem] ->
UTCTime ->
TimeZone ->
[StyledString]
viewChatItems ttyUser unmuted u chatItems ts tz
| length chatItems <= 20 =
concatMap
(\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item)
chatItems
| all (\aci -> aChatItemDir aci == MDRcv) chatItems = ttyUser u [sShow (length chatItems) <> " new messages"]
| all (\aci -> aChatItemDir aci == MDSnd) chatItems = ttyUser u [sShow (length chatItems) <> " messages sent"]
| otherwise = ttyUser u [sShow (length chatItems) <> " new messages created"]
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwardedByMember, userMention}, content, quotedItem, file} doShow ts tz =
withGroupMsgForwarded . withItemDeleted <$> viewCI
@ -725,14 +765,10 @@ localTs tz ts = do
viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString]
viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts =
case itemStatus of
CISSndRcvd rcptStatus SSPPartial ->
if testView && showReceipts
then prependFirst (viewDeliveryReceiptPartial rcptStatus <> " ") $ viewChatItem chat item False ts tz
else []
CISSndRcvd rcptStatus SSPComplete ->
if testView && showReceipts
then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz
else []
CISSndRcvd rcptStatus SSPPartial | testView && showReceipts ->
prependFirst (viewDeliveryReceiptPartial rcptStatus <> " ") $ viewChatItem chat item False ts tz
CISSndRcvd rcptStatus SSPComplete | testView && showReceipts ->
prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz
_ -> []
viewDeliveryReceiptPartial :: MsgReceiptStatus -> StyledString
@ -796,6 +832,23 @@ viewItemNotChanged (AChatItem _ msgDir _ _) = case msgDir of
SMDSnd -> ["message didn't change"]
SMDRcv -> []
viewChatItemsDeleted ::
(forall c d. ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]) ->
[ChatItemDeletion] ->
Bool ->
Bool ->
UTCTime ->
TimeZone ->
Bool ->
[StyledString]
viewChatItemsDeleted unmuted deletions byUser timed ts tz testView = case deletions of
[ChatItemDeletion (AChatItem _ _ chat deletedItem) toItem] ->
unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
deletions' -> [sShow (length deletions') <> " messages deleted"]
viewGroupChatItemsDeleted :: GroupInfo -> [ChatItemId] -> Bool -> Maybe GroupMember -> [StyledString]
viewGroupChatItemsDeleted g ciIds byUser member_ = [ttyGroup' g <> ": " <> sShow (length ciIds) <> " messages deleted by " <> if byUser then "user" else "member" <> maybe "" (\m -> " " <> ttyMember m) member_]
viewItemDelete :: ChatInfo c -> ChatItem c d -> Maybe AChatItem -> Bool -> Bool -> CurrentTime -> TimeZone -> Bool -> [StyledString]
viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem byUser timed ts tz testView
| timed = [plain ("timed message deleted: " <> T.unpack (ciContentToText deletedContent)) | testView]
@ -1222,6 +1275,13 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs
| localAlias == "" = ""
| otherwise = " (alias: " <> plain localAlias <> ")"
viewSentGroupInvitation :: GroupInfo -> Contact -> [StyledString]
viewSentGroupInvitation g c = case contactConn c of
Just Connection {viaGroupLink}
| viaGroupLink -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
| otherwise -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
Nothing -> []
groupInvitation' :: GroupInfo -> StyledString
groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
highlight ("#" <> viewName ldn)