diff --git a/apps/ios/Shared/Model/AppAPITypes.swift b/apps/ios/Shared/Model/AppAPITypes.swift index d7f96284cf..37d016e93d 100644 --- a/apps/ios/Shared/Model/AppAPITypes.swift +++ b/apps/ios/Shared/Model/AppAPITypes.swift @@ -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, 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, 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.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 } diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index 4e9c8ce7b6..a6b9e719c7 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -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)") } } } diff --git a/apps/ios/Shared/Views/Migration/MigrateFromDevice.swift b/apps/ios/Shared/Views/Migration/MigrateFromDevice.swift index dfe9e37bd6..c684ad627a 100644 --- a/apps/ios/Shared/Views/Migration/MigrateFromDevice.swift +++ b/apps/ios/Shared/Views/Migration/MigrateFromDevice.swift @@ -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? 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 { diff --git a/apps/ios/Shared/Views/Migration/MigrateToDevice.swift b/apps/ios/Shared/Views/Migration/MigrateToDevice.swift index 1a740874a6..19cefa7f4d 100644 --- a/apps/ios/Shared/Views/Migration/MigrateToDevice.swift +++ b/apps/ios/Shared/Views/Migration/MigrateToDevice.swift @@ -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? 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 { diff --git a/apps/ios/SimpleX NSE/NSEAPITypes.swift b/apps/ios/SimpleX NSE/NSEAPITypes.swift index b1ab5e76c2..7569547e6a 100644 --- a/apps/ios/SimpleX NSE/NSEAPITypes.swift +++ b/apps/ios/SimpleX NSE/NSEAPITypes.swift @@ -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.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 } diff --git a/apps/ios/SimpleX NSE/NotificationService.swift b/apps/ios/SimpleX NSE/NotificationService.swift index 0bfa21781e..e8dd21f23c 100644 --- a/apps/ios/SimpleX NSE/NotificationService.swift +++ b/apps/ios/SimpleX NSE/NotificationService.swift @@ -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 } } diff --git a/apps/ios/SimpleX SE/ShareAPI.swift b/apps/ios/SimpleX SE/ShareAPI.swift index 56f1c2f5f3..0f12b002f7 100644 --- a/apps/ios/SimpleX SE/ShareAPI.swift +++ b/apps/ios/SimpleX SE/ShareAPI.swift @@ -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.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 } diff --git a/apps/ios/SimpleX SE/ShareModel.swift b/apps/ios/SimpleX SE/ShareModel.swift index a555c14472..b4d26b6d54 100644 --- a/apps/ios/SimpleX SE/ShareModel.swift +++ b/apps/ios/SimpleX SE/ShareModel.swift @@ -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 } } diff --git a/apps/ios/SimpleXChat/API.swift b/apps/ios/SimpleXChat/API.swift index b10b544a43..0baf52b26c 100644 --- a/apps/ios/SimpleXChat/API.swift +++ b/apps/ios/SimpleXChat/API.swift @@ -119,10 +119,10 @@ public func sendSimpleXCmd(_ cmd: ChatCmdProtocol, _ ctrl: // in microseconds public let MESSAGE_TIMEOUT: Int32 = 15_000_000 -public func recvSimpleXMsg(_ ctrl: chat_ctrl? = nil, messageTimeout: Int32 = MESSAGE_TIMEOUT) -> CR? { +public func recvSimpleXMsg(_ 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 } diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index 3cfe67e158..f635cfb7bb 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -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), diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 24df07a052..8c1166dccd 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -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): CR() @Serializable @SerialName("networkStatuses") class NetworkStatuses(val user_: UserRef?, val networkStatuses: List): CR() - @Serializable @SerialName("groupSubscribed") class GroupSubscribed(val user: UserRef, val group: GroupRef): CR() - @Serializable @SerialName("memberSubErrors") class MemberSubErrors(val user: UserRef, val memberSubErrors: List): 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): CR() @Serializable @SerialName("chatItemsStatusesUpdated") class ChatItemsStatusesUpdated(val user: UserRef, val chatItems: List): 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") diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index 6c3d8240e4..b6ad9eea96 100644 --- a/apps/simplex-bot-advanced/Main.hs +++ b/apps/simplex-bot-advanced/Main.hs @@ -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 diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs index 15f790e8b1..913f6a732a 100644 --- a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs +++ b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs @@ -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" diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs index fddad1cf2c..d087df0bb5 100644 --- a/apps/simplex-chat/Server.hs +++ b/apps/simplex-chat/Server.hs @@ -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 diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs index 802221f976..412f87889c 100644 --- a/apps/simplex-directory-service/src/Directory/Events.hs +++ b/apps/simplex-directory-service/src/Directory/Events.hs @@ -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 diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index fc9ac24e71..89fb9c30d8 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -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 diff --git a/cabal.project b/cabal.project index b7c8832d9d..a9a4b45f1a 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 3d10c9bf9e4d8196d39162ff8712f6b729b8c247 + tag: a632eea75b677cf2b146ad06ee875307d0321f23 source-repository-package type: git diff --git a/packages/simplex-chat-client/typescript/src/response.ts b/packages/simplex-chat-client/typescript/src/response.ts index 2e92e335df..5f91baa7db 100644 --- a/packages/simplex-chat-client/typescript/src/response.ts +++ b/packages/simplex-chat-client/typescript/src/response.ts @@ -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 diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 40aa4e7da0..842348157a 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -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"; diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs index 727d7f9ac5..5acf60556e 100644 --- a/src/Simplex/Chat/Bot.hs +++ b/src/Simplex/Chat/Bot.hs @@ -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 () diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 4d835b41bb..a3b9f34346 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -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) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index eeb54c6aef..77871ccc1b 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -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 = diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index dca3a7f678..a2c8ae74b2 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -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 diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 38d67aa150..53aee8938f 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -90,20 +90,20 @@ smallGroupsRcptsMemLimit = 20 processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM () processAgentMessage _ _ (DEL_RCVQS delQs) = - toView $ CRAgentRcvQueuesDeleted $ L.map rcvQ delQs + toView $ CEvtAgentRcvQueuesDeleted $ L.map rcvQ delQs where rcvQ (connId, server, rcvId, err_) = DeletedRcvQueue (AgentConnId connId) server (AgentQueueId rcvId) err_ processAgentMessage _ _ (DEL_CONNS connIds) = - toView $ CRAgentConnsDeleted $ L.map AgentConnId connIds + toView $ CEvtAgentConnsDeleted $ L.map AgentConnId connIds processAgentMessage _ "" (ERR e) = - toView $ CRChatError Nothing $ ChatErrorAgent e Nothing + toView $ CEvtChatError Nothing $ ChatErrorAgent e Nothing processAgentMessage corrId connId msg = do lockEntity <- critical (withStore (`getChatLockEntity` AgentConnId connId)) withEntityLock "processAgentMessage" lockEntity $ do vr <- chatVersionRange -- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case - Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user)) + Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CEvtChatError (Just user)) _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) -- CRITICAL error will be shown to the user as alert with restart button in Android/desktop apps. @@ -121,22 +121,22 @@ critical a = processAgentMessageNoConn :: AEvent 'AENone -> CM () processAgentMessageNoConn = \case - CONNECT p h -> hostEvent $ CRHostConnected p h - DISCONNECT p h -> hostEvent $ CRHostDisconnected p h - DOWN srv conns -> serverEvent srv conns NSDisconnected CRContactsDisconnected - UP srv conns -> serverEvent srv conns NSConnected CRContactsSubscribed - SUSPENDED -> toView CRChatSuspended - DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId + CONNECT p h -> hostEvent $ CEvtHostConnected p h + DISCONNECT p h -> hostEvent $ CEvtHostDisconnected p h + DOWN srv conns -> serverEvent srv conns NSDisconnected CEvtContactsDisconnected + UP srv conns -> serverEvent srv conns NSConnected CEvtContactsSubscribed + SUSPENDED -> toView CEvtChatSuspended + DEL_USER agentUserId -> toView $ CEvtAgentUserDeleted agentUserId ERRS cErrs -> errsEvent cErrs where - hostEvent :: ChatResponse -> CM () + hostEvent :: ChatEvent -> CM () hostEvent = whenM (asks $ hostEvents . config) . toView serverEvent srv conns nsStatus event = do chatModifyVar connNetworkStatuses $ \m -> foldl' (\m' cId -> M.insert cId nsStatus m') m connIds ifM (asks $ coreApi . config) (notifyAPI connIds) notifyCLI where connIds = map AgentConnId conns - notifyAPI = toView . CRNetworkStatus nsStatus + notifyAPI = toView . CEvtNetworkStatus nsStatus notifyCLI = do cs <- withStore' (`getConnectionsContacts` conns) toView $ event srv cs @@ -144,7 +144,7 @@ processAgentMessageNoConn = \case errsEvent cErrs = do vr <- chatVersionRange errs <- lift $ rights <$> withStoreBatch' (\db -> map (getChatErr vr db) cErrs) - toView $ CRChatErrors Nothing errs + toView $ CEvtChatErrors Nothing errs where getChatErr :: VersionRangeChat -> DB.Connection -> (ConnId, AgentErrorType) -> IO ChatError getChatErr vr db (connId, err) = @@ -156,7 +156,7 @@ processAgentMsgSndFile _corrId aFileId msg = do (cRef_, fileId) <- withStore (`getXFTPSndFileDBIds` AgentSndFileId aFileId) withEntityLock_ cRef_ . withFileLock "processAgentMsgSndFile" fileId $ withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case - Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user)) + Just user -> process user fileId `catchChatError` (toView . CEvtChatError (Just user)) _ -> do lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId @@ -176,7 +176,7 @@ processAgentMsgSndFile _corrId aFileId msg = do ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId status lookupChatItemByFileId db vr user fileId - toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal + toView $ CEvtSndFileProgressXFTP user ci ft sndProgress sndTotal SFDONE sndDescr rfds -> do withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr) ci <- withStore $ \db -> lookupChatItemByFileId db vr user fileId @@ -188,18 +188,18 @@ processAgentMsgSndFile _corrId aFileId msg = do [] -> sendFileError (FileErrOther "no receiver descriptions") "no receiver descriptions" vr ft rfd : _ -> case [fd | fd@(FD.ValidFileDescription FD.FileDescription {chunks = [_]}) <- rfds] of [] -> case xftpRedirectFor of - Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CRSndFileRedirectStartXFTP user ft + Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CEvtSndFileRedirectStartXFTP user ft Just _ -> sendFileError (FileErrOther "chaining redirects") "Prohibit chaining redirects" vr ft rfds' -> do -- we have 1 chunk - use it as URI whether it is redirect or not ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor - toView $ CRSndStandaloneFileComplete user ft' $ map (decodeLatin1 . strEncode . FD.fileDescriptionURI) rfds' + toView $ CEvtSndStandaloneFileComplete user ft' $ map (decodeLatin1 . strEncode . FD.fileDescriptionURI) rfds' Just (AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) -> case (msgId_, itemDeleted) of (Just sharedMsgId, Nothing) -> do when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send" -- TODO either update database status or move to SFPROG - toView $ CRSndFileProgressXFTP user ci ft 1 1 + toView $ CEvtSndFileProgressXFTP user ci ft 1 1 case (rfds, sfts, d, cInfo) of (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) @@ -208,9 +208,9 @@ processAgentMsgSndFile _corrId aFileId msg = do Just rs -> case L.last rs of Right ([msgDeliveryId], _) -> withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId - Right (deliveryIds, _) -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError $ "SFDONE, sendFileDescriptions: expected 1 delivery id, got " <> show (length deliveryIds) - Left e -> toView $ CRChatError (Just user) e - Nothing -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError "SFDONE, sendFileDescriptions: expected at least 1 result" + Right (deliveryIds, _) -> toView $ CEvtChatError (Just user) $ ChatError $ CEInternalError $ "SFDONE, sendFileDescriptions: expected 1 delivery id, got " <> show (length deliveryIds) + Left e -> toView $ CEvtChatError (Just user) e + Nothing -> toView $ CEvtChatError (Just user) $ ChatError $ CEInternalError "SFDONE, sendFileDescriptions: expected at least 1 result" lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do ms <- withStore' $ \db -> getGroupMembers db vr user g @@ -223,7 +223,7 @@ processAgentMsgSndFile _corrId aFileId msg = do liftIO $ updateCIFileStatus db user fileId CIFSSndComplete getChatItemByFileId db vr user fileId lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - toView $ CRSndFileCompleteXFTP user ci' ft + toView $ CEvtSndFileCompleteXFTP user ci' ft where memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)] memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts') @@ -244,7 +244,7 @@ processAgentMsgSndFile _corrId aFileId msg = do ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId (CIFSSndWarning $ agentFileError e) lookupChatItemByFileId db vr user fileId - toView $ CRSndFileWarning user ci ft err + toView $ CEvtSndFileWarning user ci ft err SFERR e -> sendFileError (agentFileError e) (tshow e) vr ft where @@ -259,7 +259,7 @@ processAgentMsgSndFile _corrId aFileId msg = do let (errs, msgReqs) = partitionEithers . L.toList $ L.zipWith (fmap . toMsgReq) connsIdsEvts sndMsgs_ delivered <- mapM deliverMessages (L.nonEmpty msgReqs) let errs' = errs <> maybe [] (lefts . L.toList) delivered - unless (null errs') $ toView $ CRChatErrors (Just user) errs' + unless (null errs') $ toView $ CEvtChatErrors (Just user) errs' pure delivered where connDescrEvents :: Int -> NonEmpty (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) @@ -278,7 +278,7 @@ processAgentMsgSndFile _corrId aFileId msg = do liftIO $ updateFileCancelled db user fileId (CIFSSndError ferr) lookupChatItemByFileId db vr user fileId lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) - toView $ CRSndFileError user ci ft err + toView $ CEvtSndFileError user ci ft err agentFileError :: AgentErrorType -> FileError agentFileError = \case @@ -298,7 +298,7 @@ processAgentMsgRcvFile _corrId aFileId msg = do (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId) withEntityLock_ cRef_ . withFileLock "processAgentMsgRcvFile" fileId $ withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case - Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user)) + Just user -> process user fileId `catchChatError` (toView . CEvtChatError (Just user)) _ -> do lift $ withAgent' (`xftpDeleteRcvFile` aFileId) throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId @@ -318,7 +318,7 @@ processAgentMsgRcvFile _corrId aFileId msg = do ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId status lookupChatItemByFileId db vr user fileId - toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal ft + toView $ CEvtRcvFileProgressXFTP user ci rcvProgress rcvTotal ft RFDONE xftpPath -> case liveRcvFileTransferPath ft of Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file" @@ -331,25 +331,25 @@ processAgentMsgRcvFile _corrId aFileId msg = do updateCIFileStatus db user fileId CIFSRcvComplete lookupChatItemByFileId db vr user fileId agentXFTPDeleteRcvFile aFileId fileId - toView $ maybe (CRRcvStandaloneFileComplete user fsTargetPath ft) (CRRcvFileComplete user) ci_ + toView $ maybe (CEvtRcvStandaloneFileComplete user fsTargetPath ft) (CEvtRcvFileComplete user) ci_ RFWARN e -> do ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId (CIFSRcvWarning $ agentFileError e) lookupChatItemByFileId db vr user fileId - toView $ CRRcvFileWarning user ci e ft + toView $ CEvtRcvFileWarning user ci e ft RFERR e | e == FILE NOT_APPROVED -> do aci_ <- resetRcvCIFileStatus user fileId CIFSRcvAborted forM_ aci_ cleanupACIFile agentXFTPDeleteRcvFile aFileId fileId - forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci + forM_ aci_ $ \aci -> toView $ CEvtChatItemUpdated user aci | otherwise -> do aci_ <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ agentFileError e) lookupChatItemByFileId db vr user fileId forM_ aci_ cleanupACIFile agentXFTPDeleteRcvFile aFileId fileId - toView $ CRRcvFileError user aci_ e ft + toView $ CEvtRcvFileError user aci_ e ft processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM () processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do @@ -360,9 +360,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = entity <- critical $ withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus case agentMessage of END -> case entity of - RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct - _ -> toView $ CRSubscriptionEnd user entity - MSGNTF msgId msgTs_ -> toView $ CRNtfMessage user entity $ ntfMsgAckInfo msgId msgTs_ + RcvDirectMsgConnection _ (Just ct) -> toView $ CEvtContactAnotherClient user ct + _ -> toView $ CEvtSubscriptionEnd user entity + MSGNTF msgId msgTs_ -> toView $ CEvtNtfMessage user entity $ ntfMsgAckInfo msgId msgTs_ _ -> case entity of RcvDirectMsgConnection conn contact_ -> processDirectMessage agentMessage entity conn contact_ @@ -438,13 +438,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = MWARN _ err -> processConnMWARN connEntity conn err MERR _ err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) processConnMERR connEntity conn err MERRS _ err -> do -- error cannot be AUTH error here - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -468,11 +468,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = checkIntegrityCreateItem (CDDirectRcv ct') msgMeta `catchChatError` \_ -> pure () forM_ aChatMsgs $ \case Right (ACMsg _ chatMsg) -> - processEvent ct' conn' tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e + processEvent ct' conn' tags eInfo chatMsg `catchChatError` \e -> toView $ CEvtChatError (Just user) e Left e -> do atomically $ modifyTVar' tags ("error" :) logInfo $ "contact msg=error " <> eInfo <> " " <> tshow e - toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) + toView $ CEvtChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) checkSendRcpt ct' $ rights aChatMsgs -- not crucial to use ct'' from processEvent where aChatMsgs = parseChatMessages msgBody @@ -543,7 +543,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing True allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend - toView $ CRBusinessLinkConnecting user gInfo host ct + toView $ CEvtBusinessLinkConnecting user gInfo host ct _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" INFO pqSupport connInfo -> do processINFOpqSupport conn pqSupport @@ -567,7 +567,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- [incognito] print incognito profile used for this contact incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) lift $ setContactNetworkStatus ct' NSConnected - toView $ CRContactConnected user ct' (fmap fromLocalProfile incognitoProfile) + toView $ CEvtContactConnected user ct' (fmap fromLocalProfile incognitoProfile) when (directOrUsed ct') $ do createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EInfo pqEnc) Nothing createFeatureEnabledItems ct' @@ -601,11 +601,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = cis <- updateDirectItemsStatus' db ct conn msgId (CISSndSent SSPComplete) liftIO $ forM cis $ \ci -> setDirectSndChatItemViaProxy db user ct ci (isJust proxy) let acis = map ctItem cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis where ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) SWITCH qd phase cStats -> do - toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats) + toView $ CEvtContactSwitch user ct (SwitchProgress qd phase cStats) when (phase == SPStarted || phase == SPCompleted) $ case qd of QDRcv -> createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCESwitchQueue phase Nothing) Nothing QDSnd -> createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing @@ -628,12 +628,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = . mapM (\(ci, content') -> updateDirectChatItem' db user contactId ci content' False False Nothing Nothing) . mdeUpdatedCI e case ci_ of - Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) + Just ci -> toView $ CEvtChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) _ -> do - toView $ CRContactRatchetSync user ct (RatchetSyncProgress rss cStats) + toView $ CEvtContactRatchetSync user ct (RatchetSyncProgress rss cStats) createInternalChatItem user (CDDirectRcv ct) (CIRcvDecryptionError mde n) Nothing ratchetSyncEventItem ct' = do - toView $ CRContactRatchetSync user ct' (RatchetSyncProgress rss cStats) + toView $ CEvtContactRatchetSync user ct' (RatchetSyncProgress rss cStats) createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent $ RCERatchetSync rss) Nothing OK -> -- [async agent commands] continuation on receiving OK @@ -643,7 +643,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> when (directOrUsed ct && sqSecured) $ do lift $ setContactNetworkStatus ct NSConnected - toView $ CRContactSndReady user ct + toView $ CEvtContactSndReady user ct forM_ viaUserContactLink $ \userContactLinkId -> do ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId let (UserContactLink {autoAccept}, _) = ucl @@ -655,14 +655,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processConnMWARN connEntity conn err MERR msgId err -> do updateDirectItemStatus ct conn msgId (CISSndError $ agentSndError err) - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) processConnMERR connEntity conn err MERRS msgIds err -> do -- error cannot be AUTH error here updateDirectItemsStatusMsgs ct conn (L.toList msgIds) (CISSndError $ agentSndError err) - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -671,7 +671,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just AutoAccept {autoReply = Just mc} -> do (msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci] _ -> pure () processGroupMessage :: AEvent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM () @@ -698,7 +698,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> setNewContactMemberConnRequest db user m cReq groupLinkId <- withStore' $ \db -> getGroupLinkId db user gInfo sendGrpInvitation ct m groupLinkId - toView $ CRSentGroupInvitation user gInfo ct m + toView $ CEvtSentGroupInvitation user gInfo ct m where sendGrpInvitation :: Contact -> GroupMember -> Maybe GroupLinkId -> CM () sendGrpInvitation ct GroupMember {memberId, memberRole = memRole} groupLinkId = do @@ -776,7 +776,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings case memberCategory m of GCHostMember -> do - toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = status'}} m {memberStatus = status'} + toView $ CEvtUserJoinedGroup user gInfo {membership = membership {memberStatus = status'}} m {memberStatus = status'} let cd = CDGroupRcv gInfo m createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing createGroupFeatureItems user cd CIRcvGroupFeature gInfo @@ -787,7 +787,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion GCInviteeMember -> do memberConnectedChatItem gInfo m - toView $ CRJoinedGroupMember user gInfo m {memberStatus = status'} + toView $ CEvtJoinedGroupMember user gInfo m {memberStatus = status'} let Connection {viaUserContactLink} = conn when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem when (connChatVersion < batchSend2Version) sendGroupAutoReply @@ -831,12 +831,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure () forM_ aChatMsgs $ \case Right (ACMsg _ chatMsg) -> - processEvent tags eInfo chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e + processEvent tags eInfo chatMsg `catchChatError` \e -> toView $ CEvtChatError (Just user) e Left e -> do atomically $ modifyTVar' tags ("error" :) logInfo $ "group msg=error " <> eInfo <> " " <> tshow e - toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) - forwardMsgs (rights aChatMsgs) `catchChatError` (toView . CRChatError (Just user)) + toView $ CEvtChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e) + forwardMsgs (rights aChatMsgs) `catchChatError` (toView . CEvtChatError (Just user)) checkSendRcpt $ rights aChatMsgs where aChatMsgs = parseChatMessages msgBody @@ -918,7 +918,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy) when continued $ sendPendingGroupMessages user m conn SWITCH qd phase cStats -> do - toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) + toView $ CEvtGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) when (phase == SPStarted || phase == SPCompleted) $ case qd of QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing @@ -930,7 +930,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> setConnectionVerified db user connId Nothing let m' = m {activeConn = Just (conn {connectionCode = Nothing} :: Connection)} :: GroupMember ratchetSyncEventItem m' - toView $ CRGroupMemberVerificationReset user gInfo m' + toViewTE $ TEGroupMemberVerificationReset user gInfo m' createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent RCEVerificationCodeReset) Nothing _ -> ratchetSyncEventItem m where @@ -942,12 +942,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = . mapM (\(ci, content') -> updateGroupChatItem db user groupId ci content' False False Nothing) . mdeUpdatedCI e case ci_ of - Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) + Just ci -> toView $ CEvtChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) _ -> do - toView $ CRGroupMemberRatchetSync user gInfo m (RatchetSyncProgress rss cStats) + toView $ CEvtGroupMemberRatchetSync user gInfo m (RatchetSyncProgress rss cStats) createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvDecryptionError mde n) Nothing ratchetSyncEventItem m' = do - toView $ CRGroupMemberRatchetSync user gInfo m' (RatchetSyncProgress rss cStats) + toView $ CEvtGroupMemberRatchetSync user gInfo m' (RatchetSyncProgress rss cStats) createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent $ RCERatchetSync rss) Nothing OK -> -- [async agent commands] continuation on receiving OK @@ -965,16 +965,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = MERR msgId err -> do withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSError $ agentSndError err) -- group errors are silenced to reduce load on UI event log - -- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + -- toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) processConnMERR connEntity conn err MERRS msgIds err -> do let newStatus = GSSError $ agentSndError err -- error cannot be AUTH error here withStore' $ \db -> forM_ msgIds $ \msgId -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) newStatus `catchAll_` pure () - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1000,7 +1000,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = msg <- sendGroupMessage' user gInfo [m] (XMsgNew $ MCSimple (extMsgContent mc Nothing)) ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc) withStore' $ \db -> createGroupSndStatus db (chatItemId' ci) (groupMemberId' m) GSSNew - toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] + toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci] agentMsgDecryptError :: AgentCryptoError -> (MsgDecryptError, Word32) agentMsgDecryptError = \case @@ -1045,7 +1045,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ci <- withStore $ \db -> do liftIO $ updateSndFileStatus db ft FSConnected updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 - toView $ CRSndFileStart user ci ft + toView $ CEvtSndFileStart user ci ft sendFileChunk user ft SENT msgId _proxy -> do withStore' $ \db -> updateSndFileChunkSent db ft msgId @@ -1059,7 +1059,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just (ChatRef CTDirect _) -> liftIO $ updateFileCancelled db user fileId CIFSSndCancelled _ -> pure () lookupChatItemByFileId db vr user fileId - toView $ CRSndFileRcvCancelled user ci ft + toView $ CEvtSndFileRcvCancelled user ci ft _ -> throwChatError $ CEFileSend fileId err MSG meta _ _ -> withAckMessage' "file msg" agentConnId meta $ pure () @@ -1070,7 +1070,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- [async agent commands] continuation on receiving JOINED when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1119,10 +1119,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- [async agent commands] continuation on receiving JOINED when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () MERR _ err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) processConnMERR connEntity conn err ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1133,7 +1133,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) ci <- withStore $ \db -> getChatItemByFileId db vr user fileId - toView $ CRRcvFileSndCancelled user ci ft + toView $ CEvtRcvFileSndCancelled user ci ft FileChunk {chunkNo, chunkBytes = chunk} -> do case integrity of MsgOk -> pure () @@ -1156,7 +1156,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateCIFileStatus db user fileId CIFSRcvComplete deleteRcvFileChunks db ft getChatItemByFileId db vr user fileId - toView $ CRRcvFileComplete user ci + toView $ CEvtRcvFileComplete user ci forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn) RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure () RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo @@ -1171,10 +1171,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- TODO show/log error, other events in contact request _ -> pure () MERR _ err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) processConnMERR connEntity conn err ERR err -> do - toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity) + toView $ CEvtChatError (Just user) (ChatErrorAgent err $ Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1182,8 +1182,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> CM () profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ reqPQSup = do withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case - CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact - CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo + CORContact contact -> toView $ CEvtContactRequestAlreadyAccepted user contact + CORGroup gInfo -> toView $ CEvtBusinessRequestAlreadyAccepted user gInfo CORRequest cReq -> do ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId let (UserContactLink {connLinkContact = CCLink connReq _, autoAccept}, gLinkInfo_) = ucl @@ -1195,16 +1195,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = if isSimplexTeam && v < businessChatsVersion then do ct <- acceptContactRequestAsync user cReq Nothing reqPQSup - toView $ CRAcceptingContactRequest user ct + toView $ CEvtAcceptingContactRequest user ct else do gInfo <- acceptBusinessJoinRequestAsync user cReq - toView $ CRAcceptingBusinessRequest user gInfo + toView $ CEvtAcceptingBusinessRequest user gInfo | otherwise -> case gLinkInfo_ of Nothing -> do -- [incognito] generate profile to send, create connection with incognito profile incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing ct <- acceptContactRequestAsync user cReq incognitoProfile reqPQSup - toView $ CRAcceptingContactRequest user ct + toView $ CEvtAcceptingContactRequest user ct Just gli@GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do gInfo <- withStore $ \db -> getGroupInfo db vr user groupId acceptMember_ <- asks $ acceptMember . chatHooks . config @@ -1216,14 +1216,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo mem <- acceptGroupJoinRequestAsync user gInfo cReq acceptance useRole profileMode createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing - toView $ CRAcceptingGroupJoinRequestMember user gInfo mem + toView $ CEvtAcceptingGroupJoinRequestMember user gInfo mem Left rjctReason | v < groupJoinRejectVersion -> messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked" | otherwise -> do mem <- acceptGroupJoinSendRejectAsync user gInfo cReq rjctReason toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason - _ -> toView $ CRReceivedContactRequest user cReq + _ -> toView $ CEvtReceivedContactRequest user cReq -- TODO [knocking] review memberCanSend :: GroupMember -> CM () -> CM () @@ -1238,12 +1238,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = authErrCounter' <- withStore' $ \db -> incAuthErrCounter db user conn when (authErrCounter' >= authErrDisableCount) $ case connEntity of RcvDirectMsgConnection ctConn (Just ct) -> do - toView $ CRContactDisabled user ct {activeConn = Just ctConn {authErrCounter = authErrCounter'}} - _ -> toView $ CRConnectionDisabled connEntity + toView $ CEvtContactDisabled user ct {activeConn = Just ctConn {authErrCounter = authErrCounter'}} + _ -> toView $ CEvtConnectionDisabled connEntity SMP _ SMP.QUOTA -> unless (connInactive conn) $ do withStore' $ \db -> setQuotaErrCounter db user conn quotaErrSetOnMERR - toView $ CRConnectionInactive connEntity True + toView $ CEvtConnectionInactive connEntity True _ -> pure () processConnMWARN :: ConnectionEntity -> Connection -> AgentErrorType -> CM () @@ -1253,8 +1253,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = unless (connInactive conn) $ do quotaErrCounter' <- withStore' $ \db -> incQuotaErrCounter db user conn when (quotaErrCounter' >= quotaErrInactiveCount) $ - toView $ - CRConnectionInactive connEntity True + toView $ CEvtConnectionInactive connEntity True _ -> pure () continueSending :: ConnectionEntity -> Connection -> CM Bool @@ -1262,7 +1261,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = if connInactive conn then do withStore' $ \db -> setQuotaErrCounter db user conn 0 - toView $ CRConnectionInactive connEntity False + toView $ CEvtConnectionInactive connEntity False pure True else pure False @@ -1366,7 +1365,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = notifyMemberConnected gInfo m ct_ = do memberConnectedChatItem gInfo m lift $ mapM_ (`setContactNetworkStatus` NSConnected) ct_ - toView $ CRConnectedToGroupMember user gInfo m ct_ + toView $ CEvtConnectedToGroupMember user gInfo m ct_ probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> CM () probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do @@ -1423,10 +1422,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> createSentProbeHash db userId probeId cgm messageWarning :: Text -> CM () - messageWarning = toView . CRMessageError user "warning" + messageWarning = toView . CEvtMessageError user "warning" messageError :: Text -> CM () - messageError = toView . CRMessageError user "error" + messageError = toView . CEvtMessageError user "error" newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM () newContentMessage ct mc msg@RcvMessage {sharedMsgId_} msgMeta = do @@ -1452,13 +1451,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = newChatItem content ciFile_ timed_ live = do ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content ciFile_ timed_ live M.empty reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}] + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}] autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> CM () autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do -- ! autoAcceptFileSize is only used in tests ChatConfig {autoAcceptFileSize = sz} <- asks config - when (sz > fileSize) $ receiveFile' user ft False Nothing Nothing >>= toView + when (sz > fileSize) $ receiveFileEvt' user ft False Nothing Nothing >>= toView messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> CM () messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr = do @@ -1482,7 +1481,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = pure (rfd, ft') when fileDescrComplete $ do ci <- withStore $ \db -> getAChatItemBySharedMsgId db user cd sharedMsgId - toView $ CRRcvFileDescrReady user ci ft' rfd + toView $ CEvtRcvFileDescrReady user ci ft' rfd case (fileStatus, xftpRcvFile) of (RFSAccepted _, Just XFTPRcvFile {userApprovedRelays}) -> receiveViaCompleteFD user fileId rfd userApprovedRelays cryptoArgs _ -> pure () @@ -1521,7 +1520,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ci' <- withStore' $ \db -> do createChatItemVersion db (chatItemId' ci) brokerTs mc updateDirectChatItem' db user contactId ci content True live Nothing Nothing - toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') + toView $ CEvtChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') where brokerTs = metaBrokerTs msgMeta content = CIRcvMsgContent mc @@ -1540,24 +1539,25 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = reactions <- getDirectCIReactions db ct sharedMsgId let edited = itemLive /= Just True updateDirectChatItem' db user contactId ci {reactions} content edited live Nothing $ Just msgId - toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') + toView $ CEvtChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' - else toView $ CRChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) + else toView $ CEvtChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) _ -> messageError "x.msg.update: contact attempted invalid message update" messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> CM () messageDelete ct@Contact {contactId} sharedMsgId _rcvMessage msgMeta = do - deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct) + deleteRcvChatItem `catchCINotFound` (toView . CEvtChatItemDeletedNotFound user ct) where brokerTs = metaBrokerTs msgMeta deleteRcvChatItem = do cci@(CChatItem msgDir ci) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId case msgDir of SMDRcv - | rcvItemDeletable ci brokerTs -> - if featureAllowed SCFFullDelete forContact ct - then deleteDirectCIs user ct [cci] False False >>= toView - else markDirectCIsDeleted user ct [cci] False brokerTs >>= toView + | rcvItemDeletable ci brokerTs -> do + deletions <- if featureAllowed SCFFullDelete forContact ct + then deleteDirectCIs user ct [cci] + else markDirectCIsDeleted user ct [cci] brokerTs + toView $ CEvtChatItemsDeleted user deletions False False | otherwise -> messageError "x.msg.del: contact attempted invalid message delete" SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete" @@ -1575,7 +1575,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs where updateChatItemReaction = do - cr_ <- withStore $ \db -> do + cEvt_ <- withStore $ \db -> do CChatItem md ci <- getDirectChatItemBySharedMsgId db user (contactId' ct) sharedMsgId if ciReactionAllowed ci then liftIO $ do @@ -1583,9 +1583,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = reactions <- getDirectCIReactions db ct sharedMsgId let ci' = CChatItem md ci {reactions} r = ACIReaction SCTDirect SMDRcv (DirectChat ct) $ CIReaction CIDirectRcv ci' brokerTs reaction - pure $ Just $ CRChatItemReaction user add r + pure $ Just $ CEvtChatItemReaction user add r else pure Nothing - mapM_ toView cr_ + mapM_ toView cEvt_ groupMsgReaction :: GroupInfo -> GroupMember -> SharedMsgId -> MemberId -> MsgReaction -> Bool -> RcvMessage -> UTCTime -> CM () groupMsgReaction g m sharedMsgId itemMemberId reaction add RcvMessage {msgId} brokerTs = do @@ -1596,7 +1596,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs where updateChatItemReaction = do - cr_ <- withStore $ \db -> do + cEvt_ <- withStore $ \db -> do CChatItem md ci <- getGroupMemberCIBySharedMsgId db user g itemMemberId sharedMsgId if ciReactionAllowed ci then liftIO $ do @@ -1604,9 +1604,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = reactions <- getGroupCIReactions db g itemMemberId sharedMsgId let ci' = CChatItem md ci {reactions} r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m) ci' brokerTs reaction - pure $ Just $ CRChatItemReaction user add r + pure $ Just $ CEvtChatItemReaction user add r else pure Nothing - mapM_ toView cr_ + mapM_ toView cEvt_ reactionAllowed :: Bool -> MsgReaction -> [MsgReaction] -> Bool reactionAllowed add reaction rs = (reaction `elem` rs) /= add && not (add && length rs >= maxMsgReactions) @@ -1656,7 +1656,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | otherwise = do file_ <- processFileInv ci <- createNonLive file_ - toView =<< markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] False (Just moderator) moderatedAt + deletions <- markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] (Just moderator) moderatedAt + toView $ CEvtChatItemsDeleted user deletions False False createNonLive file_ = saveRcvCI (CIRcvMsgContent content, ts) (snd <$> file_) timed' False mentions createContentItem = do @@ -1688,7 +1689,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createChatItemVersion db (chatItemId' ci) brokerTs mc ci' <- updateGroupChatItem db user groupId ci content True live Nothing blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci' - toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') + toView $ CEvtChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') where content = CIRcvMsgContent mc ts@(_, ft_) = msgContentTexts mc @@ -1710,9 +1711,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ciMentions <- getRcvCIMentions db user gInfo ft_ mentions ci' <- updateGroupChatItem db user groupId ci {reactions} content edited live $ Just msgId updateGroupCIMentions db gInfo ci' ciMentions - toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') + toView $ CEvtChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' - else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) + else toView $ CEvtChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) else messageError "x.msg.update: group member attempted to update a message of another member" _ -> messageError "x.msg.update: group member attempted invalid message update" @@ -1730,13 +1731,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- regular deletion Nothing | sameMemberId memberId mem && msgMemberId == memberId && rcvItemDeletable ci brokerTs -> - delete cci Nothing >>= toView + delete cci Nothing | otherwise -> messageError "x.msg.del: member attempted invalid message delete" -- moderation (not limited by time) Just _ | sameMemberId memberId mem && msgMemberId == memberId -> - delete cci (Just m) >>= toView + delete cci (Just m) | otherwise -> moderate mem cci CIGroupSnd -> moderate membership cci @@ -1749,7 +1750,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = moderate mem cci = case sndMemberId_ of Just sndMemberId | sameMemberId sndMemberId mem -> checkRole mem $ do - delete cci (Just m) >>= toView + delete cci (Just m) archiveMessageReports cci m | otherwise -> messageError "x.msg.del: message of another member with incorrect memberId" _ -> messageError "x.msg.del: message of another member without memberId" @@ -1757,14 +1758,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | senderRole < GRModerator || senderRole < memberRole = messageError "x.msg.del: message of another member with insufficient member permissions" | otherwise = a - delete :: CChatItem 'CTGroup -> Maybe GroupMember -> CM ChatResponse - delete cci byGroupMember - | groupFeatureMemberAllowed SGFFullDelete m gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs - | otherwise = markGroupCIsDeleted user gInfo [cci] False byGroupMember brokerTs + delete :: CChatItem 'CTGroup -> Maybe GroupMember -> CM () + delete cci byGroupMember = do + deletions <- if groupFeatureMemberAllowed SGFFullDelete m gInfo + then deleteGroupCIs user gInfo [cci] byGroupMember brokerTs + else markGroupCIsDeleted user gInfo [cci] byGroupMember brokerTs + toView $ CEvtChatItemsDeleted user deletions False False archiveMessageReports :: CChatItem 'CTGroup -> GroupMember -> CM () archiveMessageReports (CChatItem _ ci) byMember = do ciIds <- withStore' $ \db -> markMessageReportsDeleted db user gInfo ci byMember brokerTs - unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just byMember) + unless (null ciIds) $ toView $ CEvtGroupChatItemsDeleted user gInfo ciIds False (Just byMember) -- TODO remove once XFile is discontinued processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> CM () @@ -1777,7 +1780,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} content = ciContentNoParse $ CIRcvMsgContent $ MCFile "" ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] where brokerTs = metaBrokerTs msgMeta @@ -1815,7 +1818,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) ci <- withStore $ \db -> getChatItemByFileId db vr user fileId - toView $ CRRcvFileSndCancelled user ci ft + toView $ CEvtRcvFileSndCancelled user ci ft xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM () xFileAcptInv ct sharedMsgId fileConnReq_ fName = do @@ -1837,7 +1840,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = event <- withStore $ \db -> do ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 sft <- createSndDirectInlineFT db ct ft - pure $ CRSndFileStart user ci' sft + pure $ CEvtSndFileStart user ci' sft toView event ifM (allowSendInline fileSize fileInline) @@ -1867,8 +1870,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case file of Just CIFile {fileProtocol = FPXFTP} -> do ft <- withStore $ \db -> getFileTransferMeta db user fileId - toView $ CRSndFileCompleteXFTP user ci ft - _ -> toView $ CRSndFileComplete user ci sft + toView $ CEvtSndFileCompleteXFTP user ci ft + _ -> toView $ CEvtSndFileComplete user ci sft allowSendInline :: Integer -> Maybe InlineFileMode -> CM Bool allowSendInline fileSize = \case @@ -1909,7 +1912,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) ci <- withStore $ \db -> getChatItemByFileId db vr user fileId - toView $ CRRcvFileSndCancelled user ci ft + toView $ CEvtRcvFileSndCancelled user ci ft else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" @@ -1934,7 +1937,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = event <- withStore $ \db -> do ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 sft <- liftIO $ createSndGroupInlineFT db m conn ft - pure $ CRSndFileStart user ci' sft + pure $ CEvtSndFileStart user ci' sft toView event ifM (allowSendInline fileSize fileInline) @@ -1945,7 +1948,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = groupMsgToView :: forall d. MsgDirectionI d => GroupInfo -> ChatItem 'CTGroup d -> CM () groupMsgToView gInfo ci = - toView $ CRNewChatItems user [AChatItem SCTGroup (msgDirection @d) (GroupChat gInfo) ci] + toView $ CEvtNewChatItems user [AChatItem SCTGroup (msgDirection @d) (GroupChat gInfo) ci] processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> CM () processGroupInvitation ct inv msg msgMeta = do @@ -1967,13 +1970,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode updateGroupMemberStatusById db userId hostId GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted - toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) + toView $ CEvtUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) else do let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole ci <- saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs content withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] - toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + toView $ CEvtReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} where brokerTs = metaBrokerTs msgMeta sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool @@ -1999,8 +2002,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted} let ct'' = ct' {activeConn = activeConn'} :: Contact ci <- saveRcvChatItemNoParse user (CDDirectRcv ct'') msg brokerTs (CIRcvDirectEvent RDEContactDeleted) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct'') ci] - toView $ CRContactDeletedByContact user ct'' + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct'') ci] + toView $ CEvtContactDeletedByContact user ct'' else do contactConns <- withStore' $ \db -> getContactConnections db vr userId c deleteAgentConnectionsAsync user $ map aConnId contactConns @@ -2020,7 +2023,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = when (directOrUsed c' && createItems) $ do createProfileUpdatedItem c' lift $ createRcvFeatureItems user c c' - toView $ CRContactUpdated user c c' + toView $ CEvtContactUpdated user c c' pure c' | otherwise = pure c @@ -2070,7 +2073,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateGroupMemberStatus db userId m GSMemConnected updateGroupMemberAccepted db user membership role let m' = m {memberStatus = GSMemConnected} - toView $ CRUserJoinedGroup user gInfo {membership = membership'} m' + toView $ CEvtUserJoinedGroup user gInfo {membership = membership'} m' let connectedIncognito = memberIncognito membership probeMatchingMemberContact m' connectedIncognito @@ -2082,7 +2085,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Nothing -> do m' <- withStore $ \db -> updateMemberProfile db user m p' createProfileUpdatedItem m' - toView $ CRGroupMemberUpdated user gInfo m m' + toView $ CEvtGroupMemberUpdated user gInfo m m' pure m' Just mContactId -> do mCt <- withStore $ \db -> getContact db vr user mContactId @@ -2090,8 +2093,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = then do (m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p' createProfileUpdatedItem m' - toView $ CRGroupMemberUpdated user gInfo m m' - toView $ CRContactUpdated user mCt ct' + toView $ CEvtGroupMemberUpdated user gInfo m m' + toView $ CEvtContactUpdated user mCt ct' pure m' else pure m where @@ -2106,7 +2109,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateBusinessChatProfile g@GroupInfo {businessChat} = case businessChat of Just bc | isMainBusinessMember bc m -> do g' <- withStore $ \db -> updateGroupProfileFromMember db user g p' - toView $ CRGroupUpdated user g g' (Just m) + toView $ CEvtGroupUpdated user g g' (Just m) _ -> pure () isMainBusinessMember BusinessChatInfo {chatType, businessId, customerId} GroupMember {memberId} = case chatType of BCBusiness -> businessId == memberId @@ -2213,8 +2216,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> createCall db user call' $ chatItemTs' ci call_ <- atomically (TM.lookupInsert contactId call' calls) forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing - toView $ CRCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callUUID, callTs = chatItemTs' ci} - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + toView $ CEvtCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callUUID, callTs = chatItemTs' ci} + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] else featureRejected CFCalls where brokerTs = metaBrokerTs msgMeta @@ -2222,7 +2225,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = featureRejected f = do let content = ciContentNoParse $ CIRcvChatFeatureRejected f ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] -- to party initiating call xCallOffer :: Contact -> CallId -> CallOffer -> RcvMessage -> CM () @@ -2233,7 +2236,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> localDhPrivKey) callState' = CallOfferReceived {localCallType, peerCallType = callType, peerCallSession = rtcSession, sharedKey} askConfirmation = encryptedCall localCallType && not (encryptedCall callType) - toView CRCallOffer {user, contact = ct, callType, offer = rtcSession, sharedKey, askConfirmation} + toView CEvtCallOffer {user, contact = ct, callType, offer = rtcSession, sharedKey, askConfirmation} pure (Just call {callState = callState'}, Just . ACIContent SMDSnd $ CISndCall CISCallAccepted 0) _ -> do msgCallStateError "x.call.offer" call @@ -2246,7 +2249,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = \call -> case callState call of CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} -> do let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession = rtcSession, sharedKey} - toView $ CRCallAnswer user ct rtcSession + toView $ CEvtCallAnswer user ct rtcSession pure (Just call {callState = callState'}, Just . ACIContent SMDRcv $ CIRcvCall CISCallNegotiated 0) _ -> do msgCallStateError "x.call.answer" call @@ -2260,12 +2263,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} -> do -- TODO update the list of ice servers in peerCallSession let callState' = CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} - toView $ CRCallExtraInfo user ct rtcExtraInfo + toView $ CEvtCallExtraInfo user ct rtcExtraInfo pure (Just call {callState = callState'}, Nothing) CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} -> do -- TODO update the list of ice servers in peerCallSession let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} - toView $ CRCallExtraInfo user ct rtcExtraInfo + toView $ CEvtCallExtraInfo user ct rtcExtraInfo pure (Just call {callState = callState'}, Nothing) _ -> do msgCallStateError "x.call.extra" call @@ -2275,7 +2278,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xCallEnd :: Contact -> CallId -> RcvMessage -> CM () xCallEnd ct callId msg = msgCurrentCall ct callId "x.call.end" msg $ \Call {chatItemId} -> do - toView $ CRCallEnded user ct + toView $ CEvtCallEnded user ct (Nothing,) <$> callStatusItemContent user ct chatItemId WCSDisconnected msgCurrentCall :: Contact -> CallId -> Text -> RcvMessage -> (Call -> CM (Maybe Call, Maybe ACIContent)) -> CM () @@ -2317,7 +2320,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where merge c1' c2' = do c2'' <- withStore $ \db -> mergeContactRecords db vr user c1' c2' - toView $ CRContactsMerged user c1' c2' c2'' + toView $ CEvtContactsMerged user c1' c2' c2'' when (directOrUsed c2'') $ showSecurityCodeChanged c2'' pure $ Just c2'' where @@ -2356,14 +2359,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = associateMemberWithContact c1 m2@GroupMember {groupId} = do withStore' $ \db -> associateMemberWithContactRecord db user c1 m2 g <- withStore $ \db -> getGroupInfo db vr user groupId - toView $ CRContactAndMemberAssociated user c1 g m2 c1 + toView $ CEvtContactAndMemberAssociated user c1 g m2 c1 pure c1 associateContactWithMember :: GroupMember -> Contact -> CM Contact associateContactWithMember m1@GroupMember {groupId} c2 = do c2' <- withStore $ \db -> associateContactWithMemberRecord db vr user m1 c2 g <- withStore $ \db -> getGroupInfo db vr user groupId - toView $ CRContactAndMemberAssociated user c2 g m1 c2' + toView $ CEvtContactAndMemberAssociated user c2 g m1 c2' pure c2' saveConnInfo :: Connection -> ConnInfo -> CM (Connection, Bool) @@ -2373,15 +2376,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case chatMsgEvent of XInfo p -> do ct <- withStore $ \db -> createDirectContact db user conn' p - toView $ CRContactConnecting user ct + toView $ CEvtContactConnecting user ct pure (conn', False) XGrpLinkInv glInv -> do (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv - toView $ CRGroupLinkConnecting user gInfo host + toView $ CEvtGroupLinkConnecting user gInfo host pure (conn', True) XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do (gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db vr user conn' glRjct - toView $ CRGroupLinkConnecting user gInfo host + toView $ CEvtGroupLinkConnecting user gInfo host toViewTE $ TEGroupLinkRejected user gInfo rejectionReason pure (conn', True) -- TODO show/log error, other events in SMP confirmation @@ -2394,7 +2397,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right unknownMember@GroupMember {memberStatus = GSMemUnknown} -> do updatedMember <- withStore $ \db -> updateUnknownMemberAnnounced db vr user m unknownMember memInfo - toView $ CRUnknownMemberAnnounced user gInfo m unknownMember updatedMember + toView $ CEvtUnknownMemberAnnounced user gInfo m unknownMember updatedMember memberAnnouncedToView updatedMember Right _ -> messageError "x.grp.mem.new error: member already exists" Left _ -> do @@ -2405,7 +2408,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let event = RGEMemberAdded groupMemberId (fromLocalProfile memberProfile) ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent event) groupMsgToView gInfo ci - toView $ CRJoinedGroupMemberConnecting user gInfo m announcedMember + toView $ CEvtJoinedGroupMemberConnecting user gInfo m announcedMember xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM () xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do @@ -2491,7 +2494,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> updateGroupMemberRole db user member memRole ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent) groupMsgToView gInfo ci - toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} + toView CEvtMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole} checkHostRole :: GroupMember -> GroupMemberRole -> CM () checkHostRole GroupMember {memberRole, localDisplayName} memRole = @@ -2519,11 +2522,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs ciContent groupMsgToView gInfo ci - toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked} + toView CEvtMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked} Left (SEGroupMemberNotFoundByMemberId _) -> do bm <- createUnknownMember gInfo memId bm' <- setMemberBlocked bm - toView $ CRUnknownMemberBlocked user gInfo m bm' + toView $ CEvtUnknownMemberBlocked user gInfo m bm' Left e -> throwError $ ChatErrorStore e where setMemberBlocked bm = withStore' $ \db -> updateGroupMemberBlocked db user gInfo restriction bm @@ -2582,7 +2585,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved when withMessages $ deleteMessages membership SMDSnd deleteMemberItem RGEUserDeleted - toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m withMessages + toView $ CEvtDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m withMessages else withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Left _ -> messageError "x.grp.mem.del with unknown member ID" @@ -2594,7 +2597,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = deleteOrUpdateMemberRecord user member when withMessages $ deleteMessages member SMDRcv deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile) - toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved} withMessages + toView $ CEvtDeletedMember user gInfo m member {memberStatus = GSMemRemoved} withMessages where checkRole GroupMember {memberRole} a | senderRole < GRAdmin || senderRole < memberRole = @@ -2615,7 +2618,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEMemberLeft) groupMsgToView gInfo ci - toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft} + toView $ CEvtLeftMember user gInfo m {memberStatus = GSMemLeft} xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg brokerTs = do @@ -2628,7 +2631,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = deleteMembersConnections user ms ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEGroupDeleted) groupMsgToView gInfo ci - toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m + toView $ CEvtGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m xGrpInfo :: GroupInfo -> GroupMember -> GroupProfile -> RcvMessage -> UTCTime -> CM () xGrpInfo g@GroupInfo {groupProfile = p, businessChat} m@GroupMember {memberRole} p' msg brokerTs @@ -2636,7 +2639,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | otherwise = case businessChat of Nothing -> unless (p == p') $ do g' <- withStore $ \db -> updateGroupProfile db user g p' - toView $ CRGroupUpdated user g g' (Just m) + toView $ CEvtGroupUpdated user g g' (Just m) let cd = CDGroupRcv g' m unless (sameGroupProfileInfo p p') $ do ci <- saveRcvChatItemNoParse user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') @@ -2653,7 +2656,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateGroupPrefs_ g@GroupInfo {groupProfile = p} m ps' = unless (groupPreferences p == Just ps') $ do g' <- withStore' $ \db -> updateGroupPreferences db user g ps' - toView $ CRGroupUpdated user g g' (Just m) + toView $ CEvtGroupUpdated user g g' (Just m) let cd = CDGroupRcv g' m createGroupFeatureChangedItems user cd CIRcvGroupFeature g g' @@ -2696,14 +2699,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = joinAgentConnectionAsync user True connReq dm subMode createItems mCt' m' = do createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing - toView $ CRNewMemberContactReceivedInv user mCt' g m' + toView $ CEvtNewMemberContactReceivedInv user mCt' g m' forM_ mContent_ $ \mc -> do ci <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc, msgContentTexts mc) - toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat mCt') ci] + toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat mCt') ci] securityCodeChanged :: Contact -> CM () securityCodeChanged ct = do - toView $ CRContactVerificationReset user ct + toViewTE $ TEContactVerificationReset user ct createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> CM () @@ -2713,7 +2716,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Right author -> processForwardedMsg author msg Left (SEGroupMemberNotFoundByMemberId _) -> do unknownAuthor <- createUnknownMember gInfo memberId - toView $ CRUnknownMemberCreated user gInfo m unknownAuthor + toView $ CEvtUnknownMemberCreated user gInfo m unknownAuthor processForwardedMsg unknownAuthor msg Left e -> throwError $ ChatErrorStore e where @@ -2763,7 +2766,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateDirectItemsStatusMsgs ct conn msgIds newStatus = do cis <- withStore' $ \db -> forM msgIds $ \msgId -> runExceptT $ updateDirectItemsStatus' db ct conn msgId newStatus let acis = map ctItem $ concat $ rights cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis where ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) @@ -2771,7 +2774,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = updateDirectItemStatus ct conn msgId newStatus = do cis <- withStore $ \db -> updateDirectItemsStatus' db ct conn msgId newStatus let acis = map ctItem cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis where ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct) @@ -2802,7 +2805,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = items <- withStore' (\db -> getGroupChatItemsByAgentMsgId db user groupId connId msgId) cis <- catMaybes <$> withStore (\db -> mapM (updateItem db) items) let acis = map gItem cis - unless (null acis) $ toView $ CRChatItemsStatusesUpdated user acis + unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis where gItem = AChatItem SCTGroup SMDSnd (GroupChat gInfo) updateItem :: DB.Connection -> CChatItem 'CTGroup -> ExceptT StoreError IO (Maybe (ChatItem 'CTGroup 'MDSnd)) diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 502dbc98d0..7f9f3eb505 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -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) diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index d971656a26..bcdd60377f 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -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_ diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs index 00fc56f897..b572780a1f 100644 --- a/src/Simplex/Chat/Remote/Protocol.hs +++ b/src/Simplex/Chat/Remote/Protocol.hs @@ -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 diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index bf48d1d4f5..06a1e0f314 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -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 () diff --git a/src/Simplex/Chat/Terminal/Main.hs b/src/Simplex/Chat/Terminal/Main.hs index aa9adb059f..af90340cbc 100644 --- a/src/Simplex/Chat/Terminal/Main.hs +++ b/src/Simplex/Chat/Terminal/Main.hs @@ -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 diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 3694b20c67..5134d0efc9 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -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 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 6abbf6f03f..b87ba3a081 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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 (<> " ") 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)