diff --git a/apps/ios/Shared/Views/Chat/ChatItem/FramedItemView.swift b/apps/ios/Shared/Views/Chat/ChatItem/FramedItemView.swift index 2841df808a..6c6c605536 100644 --- a/apps/ios/Shared/Views/Chat/ChatItem/FramedItemView.swift +++ b/apps/ios/Shared/Views/Chat/ChatItem/FramedItemView.swift @@ -44,7 +44,7 @@ struct FramedItemView: View { } else if chatItem.meta.isLive { framedItemHeader(caption: Text("LIVE")) } - + if let qi = chatItem.quotedItem { ciQuoteView(qi) .onTapGesture { @@ -56,13 +56,13 @@ struct FramedItemView: View { } } } - + ChatItemContentView(chatInfo: chatInfo, chatItem: chatItem, showMember: showMember, msgContentView: framedMsgContentView) .padding(chatItem.content.msgContent != nil ? 0 : 4) .overlay(DetermineWidth()) } .onPreferenceChange(MetaColorPreferenceKey.self) { metaColor = $0 } - + if chatItem.content.msgContent != nil { CIMetaView(chatItem: chatItem, metaColor: metaColor) .padding(.horizontal, 12) @@ -73,7 +73,7 @@ struct FramedItemView: View { .background(chatItemFrameColorMaybeImageOrVideo(chatItem, colorScheme)) .cornerRadius(18) .onPreferenceChange(DetermineWidth.Key.self) { msgWidth = $0 } - + switch chatItem.meta.itemStatus { case .sndErrorAuth: v.onTapGesture { msgDeliveryError("Most likely this contact has deleted the connection with you.") } @@ -82,7 +82,7 @@ struct FramedItemView: View { default: v } } - + @ViewBuilder private func framedMsgContentView() -> some View { if chatItem.formattedText == nil && chatItem.file == nil && !chatItem.meta.isLive && isShortEmoji(chatItem.content.text) { VStack { diff --git a/apps/ios/Shared/Views/Chat/ChatView.swift b/apps/ios/Shared/Views/Chat/ChatView.swift index 322262418d..b879327683 100644 --- a/apps/ios/Shared/Views/Chat/ChatView.swift +++ b/apps/ios/Shared/Views/Chat/ChatView.swift @@ -443,6 +443,7 @@ struct ChatView: View { private struct ChatItemWithMenu: View { @EnvironmentObject var chat: Chat + @Environment(\.colorScheme) var colorScheme var ci: ChatItem var showMember: Bool = false var maxWidth: CGFloat @@ -469,8 +470,14 @@ struct ChatView: View { set: { _ in } ) - ChatItemView(chatInfo: chat.chatInfo, chatItem: ci, showMember: showMember, maxWidth: maxWidth, scrollProxy: scrollProxy, revealed: $revealed, allowMenu: $allowMenu, audioPlayer: $audioPlayer, playbackState: $playbackState, playbackTime: $playbackTime) - .uiKitContextMenu(menu: uiMenu, allowMenu: $allowMenu) + VStack(alignment: .trailing, spacing: 4) { + ChatItemView(chatInfo: chat.chatInfo, chatItem: ci, showMember: showMember, maxWidth: maxWidth, scrollProxy: scrollProxy, revealed: $revealed, allowMenu: $allowMenu, audioPlayer: $audioPlayer, playbackState: $playbackState, playbackTime: $playbackTime) + .uiKitContextMenu(menu: uiMenu, allowMenu: $allowMenu) + if ci.reactions.count > 0 { + chatItemReactions(ci.reactions) + .padding(.bottom, 4) + } + } .confirmationDialog("Delete message?", isPresented: $showDeleteMessage, titleVisibility: .visible) { Button("Delete for me", role: .destructive) { deleteMessage(.cidmInternal) @@ -497,7 +504,26 @@ struct ChatView: View { ChatItemInfoView(chatItemSent: ci.chatDir.sent, chatItemInfo: $chatItemInfo) } } - + + private func chatItemReactions(_ reactions: [CIReaction]) -> some View { + HStack(spacing: 4) { + ForEach(reactions, id: \.reaction) { r in + HStack(spacing: 4) { + switch r.reaction { + case let .emoji(emoji): Text(emoji).font(.caption) + } + if r.totalReacted > 1 { + Text("\(r.totalReacted)").font(.caption).foregroundColor(.secondary) + } + } + .padding(.horizontal, 8) + .padding(.vertical, 4) + .background(!r.userReacted ? Color.clear : colorScheme == .dark ? sentColorDark : sentColorLight) + .cornerRadius(16) + } + } + } + private func menu(live: Bool) -> [UIAction] { var menu: [UIAction] = [] if let mc = ci.content.msgContent, ci.meta.itemDeleted == nil || revealed { @@ -718,7 +744,7 @@ struct ChatView: View { chat.chatInfo.featureEnabled(.fullDelete) ? "Delete for everyone" : "Mark deleted for everyone" } } - + private func showMemberImage(_ member: GroupMember, _ prevItem: ChatItem?) -> Bool { switch (prevItem?.chatDir) { case .groupSnd: return true diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index 23a1d95565..9369fccccc 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -1762,6 +1762,17 @@ public struct ChatItem: Identifiable, Decodable { self.content = content self.formattedText = formattedText self.quotedItem = quotedItem + self.reactions = [] // [ +// CIReaction(reaction: .emoji(emoji: "👍"), userReacted: false, totalReacted: 1), +// CIReaction(reaction: .emoji(emoji: "❤️"), userReacted: false, totalReacted: 1), +// CIReaction(reaction: .emoji(emoji: "🚀"), userReacted: false, totalReacted: 3), +// CIReaction(reaction: .emoji(emoji: "👍"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "👎"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "👀"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "🎉"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "😀"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "😕"), userReacted: true, totalReacted: 2), +// ] self.file = file } @@ -1770,6 +1781,17 @@ public struct ChatItem: Identifiable, Decodable { public var content: CIContent public var formattedText: [FormattedText]? public var quotedItem: CIQuote? + public var reactions: [CIReaction] = [] // [ +// CIReaction(reaction: .emoji(emoji: "👍"), userReacted: false, totalReacted: 1), +// CIReaction(reaction: .emoji(emoji: "❤️"), userReacted: false, totalReacted: 1), +// CIReaction(reaction: .emoji(emoji: "🚀"), userReacted: false, totalReacted: 3), +// CIReaction(reaction: .emoji(emoji: "👍"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "👎"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "👀"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "🎉"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "😀"), userReacted: true, totalReacted: 2), +// CIReaction(reaction: .emoji(emoji: "😕"), userReacted: true, totalReacted: 2), +// ] public var file: CIFile? public var viewTimestamp = Date.now @@ -2298,6 +2320,16 @@ public struct CIQuote: Decodable, ItemContent { } } +public struct CIReaction: Decodable { + public var reaction: MsgReaction + public var userReacted: Bool + public var totalReacted: Int +} + +public enum MsgReaction: Decodable, Hashable { + case emoji(emoji: String) +} + public struct CIFile: Decodable { public var fileId: Int64 public var fileName: String diff --git a/apps/simplex-broadcast-bot/Options.hs b/apps/simplex-broadcast-bot/Options.hs index 0c69845f0f..f15035fa16 100644 --- a/apps/simplex-broadcast-bot/Options.hs +++ b/apps/simplex-broadcast-bot/Options.hs @@ -104,6 +104,7 @@ mkChatOpts BroadcastBotOpts {coreOptions} = chatCmdDelay = 3, chatServerPort = Nothing, optFilesFolder = Nothing, + showReactions = False, allowInstantFiles = True, muteNotifications = True, maintenance = False diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 591d677ca8..d9dd632181 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -95,6 +95,7 @@ library Simplex.Chat.Migrations.M20230422_profile_contact_links Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages Simplex.Chat.Migrations.M20230505_chat_item_versions + Simplex.Chat.Migrations.M20230511_reactions Simplex.Chat.Mobile Simplex.Chat.Mobile.WebRTC Simplex.Chat.Options diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 91a2b12db0..b327880736 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -114,6 +114,7 @@ defaultChatConfig = inlineFiles = defaultInlineFilesConfig, xftpFileConfig = Just defaultXFTPFileConfig, tempDir = Nothing, + showReactions = False, logLevel = CLLImportant, subscriptionEvents = False, hostEvents = False, @@ -135,6 +136,9 @@ _defaultNtfServers = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.s maxImageSize :: Integer maxImageSize = 236700 +maxMsgReactions :: Int +maxMsgReactions = 3 + fixedImagePreview :: ImageData fixedImagePreview = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg==" @@ -148,9 +152,9 @@ createChatDatabase filePrefix key confirmMigrations = runExceptT $ do pure ChatDatabase {chatStore, agentStore} newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController -newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, showReactions, allowInstantFiles} sendToast = do let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} - config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'} + config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'} sendNotification = fromMaybe (const $ pure ()) sendToast firstTime = dbNew chatStore activeTo <- newTVarIO ActiveNone @@ -728,6 +732,55 @@ processChatCommand = \case SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId delGroupChatItem user gInfo ci msgId (Just membership) (_, _) -> throwChatError CEInvalidChatItemDelete + APIChatItemReaction (ChatRef cType chatId) itemId reaction add -> withUser $ \user -> withChatLock "chatItemReaction" $ case cType of + CTDirect -> + withStore (\db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId) >>= \case + (ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do + unless (featureAllowed SCFReactions forUser ct) $ + throwChatError $ CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions) + unless (ciReactionAllowed ci) $ + throwChatError $ CECommandError "reaction not allowed - chat item has no content" + rs <- withStore' $ \db -> getDirectReactions db ct itemSharedMId True + checkReactionAllowed rs + (SndMessage {msgId}, _) <- sendDirectContactMessage ct $ XMsgReact itemSharedMId Nothing reaction add + createdAt <- liftIO getCurrentTime + reactions <- withStore' $ \db -> do + setDirectReaction db ct itemSharedMId True reaction add msgId createdAt + liftIO $ getDirectCIReactions db ct itemSharedMId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTDirect SMDSnd (DirectChat ct) $ CIReaction CIDirectSnd ci' createdAt reaction + pure $ CRChatItemReaction user r add + _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" + CTGroup -> + withStore (\db -> (,) <$> getGroup db user chatId <*> getGroupChatItem db user chatId itemId) >>= \case + (Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}, chatDir}) -> do + unless (groupFeatureAllowed SGFReactions g) $ + throwChatError $ CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions) + unless (ciReactionAllowed ci) $ + throwChatError $ CECommandError "reaction not allowed - chat item has no content" + let GroupMember {memberId} = membership + itemMemberId = case chatDir of + CIGroupSnd -> memberId + CIGroupRcv GroupMember {memberId = mId} -> mId + rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True + checkReactionAllowed rs + SndMessage {msgId} <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add) + createdAt <- liftIO getCurrentTime + reactions <- withStore' $ \db -> do + setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt + liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction + pure $ CRChatItemReaction user r add + _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" + CTContactRequest -> pure $ chatCmdError (Just user) "not supported" + CTContactConnection -> pure $ chatCmdError (Just user) "not supported" + where + checkReactionAllowed rs = do + when ((reaction `elem` rs) == add) $ + throwChatError $ CECommandError $ "reaction already " <> if add then "added" else "removed" + when (add && length rs >= maxMsgReactions) $ + throwChatError $ CECommandError "too many reactions" APIChatRead (ChatRef cType chatId) fromToIds -> withUser $ \_ -> case cType of CTDirect -> do user <- withStore $ \db -> getUserByContactId db chatId @@ -1229,6 +1282,10 @@ processChatCommand = \case chatRef <- getChatRef user chatName let mc = MCText msg processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc + ReactToMessage chatName msg reaction add -> withUser $ \user -> do + chatRef <- getChatRef user chatName + chatItemId <- getChatItemIdByText user chatRef msg + processChatCommand $ APIChatItemReaction chatRef chatItemId reaction add APINewGroup userId gProfile -> withUserId userId $ \user -> do gVar <- asks idsDrg groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile @@ -2650,6 +2707,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XMsgFileCancel sharedMsgId -> cancelMessageFile ct sharedMsgId msgMeta XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct sharedMsgId mContent msg msgMeta ttl live XMsgDel sharedMsgId _ -> messageDelete ct sharedMsgId msg msgMeta + XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct sharedMsgId reaction add msg msgMeta -- TODO discontinue XFile XFile fInv -> processFileInvitation' ct fInv msg msgMeta XFileCancel sharedMsgId -> xFileCancel ct sharedMsgId msgMeta @@ -2880,6 +2938,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m sharedMsgId msgMeta XMsgUpdate sharedMsgId mContent ttl live -> canSend $ groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg + XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m sharedMsgId memberId reaction add msg msgMeta -- TODO discontinue XFile XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta XFileCancel sharedMsgId -> xFileCancelGroup gInfo m sharedMsgId msgMeta @@ -3260,7 +3319,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do where newChatItem ciContent ciFile_ timed_ live = do ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live - toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) + reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ + toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}) pure ci messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> MsgMeta -> m () @@ -3316,20 +3376,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta - updateRcvChatItem `catchError` \e -> - case e of - (ChatErrorStore (SEChatItemSharedMsgIdNotFound _)) -> do - -- This patches initial sharedMsgId into chat item when locally deleted chat item - -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). - -- Chat item and update message which created it will have different sharedMsgId in this case... - let timed_ = rcvContactCITimed ct ttl - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live - ci' <- withStore' $ \db -> do - createChatItemVersion db (chatItemId' ci) brokerTs mc - updateDirectChatItem' db user contactId ci content live Nothing - toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') - setActive $ ActiveC c - _ -> throwError e + updateRcvChatItem `catchCINotFound` \_ -> do + -- This patches initial sharedMsgId into chat item when locally deleted chat item + -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). + -- Chat item and update message which created it will have different sharedMsgId in this case... + let timed_ = rcvContactCITimed ct ttl + ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live + ci' <- withStore' $ \db -> do + createChatItemVersion db (chatItemId' ci) brokerTs mc + updateDirectChatItem' db user contactId ci content live Nothing + toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') + setActive $ ActiveC c where MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc @@ -3353,10 +3410,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m () messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta - deleteRcvChatItem `catchError` \e -> - case e of - (ChatErrorStore (SEChatItemSharedMsgIdNotFound sMsgId)) -> toView $ CRChatItemDeletedNotFound user ct sMsgId - _ -> throwError e + deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct) where deleteRcvChatItem = do ci@(CChatItem msgDir _) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId @@ -3367,8 +3421,60 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do else markDirectCIDeleted user ct ci msgId False >>= toView SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete" + directMsgReaction :: Contact -> SharedMsgId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> m () + directMsgReaction ct sharedMsgId reaction add RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do + when (featureAllowed SCFReactions forContact ct) $ do + rs <- withStore' $ \db -> getDirectReactions db ct sharedMsgId False + when (reactionAllowed add reaction rs) $ do + updateChatItemReaction `catchCINotFound` \_ -> + withStore' $ \db -> setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs + where + updateChatItemReaction = do + cr_ <- withStore $ \db -> do + CChatItem md ci <- getDirectChatItemBySharedMsgId db user (contactId' ct) sharedMsgId + if ciReactionAllowed ci + then liftIO $ do + setDirectReaction db ct sharedMsgId False reaction add msgId brokerTs + reactions <- getDirectCIReactions db ct sharedMsgId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTDirect SMDRcv (DirectChat ct) $ CIReaction CIDirectRcv ci' brokerTs reaction + pure $ Just $ CRChatItemReaction user r add + else pure Nothing + mapM_ toView cr_ + + groupMsgReaction :: GroupInfo -> GroupMember -> SharedMsgId -> MemberId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> m () + groupMsgReaction g@GroupInfo {groupId} m sharedMsgId itemMemberId reaction add RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do + when (groupFeatureAllowed SGFReactions g) $ do + rs <- withStore' $ \db -> getGroupReactions db g m itemMemberId sharedMsgId False + when (reactionAllowed add reaction rs) $ do + updateChatItemReaction `catchCINotFound` \_ -> + withStore' $ \db -> setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs + where + updateChatItemReaction = do + cr_ <- withStore $ \db -> do + CChatItem md ci <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId + if ciReactionAllowed ci + then liftIO $ do + setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs + reactions <- getGroupCIReactions db g itemMemberId sharedMsgId + let ci' = CChatItem md ci {reactions} + r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m) ci' brokerTs reaction + pure $ Just $ CRChatItemReaction user r add + else pure Nothing + mapM_ toView cr_ + + reactionAllowed :: Bool -> MsgReaction -> [MsgReaction] -> Bool + reactionAllowed add reaction rs = (reaction `elem` rs) /= add && not (add && length rs >= maxMsgReactions) + + catchCINotFound :: m a -> (SharedMsgId -> m a) -> m a + catchCINotFound f handle = + f `catchError` \case + ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId + e -> throwError e + newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m () - newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msg@RcvMessage {sharedMsgId_} msgMeta = do + newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId} mc msg@RcvMessage {sharedMsgId_} msgMeta = do + -- TODO integrity message check let (ExtMsgContent content fInv_ _ _) = mcExtMsgContent mc if isVoice content && not (groupFeatureAllowed SGFVoice gInfo) then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing False @@ -3385,25 +3491,23 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do where newChatItem ciContent ciFile_ timed_ live = do ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live - groupMsgToView gInfo m ci msgMeta + reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ + groupMsgToView gInfo m ci {reactions} msgMeta pure ci groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ = - updateRcvChatItem `catchError` \e -> - case e of - (ChatErrorStore (SEChatItemSharedMsgIdNotFound _)) -> do - -- This patches initial sharedMsgId into chat item when locally deleted chat item - -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). - -- Chat item and update message which created it will have different sharedMsgId in this case... - let timed_ = rcvGroupCITimed gInfo ttl_ - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live - ci' <- withStore' $ \db -> do - createChatItemVersion db (chatItemId' ci) brokerTs mc - updateGroupChatItem db user groupId ci content live Nothing - toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') - setActive $ ActiveG g - _ -> throwError e + updateRcvChatItem `catchCINotFound` \_ -> do + -- This patches initial sharedMsgId into chat item when locally deleted chat item + -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). + -- Chat item and update message which created it will have different sharedMsgId in this case... + let timed_ = rcvGroupCITimed gInfo ttl_ + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live + ci' <- withStore' $ \db -> do + createChatItemVersion db (chatItemId' ci) brokerTs mc + updateGroupChatItem db user groupId ci content live Nothing + toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') + setActive $ ActiveG g where MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc @@ -4306,7 +4410,7 @@ mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs cur let itemText = ciContentToText content itemStatus = ciCreateStatus content meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) tz currentTs itemTs currentTs currentTs - pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file} + pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed = do @@ -4656,6 +4760,7 @@ chatCommandP = "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode), "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal), + "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> reactionP <* A.space <*> onOffP), "/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))), "/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP), "/_delete " *> (APIDeleteChat <$> chatRefP), @@ -4774,6 +4879,7 @@ chatCommandP = ("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> textP), ("\\\\ #" <|> "\\\\#") *> (DeleteMemberMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> textP), ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> msgTextP), + (("+" $> True) <|> ("-" $> False)) >>= \add -> reactionP <* A.space >>= \reaction -> ReactToMessage <$> chatNameP' <* A.space <*> textP <*> pure reaction <*> pure add, "/feed " *> (SendMessageBroadcast <$> msgTextP), ("/chats" <|> "/cs") *> (LastChats <$> (" all" $> Nothing <|> Just <$> (A.space *> A.decimal <|> pure 20))), ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing), @@ -4844,6 +4950,18 @@ chatCommandP = displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> msgTextP quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space + reactionP = MREmoji <$> (mrEmojiChar <$?> (toEmoji <$> A.anyChar)) + toEmoji = \case + '1' -> '👍' + '+' -> '👍' + '-' -> '👎' + ')' -> '😀' + '!' -> '🎉' + '?' -> '😕' + '*' -> head "❤️" + '^' -> '🚀' + '%' -> '👀' + c -> c refChar c = c > ' ' && c /= '#' && c /= '@' liveMessageP = " live=" *> onOffP <|> pure False sendMessageTTLP = " ttl=" *> ((Just <$> A.decimal) <|> ("default" $> Nothing)) <|> pure Nothing diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 90cc8583ca..05154440ee 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -104,6 +104,7 @@ data ChatConfig = ChatConfig inlineFiles :: InlineFilesConfig, xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled tempDir :: Maybe FilePath, + showReactions :: Bool, subscriptionEvents :: Bool, hostEvents :: Bool, logLevel :: ChatLogLevel, @@ -218,6 +219,7 @@ data ChatCommand | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent} | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode | APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId + | APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, reaction :: MsgReaction, add :: Bool} | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId)) | APIChatUnread ChatRef Bool | APIDeleteChat ChatRef @@ -319,6 +321,7 @@ data ChatCommand | DeleteMemberMessage GroupName ContactName Text | EditMessage {chatName :: ChatName, editedMsg :: Text, message :: Text} | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text} + | ReactToMessage {chatName :: ChatName, reactToMessage :: Text, reaction :: MsgReaction, add :: Bool} | APINewGroup UserId GroupProfile | NewGroup GroupProfile | AddMember GroupName ContactName GroupMemberRole @@ -398,6 +401,7 @@ data ChatResponse | CRChatItemStatusUpdated {user :: User, chatItem :: AChatItem} | CRChatItemUpdated {user :: User, chatItem :: AChatItem} | CRChatItemNotChanged {user :: User, chatItem :: AChatItem} + | CRChatItemReaction {user :: User, reaction :: ACIReaction, added :: Bool} | CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool} | CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId} | CRBroadcastSent User MsgContent Int ZonedTime diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index b699cbbc06..7e6d1a0a10 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -137,6 +137,7 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem content :: CIContent d, formattedText :: Maybe MarkdownList, quotedItem :: Maybe (CIQuote c), + reactions :: [CIReactionCount], file :: Maybe (CIFile d) } deriving (Show, Generic) @@ -175,6 +176,11 @@ jsonCIDirection = \case CIGroupSnd -> JCIGroupSnd CIGroupRcv m -> JCIGroupRcv m +data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int} + deriving (Show, Generic) + +instance ToJSON CIReactionCount where toEncoding = J.genericToEncoding J.defaultOptions + data CChatItem c = forall d. MsgDirectionI d => CChatItem (SMsgDirection d) (ChatItem c d) deriving instance Show (CChatItem c) @@ -388,6 +394,33 @@ instance ToJSON (CIQuote c) where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} +data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction + { chatDir :: CIDirection c d, + chatItem :: CChatItem c, + sentAt :: UTCTime, + reaction :: MsgReaction + } + deriving (Show, Generic) + +instance ToJSON (CIReaction c d) where + toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} + toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} + +data ACIReaction = forall c d. ACIReaction (SChatType c) (SMsgDirection d) (ChatInfo c) (CIReaction c d) + +deriving instance Show ACIReaction + +instance ToJSON ACIReaction where + toJSON (ACIReaction _ _ chat reaction) = J.toJSON $ JSONCIReaction chat reaction + toEncoding (ACIReaction _ _ chat reaction) = J.toEncoding $ JSONCIReaction chat reaction + +data JSONCIReaction c d = JSONCIReaction {chatInfo :: ChatInfo c, chatReaction :: CIReaction c d} + deriving (Generic) + +instance ToJSON (JSONCIReaction c d) where + toJSON = J.genericToJSON J.defaultOptions + toEncoding = J.genericToEncoding J.defaultOptions + data CIQDirection (c :: ChatType) where CIQDirectSnd :: CIQDirection 'CTDirect CIQDirectRcv :: CIQDirection 'CTDirect @@ -766,6 +799,13 @@ instance ToJSON MsgDecryptError where instance FromJSON MsgDecryptError where parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MDE" +ciReactionAllowed :: ChatItem c d -> Bool +ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False +ciReactionAllowed ChatItem {content} = case content of + CISndMsgContent _ -> True + CIRcvMsgContent _ -> True + _ -> False + ciRequiresAttention :: forall d. MsgDirectionI d => CIContent d -> Bool ciRequiresAttention content = case msgDirection @d of SMDSnd -> True diff --git a/src/Simplex/Chat/Migrations/M20230511_reactions.hs b/src/Simplex/Chat/Migrations/M20230511_reactions.hs new file mode 100644 index 0000000000..f01954a373 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230511_reactions.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230511_reactions where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230511_reactions :: Query +m20230511_reactions = + [sql| +CREATE TABLE chat_item_reactions ( + chat_item_reaction_id INTEGER PRIMARY KEY AUTOINCREMENT, + item_member_id BLOB, -- member that created item, NULL for items in direct chats + shared_msg_id BLOB NOT NULL, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_id INTEGER REFERENCES groups ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL, -- member that sent reaction, NULL for items in direct chats + created_by_msg_id INTEGER REFERENCES messages(message_id) ON DELETE SET NULL, + reaction TEXT NOT NULL, -- JSON of MsgReaction + reaction_sent INTEGER NOT NULL, -- 0 for received, 1 for sent + reaction_ts TEXT NOT NULL, -- broker_ts of creating message for received, created_at for sent + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')) +); + +CREATE INDEX idx_chat_item_reactions_shared_msg_id ON chat_item_reactions(shared_msg_id); +CREATE INDEX idx_chat_item_reactions_contact_id ON chat_item_reactions(contact_id); +CREATE INDEX idx_chat_item_reactions_group_id ON chat_item_reactions(group_id); +CREATE INDEX idx_chat_item_reactions_group_member_id ON chat_item_reactions(group_member_id); + +CREATE INDEX idx_chat_item_reactions_contact ON chat_item_reactions(contact_id, shared_msg_id); +CREATE INDEX idx_chat_item_reactions_group ON chat_item_reactions(group_id, shared_msg_id); +|] + +down_m20230511_reactions :: Query +down_m20230511_reactions = + [sql| +DROP INDEX idx_chat_item_reactions_group; +DROP INDEX idx_chat_item_reactions_contact; + +DROP INDEX idx_chat_item_reactions_group_member_id; +DROP INDEX idx_chat_item_reactions_group_id; +DROP INDEX idx_chat_item_reactions_contact_id; +DROP INDEX idx_chat_item_reactions_shared_msg_id; + +DROP TABLE chat_item_reactions; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 83a8ec6520..311a701885 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -463,6 +463,20 @@ CREATE TABLE chat_item_versions( created_at TEXT NOT NULL DEFAULT(datetime('now')), updated_at TEXT NOT NULL DEFAULT(datetime('now')) ); +CREATE TABLE chat_item_reactions( + chat_item_reaction_id INTEGER PRIMARY KEY AUTOINCREMENT, + item_member_id BLOB, -- member that created item, NULL for items in direct chats + shared_msg_id BLOB NOT NULL, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_id INTEGER REFERENCES groups ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL, -- member that sent reaction, NULL for items in direct chats + created_by_msg_id INTEGER REFERENCES messages(message_id) ON DELETE SET NULL, + reaction TEXT NOT NULL, -- JSON of MsgReaction + reaction_sent INTEGER NOT NULL, -- 0 for received, 1 for sent + reaction_ts TEXT NOT NULL, -- broker_ts of creating message for received, created_at for sent + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')) +); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, full_name @@ -607,3 +621,21 @@ CREATE INDEX idx_xftp_file_descriptions_user_id ON xftp_file_descriptions( CREATE INDEX idx_chat_item_versions_chat_item_id ON chat_item_versions( chat_item_id ); +CREATE INDEX idx_chat_item_reactions_shared_msg_id ON chat_item_reactions( + shared_msg_id +); +CREATE INDEX idx_chat_item_reactions_contact_id ON chat_item_reactions( + contact_id +); +CREATE INDEX idx_chat_item_reactions_group_id ON chat_item_reactions(group_id); +CREATE INDEX idx_chat_item_reactions_group_member_id ON chat_item_reactions( + group_member_id +); +CREATE INDEX idx_chat_item_reactions_contact ON chat_item_reactions( + contact_id, + shared_msg_id +); +CREATE INDEX idx_chat_item_reactions_group ON chat_item_reactions( + group_id, + shared_msg_id +); diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 03f7f60e2e..10badd0e2c 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -128,6 +128,7 @@ mobileChatOpts dbFilePrefix dbKey = chatCmdDelay = 3, chatServerPort = Nothing, optFilesFolder = Nothing, + showReactions = False, allowInstantFiles = True, muteNotifications = True, maintenance = True diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index af4009b787..57b653ca98 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -35,6 +35,7 @@ data ChatOpts = ChatOpts chatCmdDelay :: Int, chatServerPort :: Maybe String, optFilesFolder :: Maybe FilePath, + showReactions :: Bool, allowInstantFiles :: Bool, muteNotifications :: Bool, maintenance :: Bool @@ -216,6 +217,11 @@ chatOptsP appDir defaultDbFileName = do <> metavar "FOLDER" <> help "Folder to use for sent and received files" ) + showReactions <- + switch + ( long "reactions" + <> help "Show message reactions" + ) allowInstantFiles <- switch ( long "allow-instant-files" @@ -240,6 +246,7 @@ chatOptsP appDir defaultDbFileName = do chatCmdDelay, chatServerPort, optFilesFolder, + showReactions, allowInstantFiles, muteNotifications, maintenance diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index f14efbc101..36ff3927f7 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -184,6 +184,7 @@ data ChatMsgEvent (e :: MsgEncoding) where XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json XMsgDeleted :: ChatMsgEvent 'Json + XMsgReact :: {msgId :: SharedMsgId, memberId :: Maybe MemberId, reaction :: MsgReaction, add :: Bool} -> ChatMsgEvent 'Json XFile :: FileInvitation -> ChatMsgEvent 'Json -- TODO discontinue XFileAcpt :: String -> ChatMsgEvent 'Json -- direct file protocol XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json @@ -224,6 +225,37 @@ data AChatMsgEvent = forall e. MsgEncodingI e => ACME (SMsgEncoding e) (ChatMsgE deriving instance Show AChatMsgEvent +data MsgReaction = MREmoji {emoji :: MREmojiChar} + deriving (Eq, Show, Generic) + +instance ToJSON MsgReaction where + toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "MR" + toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "MR" + +instance FromJSON MsgReaction where + parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "MR" + +instance ToField MsgReaction where + toField = toField . encodeJSON + +instance FromField MsgReaction where + fromField = fromTextField_ decodeJSON + +newtype MREmojiChar = MREmojiChar Char + deriving (Eq, Show) + +instance ToJSON MREmojiChar where + toEncoding (MREmojiChar c) = J.toEncoding c + toJSON (MREmojiChar c) = J.toJSON c + +instance FromJSON MREmojiChar where + parseJSON v = mrEmojiChar <$?> J.parseJSON v + +mrEmojiChar :: Char -> Either String MREmojiChar +mrEmojiChar c + | c `elem` ("👍👎😀🎉😕❤️🚀👀" :: String) = Right $ MREmojiChar c + | otherwise = Left "bad emoji" + data FileChunk = FileChunk {chunkNo :: Integer, chunkBytes :: ByteString} | FileChunkCancel deriving (Eq, Show) @@ -473,6 +505,7 @@ data CMEventTag (e :: MsgEncoding) where XMsgUpdate_ :: CMEventTag 'Json XMsgDel_ :: CMEventTag 'Json XMsgDeleted_ :: CMEventTag 'Json + XMsgReact_ :: CMEventTag 'Json XFile_ :: CMEventTag 'Json XFileAcpt_ :: CMEventTag 'Json XFileAcptInv_ :: CMEventTag 'Json @@ -517,6 +550,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where XMsgUpdate_ -> "x.msg.update" XMsgDel_ -> "x.msg.del" XMsgDeleted_ -> "x.msg.deleted" + XMsgReact_ -> "x.msg.react" XFile_ -> "x.file" XFileAcpt_ -> "x.file.acpt" XFileAcptInv_ -> "x.file.acpt.inv" @@ -562,6 +596,7 @@ instance StrEncoding ACMEventTag where "x.msg.update" -> XMsgUpdate_ "x.msg.del" -> XMsgDel_ "x.msg.deleted" -> XMsgDeleted_ + "x.msg.react" -> XMsgReact_ "x.file" -> XFile_ "x.file.acpt" -> XFileAcpt_ "x.file.acpt.inv" -> XFileAcptInv_ @@ -603,6 +638,7 @@ toCMEventTag msg = case msg of XMsgUpdate {} -> XMsgUpdate_ XMsgDel {} -> XMsgDel_ XMsgDeleted -> XMsgDeleted_ + XMsgReact {} -> XMsgReact_ XFile _ -> XFile_ XFileAcpt _ -> XFileAcpt_ XFileAcptInv {} -> XFileAcptInv_ @@ -690,6 +726,7 @@ appJsonToCM AppMessageJson {msgId, event, params} = do XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live" XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId" XMsgDeleted_ -> pure XMsgDeleted + XMsgReact_ -> XMsgReact <$> p "msgId" <*> opt "memberId" <*> p "reaction" <*> p "add" XFile_ -> XFile <$> p "file" XFileAcpt_ -> XFileAcpt <$> p "fileName" XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> opt "fileConnReq" <*> p "fileName" @@ -745,6 +782,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content] XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId'] XMsgDeleted -> JM.empty + XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add] XFile fileInv -> o ["file" .= fileInv] XFileAcpt fileName -> o ["fileName" .= fileName] XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName] diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index d670c52dc2..54fe584c81 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -228,6 +228,12 @@ module Simplex.Chat.Store getAllChatItems, getAChatItem, getChatItemVersions, + getDirectCIReactions, + getDirectReactions, + setDirectReaction, + getGroupCIReactions, + getGroupReactions, + setGroupReaction, getChatItemIdByAgentMsgId, getDirectChatItem, getDirectChatItemBySharedMsgId, @@ -384,6 +390,7 @@ import Simplex.Chat.Migrations.M20230420_rcv_files_to_receive import Simplex.Chat.Migrations.M20230422_profile_contact_links import Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages import Simplex.Chat.Migrations.M20230505_chat_item_versions +import Simplex.Chat.Migrations.M20230511_reactions import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Util (week) @@ -461,7 +468,8 @@ schemaMigrations = ("20230420_rcv_files_to_receive", m20230420_rcv_files_to_receive, Just down_m20230420_rcv_files_to_receive), ("20230422_profile_contact_links", m20230422_profile_contact_links, Just down_m20230422_profile_contact_links), ("20230504_recreate_msg_delivery_events_cleanup_messages", m20230504_recreate_msg_delivery_events_cleanup_messages, Just down_m20230504_recreate_msg_delivery_events_cleanup_messages), - ("20230505_chat_item_versions", m20230505_chat_item_versions, Just down_m20230505_chat_item_versions) + ("20230505_chat_item_versions", m20230505_chat_item_versions, Just down_m20230505_chat_item_versions), + ("20230511_reactions", m20230511_reactions, Just down_m20230511_reactions) ] -- | The list of migrations in ascending order by date @@ -3993,17 +4001,17 @@ toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, viaUser getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect) getDirectChat db user contactId pagination search_ = do let search = fromMaybe "" search_ - case pagination of - CPLast count -> getDirectChatLast_ db user contactId count search - CPAfter afterId count -> getDirectChatAfter_ db user contactId afterId count search - CPBefore beforeId count -> getDirectChatBefore_ db user contactId beforeId count search + ct <- getContact db user contactId + liftIO . getDirectChatReactions_ db ct =<< case pagination of + CPLast count -> getDirectChatLast_ db user ct count search + CPAfter afterId count -> getDirectChatAfter_ db user ct afterId count search + CPBefore beforeId count -> getDirectChatBefore_ db user ct beforeId count search -getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChatLast_ db user contactId count search = do - contact <- getContact db user contactId +getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChatLast_ db user ct@Contact {contactId} count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} chatItems <- getDirectChatItemsLast db user contactId count search - pure $ Chat (DirectChat contact) (reverse chatItems) stats + pure $ Chat (DirectChat ct) (reverse chatItems) stats -- the last items in reverse order (the last item in the conversation is the first in the returned list) getDirectChatItemsLast :: DB.Connection -> User -> ContactId -> Int -> String -> ExceptT StoreError IO [CChatItem 'CTDirect] @@ -4030,12 +4038,11 @@ getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do |] (userId, contactId, search, count) -getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChatAfter_ db user@User {userId} contactId afterChatItemId count search = do - contact <- getContact db user contactId +getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} chatItems <- ExceptT getDirectChatItemsAfter_ - pure $ Chat (DirectChat contact) chatItems stats + pure $ Chat (DirectChat ct) chatItems stats where getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect]) getDirectChatItemsAfter_ = do @@ -4062,12 +4069,11 @@ getDirectChatAfter_ db user@User {userId} contactId afterChatItemId count search |] (userId, contactId, search, afterChatItemId, count) -getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChatBefore_ db user@User {userId} contactId beforeChatItemId count search = do - contact <- getContact db user contactId +getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} chatItems <- ExceptT getDirectChatItemsBefore_ - pure $ Chat (DirectChat contact) (reverse chatItems) stats + pure $ Chat (DirectChat ct) (reverse chatItems) stats where getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect]) getDirectChatItemsBefore_ = do @@ -4133,18 +4139,18 @@ getContact db user@User {userId} contactId = getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup) getGroupChat db user groupId pagination search_ = do let search = fromMaybe "" search_ - case pagination of - CPLast count -> getGroupChatLast_ db user groupId count search - CPAfter afterId count -> getGroupChatAfter_ db user groupId afterId count search - CPBefore beforeId count -> getGroupChatBefore_ db user groupId beforeId count search + g <- getGroupInfo db user groupId + liftIO . getGroupChatReactions_ db g =<< case pagination of + CPLast count -> getGroupChatLast_ db user g count search + CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search + CPBefore beforeId count -> getGroupChatBefore_ db user g beforeId count search -getGroupChatLast_ :: DB.Connection -> User -> Int64 -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) -getGroupChatLast_ db user@User {userId} groupId count search = do - groupInfo <- getGroupInfo db user groupId +getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} chatItemIds <- liftIO getGroupChatItemIdsLast_ chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds - pure $ Chat (GroupChat groupInfo) (reverse chatItems) stats + pure $ Chat (GroupChat g) (reverse chatItems) stats where getGroupChatItemIdsLast_ :: IO [ChatItemId] getGroupChatItemIdsLast_ = @@ -4176,14 +4182,13 @@ getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do (userId, groupId, groupMemberId) getGroupChatItem db user groupId chatItemId -getGroupChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) -getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count search = do - groupInfo <- getGroupInfo db user groupId +getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} afterChatItem <- getGroupChatItem db user groupId afterChatItemId chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem) chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds - pure $ Chat (GroupChat groupInfo) chatItems stats + pure $ Chat (GroupChat g) chatItems stats where getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId] getGroupChatItemIdsAfter_ afterChatItemTs = @@ -4200,14 +4205,13 @@ getGroupChatAfter_ db user@User {userId} groupId afterChatItemId count search = |] (userId, groupId, search, afterChatItemTs, afterChatItemTs, afterChatItemId, count) -getGroupChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) -getGroupChatBefore_ db user@User {userId} groupId beforeChatItemId count search = do - groupInfo <- getGroupInfo db user groupId +getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId count search = do let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem) chatItems <- mapM (getGroupChatItem db user groupId) chatItemIds - pure $ Chat (GroupChat groupInfo) (reverse chatItems) stats + pure $ Chat (GroupChat g) (reverse chatItems) stats where getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId] getGroupChatItemIdsBefore_ beforeChatItemTs = @@ -4286,7 +4290,7 @@ getAllChatItems db user@User {userId} pagination search_ = do CPLast count -> liftIO $ getAllChatItemsLast_ count CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem db user afterId CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem db user beforeId - mapM (uncurry $ getAChatItem_ db user) itemRefs + mapM (uncurry (getAChatItem_ db user) >=> liftIO . getACIReactions db) itemRefs where search = fromMaybe "" search_ getAllChatItemsLast_ count = @@ -4833,6 +4837,132 @@ getChatItemVersions db itemId = do toChatItemVersion :: (Int64, MsgContent, UTCTime, UTCTime) -> ChatItemVersion toChatItemVersion (chatItemVersionId, msgContent, itemVersionTs, createdAt) = ChatItemVersion {chatItemVersionId, msgContent, itemVersionTs, createdAt} +getDirectChatReactions_ :: DB.Connection -> Contact -> Chat 'CTDirect -> IO (Chat 'CTDirect) +getDirectChatReactions_ db ct c@Chat {chatItems} = do + chatItems' <- forM chatItems $ \(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) -> do + reactions <- maybe (pure []) (getDirectCIReactions db ct) itemSharedMsgId + pure $ CChatItem md ci {reactions} + pure c {chatItems = chatItems'} + +getGroupChatReactions_ :: DB.Connection -> GroupInfo -> Chat 'CTGroup -> IO (Chat 'CTGroup) +getGroupChatReactions_ db g@GroupInfo {membership} c@Chat {chatItems} = do + chatItems' <- forM chatItems $ \(CChatItem md ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) -> do + let GroupMember {memberId} = membership + itemMemberId = case chatDir of + CIGroupSnd -> memberId + CIGroupRcv GroupMember {memberId = mId} -> mId + reactions <- maybe (pure []) (getGroupCIReactions db g itemMemberId) itemSharedMsgId + pure $ CChatItem md ci {reactions} + pure c {chatItems = chatItems'} + +getDirectCIReactions :: DB.Connection -> Contact -> SharedMsgId -> IO [CIReactionCount] +getDirectCIReactions db Contact {contactId} itemSharedMsgId = + map toCIReaction <$> + DB.query + db + [sql| + SELECT reaction, MAX(reaction_sent), COUNT(chat_item_reaction_id) + FROM chat_item_reactions + WHERE contact_id = ? AND shared_msg_id = ? + GROUP BY reaction + |] + (contactId, itemSharedMsgId) + +getGroupCIReactions :: DB.Connection -> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount] +getGroupCIReactions db GroupInfo {groupId} itemMemberId itemSharedMsgId = + map toCIReaction <$> + DB.query + db + [sql| + SELECT reaction, MAX(reaction_sent), COUNT(chat_item_reaction_id) + FROM chat_item_reactions + WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ? + GROUP BY reaction + |] + (groupId, itemMemberId, itemSharedMsgId) + +getACIReactions :: DB.Connection -> AChatItem -> IO AChatItem +getACIReactions db aci@(AChatItem _ md chat ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of + Just itemSharedMId -> case chat of + DirectChat ct -> do + reactions <- getDirectCIReactions db ct itemSharedMId + pure $ AChatItem SCTDirect md chat ci {reactions} + GroupChat g@GroupInfo {membership = GroupMember {memberId}} -> do + let itemMemberId = case chatDir of + CIGroupSnd -> memberId + CIGroupRcv GroupMember {memberId = mId} -> mId + reactions <- getGroupCIReactions db g itemMemberId itemSharedMId + pure $ AChatItem SCTGroup md chat ci {reactions} + _ -> pure aci + _ -> pure aci + +toCIReaction :: (MsgReaction, Bool, Int) -> CIReactionCount +toCIReaction (reaction, userReacted, totalReacted) = CIReactionCount {reaction, userReacted, totalReacted} + +getDirectReactions :: DB.Connection -> Contact -> SharedMsgId -> Bool -> IO [MsgReaction] +getDirectReactions db ct itemSharedMId sent = + map fromOnly <$> + DB.query + db + [sql| + SELECT reaction + FROM chat_item_reactions + WHERE contact_id = ? AND shared_msg_id = ? AND reaction_sent = ? + |] + (contactId' ct, itemSharedMId, sent) + +setDirectReaction :: DB.Connection -> Contact -> SharedMsgId -> Bool -> MsgReaction -> Bool -> MessageId -> UTCTime -> IO () +setDirectReaction db ct itemSharedMId sent reaction add msgId reactionTs + | add = + DB.execute + db + [sql| + INSERT INTO chat_item_reactions + (contact_id, shared_msg_id, reaction_sent, reaction, created_by_msg_id, reaction_ts) + VALUES (?,?,?,?,?,?) + |] + (contactId' ct, itemSharedMId, sent, reaction, msgId, reactionTs) + | otherwise = + DB.execute + db + [sql| + DELETE FROM chat_item_reactions + WHERE contact_id = ? AND shared_msg_id = ? AND reaction_sent = ? AND reaction = ? + |] + (contactId' ct, itemSharedMId, sent, reaction) + +getGroupReactions :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> IO [MsgReaction] +getGroupReactions db GroupInfo {groupId} m itemMemberId itemSharedMId sent = + map fromOnly <$> + DB.query + db + [sql| + SELECT reaction + FROM chat_item_reactions + WHERE group_id = ? AND group_member_id = ? AND item_member_id = ? AND shared_msg_id = ? AND reaction_sent = ? + |] + (groupId, groupMemberId' m, itemMemberId, itemSharedMId, sent) + +setGroupReaction :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> MsgReaction -> Bool -> MessageId -> UTCTime -> IO () +setGroupReaction db GroupInfo {groupId} m itemMemberId itemSharedMId sent reaction add msgId reactionTs + | add = + DB.execute + db + [sql| + INSERT INTO chat_item_reactions + (group_id, group_member_id, item_member_id, shared_msg_id, reaction_sent, reaction, created_by_msg_id, reaction_ts) + VALUES (?,?,?,?,?,?,?,?) + |] + (groupId, groupMemberId' m, itemMemberId, itemSharedMId, sent, reaction, msgId, reactionTs) + | otherwise = + DB.execute + db + [sql| + DELETE FROM chat_item_reactions + WHERE group_id = ? AND group_member_id = ? AND shared_msg_id = ? AND item_member_id = ? AND reaction_sent = ? AND reaction = ? + |] + (groupId, groupMemberId' m, itemSharedMId, itemMemberId, sent, reaction) + updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem updateDirectCIFileStatus db user fileId fileStatus = do aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId @@ -5001,7 +5131,7 @@ toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemConte _ -> Nothing cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect cItem d chatDir ciStatus content file = - CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file} + CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, reactions = [], file} badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d ciMeta content status = @@ -5054,7 +5184,7 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgD _ -> Nothing cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTGroup cItem d chatDir ciStatus content file = - CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file} + CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, reactions = [], file} badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d ciMeta content status = diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index a422a8db7e..719b77b73c 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -322,7 +322,7 @@ updateTermState user_ st ac live tw (key, ms) ts@TerminalState {inputString = s, go _ _ = "" charsWithContact cs | live = cs - | null s && cs /= "@" && cs /= "#" && cs /= "/" && cs /= ">" && cs /= "\\" && cs /= "!" = + | null s && cs /= "@" && cs /= "#" && cs /= "/" && cs /= ">" && cs /= "\\" && cs /= "!" && cs /= "+" && cs /= "-" = contactPrefix <> cs | (s == ">" || s == "\\" || s == "!") && cs == " " = cs <> contactPrefix diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index 94d76b8a32..ce68d715fe 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -122,8 +122,8 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d liveItems <- readTVarIO showLiveItems responseString cc liveItems r >>= printResp where - markChatItemRead (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) = - case (muted chat item, itemStatus) of + markChatItemRead (AChatItem _ _ chat item@ChatItem {chatDir, meta = CIMeta {itemStatus}}) = + case (muted chat chatDir, itemStatus) of (False, CISRcvNew) -> do let itemId = chatItemId' item chatRef = chatInfoToRef chat diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 0999998861..fbfe7830bc 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -349,13 +349,15 @@ data ChatFeature = CFTimedMessages | CFFullDelete | -- | CFReceipts - CFVoice + CFReactions + | CFVoice | CFCalls deriving (Show, Generic) data SChatFeature (f :: ChatFeature) where SCFTimedMessages :: SChatFeature 'CFTimedMessages SCFFullDelete :: SChatFeature 'CFFullDelete + SCFReactions :: SChatFeature 'CFReactions SCFVoice :: SChatFeature 'CFVoice SCFCalls :: SChatFeature 'CFCalls @@ -369,6 +371,7 @@ chatFeatureNameText :: ChatFeature -> Text chatFeatureNameText = \case CFTimedMessages -> "Disappearing messages" CFFullDelete -> "Full deletion" + CFReactions -> "Message reactions" CFVoice -> "Voice messages" CFCalls -> "Audio/video calls" @@ -391,7 +394,8 @@ allChatFeatures :: [AChatFeature] allChatFeatures = [ ACF SCFTimedMessages, ACF SCFFullDelete, - -- CFReceipts, + -- ACF SCFReceipts, + ACF SCFReactions, ACF SCFVoice, ACF SCFCalls ] @@ -400,7 +404,8 @@ chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f) chatPrefSel = \case SCFTimedMessages -> timedMessages SCFFullDelete -> fullDelete - -- CFReceipts -> receipts + -- SCFReceipts -> receipts + SCFReactions -> reactions SCFVoice -> voice SCFCalls -> calls @@ -408,6 +413,7 @@ chatFeature :: SChatFeature f -> ChatFeature chatFeature = \case SCFTimedMessages -> CFTimedMessages SCFFullDelete -> CFFullDelete + SCFReactions -> CFReactions SCFVoice -> CFVoice SCFCalls -> CFCalls @@ -425,6 +431,7 @@ instance PreferenceI FullPreferences where SCFTimedMessages -> timedMessages SCFFullDelete -> fullDelete -- CFReceipts -> receipts + SCFReactions -> reactions SCFVoice -> voice SCFCalls -> calls {-# INLINE getPreference #-} @@ -445,6 +452,7 @@ setPreference_ f pref_ prefs = case f of SCFTimedMessages -> prefs {timedMessages = pref_} SCFFullDelete -> prefs {fullDelete = pref_} + SCFReactions -> prefs {reactions = pref_} SCFVoice -> prefs {voice = pref_} SCFCalls -> prefs {calls = pref_} @@ -453,6 +461,7 @@ data Preferences = Preferences { timedMessages :: Maybe TimedMessagesPreference, fullDelete :: Maybe FullDeletePreference, -- receipts :: Maybe SimplePreference, + reactions :: Maybe ReactionsPreference, voice :: Maybe VoicePreference, calls :: Maybe CallsPreference } @@ -473,14 +482,16 @@ data GroupFeature | GFDirectMessages | GFFullDelete | -- | GFReceipts - GFVoice + GFReactions + | GFVoice deriving (Show, Generic) data SGroupFeature (f :: GroupFeature) where SGFTimedMessages :: SGroupFeature 'GFTimedMessages SGFDirectMessages :: SGroupFeature 'GFDirectMessages SGFFullDelete :: SGroupFeature 'GFFullDelete - -- SGFReceipts + -- SGFReceipts :: SGroupFeature 'GFReceipts + SGFReactions :: SGroupFeature 'GFReactions SGFVoice :: SGroupFeature 'GFVoice deriving instance Show (SGroupFeature f) @@ -494,6 +505,7 @@ groupFeatureNameText = \case GFTimedMessages -> "Disappearing messages" GFDirectMessages -> "Direct messages" GFFullDelete -> "Full deletion" + GFReactions -> "Message reactions" GFVoice -> "Voice messages" groupFeatureNameText' :: SGroupFeature f -> Text @@ -519,6 +531,7 @@ allGroupFeatures = AGF SGFDirectMessages, AGF SGFFullDelete, -- GFReceipts, + AGF SGFReactions, AGF SGFVoice ] @@ -528,6 +541,7 @@ groupPrefSel = \case SGFDirectMessages -> directMessages SGFFullDelete -> fullDelete -- GFReceipts -> receipts + SGFReactions -> reactions SGFVoice -> voice toGroupFeature :: SGroupFeature f -> GroupFeature @@ -535,6 +549,7 @@ toGroupFeature = \case SGFTimedMessages -> GFTimedMessages SGFDirectMessages -> GFDirectMessages SGFFullDelete -> GFFullDelete + SGFReactions -> GFReactions SGFVoice -> GFVoice class GroupPreferenceI p where @@ -552,6 +567,7 @@ instance GroupPreferenceI FullGroupPreferences where SGFDirectMessages -> directMessages SGFFullDelete -> fullDelete -- GFReceipts -> receipts + SGFReactions -> reactions SGFVoice -> voice {-# INLINE getGroupPreference #-} @@ -561,6 +577,7 @@ data GroupPreferences = GroupPreferences directMessages :: Maybe DirectMessagesGroupPreference, fullDelete :: Maybe FullDeleteGroupPreference, -- receipts :: Maybe GroupPreference, + reactions :: Maybe ReactionsGroupPreference, voice :: Maybe VoiceGroupPreference } deriving (Eq, Show, Generic, FromJSON) @@ -592,6 +609,7 @@ setGroupPreference_ f pref prefs = toGroupPreferences $ case f of SGFTimedMessages -> prefs {timedMessages = pref} SGFDirectMessages -> prefs {directMessages = pref} + SGFReactions -> prefs {reactions = pref} SGFVoice -> prefs {voice = pref} SGFFullDelete -> prefs {fullDelete = pref} @@ -607,6 +625,7 @@ data FullPreferences = FullPreferences { timedMessages :: TimedMessagesPreference, fullDelete :: FullDeletePreference, -- receipts :: SimplePreference, + reactions :: ReactionsPreference, voice :: VoicePreference, calls :: CallsPreference } @@ -621,6 +640,7 @@ data FullGroupPreferences = FullGroupPreferences directMessages :: DirectMessagesGroupPreference, fullDelete :: FullDeleteGroupPreference, -- receipts :: GroupPreference, + reactions :: ReactionsGroupPreference, voice :: VoiceGroupPreference } deriving (Eq, Show, Generic, FromJSON) @@ -632,6 +652,7 @@ data ContactUserPreferences = ContactUserPreferences { timedMessages :: ContactUserPreference TimedMessagesPreference, fullDelete :: ContactUserPreference FullDeletePreference, -- receipts :: ContactUserPreference, + reactions :: ContactUserPreference ReactionsPreference, voice :: ContactUserPreference VoicePreference, calls :: ContactUserPreference CallsPreference } @@ -656,11 +677,12 @@ instance ToJSON p => ToJSON (ContactUserPref p) where toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP" toChatPrefs :: FullPreferences -> Preferences -toChatPrefs FullPreferences {fullDelete, voice, timedMessages, calls} = +toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} = Preferences { timedMessages = Just timedMessages, fullDelete = Just fullDelete, -- receipts = Just receipts, + reactions = Just reactions, voice = Just voice, calls = Just calls } @@ -671,12 +693,13 @@ defaultChatPrefs = { timedMessages = TimedMessagesPreference {allow = FAYes, ttl = Nothing}, fullDelete = FullDeletePreference {allow = FANo}, -- receipts = SimplePreference {allow = FANo}, + reactions = ReactionsPreference {allow = FAYes}, voice = VoicePreference {allow = FAYes}, calls = CallsPreference {allow = FAYes} } emptyChatPrefs :: Preferences -emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing +emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing defaultGroupPrefs :: FullGroupPreferences defaultGroupPrefs = @@ -685,11 +708,12 @@ defaultGroupPrefs = directMessages = DirectMessagesGroupPreference {enable = FEOff}, fullDelete = FullDeleteGroupPreference {enable = FEOff}, -- receipts = GroupPreference {enable = FEOff}, + reactions = ReactionsGroupPreference {enable = FEOn}, voice = VoiceGroupPreference {enable = FEOn} } emptyGroupPrefs :: GroupPreferences -emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing +emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing data TimedMessagesPreference = TimedMessagesPreference { allow :: FeatureAllowed, @@ -706,6 +730,11 @@ data FullDeletePreference = FullDeletePreference {allow :: FeatureAllowed} instance ToJSON FullDeletePreference where toEncoding = J.genericToEncoding J.defaultOptions +data ReactionsPreference = ReactionsPreference {allow :: FeatureAllowed} + deriving (Eq, Show, Generic, FromJSON) + +instance ToJSON ReactionsPreference where toEncoding = J.genericToEncoding J.defaultOptions + data VoicePreference = VoicePreference {allow :: FeatureAllowed} deriving (Eq, Show, Generic, FromJSON) @@ -727,6 +756,9 @@ instance HasField "allow" TimedMessagesPreference FeatureAllowed where instance HasField "allow" FullDeletePreference FeatureAllowed where hasField p = (\allow -> p {allow}, allow (p :: FullDeletePreference)) +instance HasField "allow" ReactionsPreference FeatureAllowed where + hasField p = (\allow -> p {allow}, allow (p :: ReactionsPreference)) + instance HasField "allow" VoicePreference FeatureAllowed where hasField p = (\allow -> p {allow}, allow (p :: VoicePreference)) @@ -743,6 +775,11 @@ instance FeatureI 'CFFullDelete where sFeature = SCFFullDelete prefParam _ = Nothing +instance FeatureI 'CFReactions where + type FeaturePreference 'CFReactions = ReactionsPreference + sFeature = SCFReactions + prefParam _ = Nothing + instance FeatureI 'CFVoice where type FeaturePreference 'CFVoice = VoicePreference sFeature = SCFVoice @@ -771,6 +808,10 @@ data FullDeleteGroupPreference = FullDeleteGroupPreference {enable :: GroupFeatureEnabled} deriving (Eq, Show, Generic, FromJSON) +data ReactionsGroupPreference = ReactionsGroupPreference + {enable :: GroupFeatureEnabled} + deriving (Eq, Show, Generic, FromJSON) + data VoiceGroupPreference = VoiceGroupPreference {enable :: GroupFeatureEnabled} deriving (Eq, Show, Generic, FromJSON) @@ -781,6 +822,8 @@ instance ToJSON TimedMessagesGroupPreference where toEncoding = J.genericToEncod instance ToJSON DirectMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions +instance ToJSON ReactionsGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions + instance ToJSON FullDeleteGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions @@ -799,6 +842,9 @@ instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled wher instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where hasField p = (\enable -> p {enable}, enable (p :: DirectMessagesGroupPreference)) +instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where + hasField p = (\enable -> p {enable}, enable (p :: ReactionsGroupPreference)) + instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where hasField p = (\enable -> p {enable}, enable (p :: FullDeleteGroupPreference)) @@ -820,6 +866,11 @@ instance GroupFeatureI 'GFFullDelete where sGroupFeature = SGFFullDelete groupPrefParam _ = Nothing +instance GroupFeatureI 'GFReactions where + type GroupFeaturePreference 'GFReactions = ReactionsGroupPreference + sGroupFeature = SGFReactions + groupPrefParam _ = Nothing + instance GroupFeatureI 'GFVoice where type GroupFeaturePreference 'GFVoice = VoiceGroupPreference sGroupFeature = SGFVoice @@ -930,6 +981,7 @@ mergePreferences contactPrefs userPreferences = { timedMessages = pref SCFTimedMessages, fullDelete = pref SCFFullDelete, -- receipts = pref CFReceipts, + reactions = pref SCFReactions, voice = pref SCFVoice, calls = pref SCFCalls } @@ -954,6 +1006,7 @@ mergeGroupPreferences groupPreferences = directMessages = pref SGFDirectMessages, fullDelete = pref SGFFullDelete, -- receipts = pref GFReceipts, + reactions = pref SGFReactions, voice = pref SGFVoice } where @@ -967,6 +1020,7 @@ toGroupPreferences groupPreferences = directMessages = pref SGFDirectMessages, fullDelete = pref SGFFullDelete, -- receipts = pref GFReceipts, + reactions = pref SGFReactions, voice = pref SGFVoice } where @@ -1044,6 +1098,7 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit { timedMessages = pref SCFTimedMessages, fullDelete = pref SCFFullDelete, -- receipts = pref CFReceipts, + reactions = pref SCFReactions, voice = pref SCFVoice, calls = pref SCFCalls } @@ -1071,6 +1126,7 @@ getContactUserPreference = \case SCFTimedMessages -> timedMessages SCFFullDelete -> fullDelete -- CFReceipts -> receipts + SCFReactions -> reactions SCFVoice -> voice SCFCalls -> calls diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index e64d70aa38..8989481a09 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -61,7 +61,7 @@ serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse - serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString] -responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case +responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts tz = \case CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile CRUsersList users -> viewUsersList users CRChatStarted -> ["chat started"] @@ -83,14 +83,17 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case 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 - CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts - CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems + CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts <> viewItemReactions item + CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts <> viewItemReactions item) chatItems CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId] CRChatItemStatusUpdated u _ -> ttyUser u [] CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts testView + CRChatItemReaction u (ACIReaction _ _ chat reaction) added + | showReactions -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction chat reaction added ts tz + | otherwise -> [] CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"] CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts t CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr @@ -141,7 +144,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"] CRRcvFileDescrReady _ _ -> [] CRRcvFileDescrNotReady _ _ -> [] - CRRcvFileProgressXFTP _ _ _ _ -> [] + CRRcvFileProgressXFTP {} -> [] CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts @@ -299,8 +302,12 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case contactList :: [ContactRef] -> String contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs unmuted :: ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString] - unmuted chat chatItem s - | muted chat chatItem = [] + unmuted chat ChatItem {chatDir} = unmuted' chat chatDir + unmutedReaction :: ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString] + unmutedReaction chat CIReaction {chatDir} = unmuted' chat chatDir + unmuted' :: ChatInfo c -> CIDirection c d -> [StyledString] -> [StyledString] + unmuted' chat chatDir s + | muted chat chatDir = [] | otherwise = s chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text @@ -330,8 +337,8 @@ viewUsersList = mapMaybe userInfo . sortOn ldn <> ["muted" | not showNtfs] <> [plain ("unread: " <> show count) | count /= 0] -muted :: ChatInfo c -> ChatItem c d -> Bool -muted chat ChatItem {chatDir} = case (chat, chatDir) of +muted :: ChatInfo c -> CIDirection c d -> Bool +muted chat chatDir = case (chat, chatDir) of (DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True (GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> True _ -> False @@ -504,6 +511,38 @@ viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} toItem by Just (AChatItem _ _ _ ci) -> chatItemDeletedText ci $ chatInfoMembership chat prohibited = [styled (colored Red) ("[unexpected message deletion, please report to developers]" :: String)] +viewItemReaction :: forall c d. ChatInfo c -> CIReaction c d -> Bool -> CurrentTime -> TimeZone -> [StyledString] +viewItemReaction chat CIReaction {chatDir, chatItem = CChatItem md ChatItem {chatDir = itemDir, content}, sentAt, reaction} added ts tz = + case (chat, chatDir) of + (DirectChat c, CIDirectRcv) -> case content of + CIRcvMsgContent mc -> view from $ reactionMsg mc + CISndMsgContent mc -> view from $ reactionMsg mc + _ -> [] + where + from = ttyFromContact c + reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then ">>" else ">" + (GroupChat g, CIGroupRcv m) -> case content of + CIRcvMsgContent mc -> view from $ reactionMsg mc + CISndMsgContent mc -> view from $ reactionMsg mc + _ -> [] + where + from = ttyFromGroup g m + reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir + (_, CIDirectSnd) -> [sentText] + (_, CIGroupSnd) -> [sentText] + where + view from msg = viewReceivedReaction from msg reactionText ts $ utcToZonedTime tz sentAt + reactionText = plain $ (if added then "+ " else "- ") <> [emoji] + MREmoji (MREmojiChar emoji) = reaction + sentText = plain $ (if added then "added " else "removed ") <> [emoji] + +viewItemReactions :: ChatItem c d -> [StyledString] +viewItemReactions ChatItem {reactions} = [" " <> viewReactions reactions | not (null reactions)] + where + viewReactions = mconcat . intersperse " " . map viewReaction + viewReaction CIReactionCount {reaction = MREmoji (MREmojiChar emoji), userReacted, totalReacted} = + plain [emoji, ' '] <> (if userReacted then styled Italic else plain) (show totalReacted) + directQuote :: forall d'. MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [StyledString] directQuote _ CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc $ if toMsgDirection (msgDirection @d') == quoteMsgDirection quoteDir then ">>" else ">" @@ -516,6 +555,11 @@ sentByMember GroupInfo {membership} = \case CIQGroupSnd -> Just membership CIQGroupRcv m -> m +sentByMember' :: GroupInfo -> CIDirection 'CTGroup d -> GroupMember +sentByMember' GroupInfo {membership} = \case + CIGroupSnd -> membership + CIGroupRcv m -> m + quoteText :: MsgContent -> StyledString -> [StyledString] quoteText qmc sentBy = prependFirst (sentBy <> " ") $ msgPreview qmc @@ -1037,6 +1081,10 @@ viewReceivedUpdatedMessage = viewReceivedMessage_ True viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> CIMeta c d -> [StyledString] viewReceivedMessage_ updated from quote mc ts meta = receivedWithTime_ ts from quote meta (ttyMsgContent mc) updated +viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> ZonedTime -> [StyledString] +viewReceivedReaction from styledMsg reactionText ts reactionTs = + prependFirst (ttyMsgTime ts reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText]) + receivedWithTime_ :: CurrentTime -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString] receivedWithTime_ ts from quote CIMeta {localItemTs, itemId, itemEdited, itemDeleted, itemLive} styledMsg updated = do prependFirst (ttyMsgTime ts localItemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg) diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 097f6aed80..8359e72e33 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -72,6 +72,7 @@ testOpts = chatCmdDelay = 3, chatServerPort = Nothing, optFilesFolder = Nothing, + showReactions = True, allowInstantFiles = True, muteNotifications = True, maintenance = False diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 96400585c3..67f6171a1d 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -85,6 +85,8 @@ chatDirectTests = do it "mark group member verified" testMarkGroupMemberVerified describe "message errors" $ do xit "show message decryption error and update count" testMsgDecryptError + describe "message reactions" $ do + it "set message reactions" testSetMessageReactions testAddContact :: HasCallStack => SpecWith FilePath testAddContact = versionTestMatrix2 runTestAddContact @@ -421,13 +423,13 @@ testDirectLiveMessage = connectUsers alice bob -- non-empty live message is sent instantly alice `send` "/live @bob hello" - bob <# "alice> [LIVE started] use /show [on/off/5] hello" + bob <# "alice> [LIVE started] use /show [on/off/6] hello" alice ##> ("/_update item @2 " <> itemId 1 <> " text hello there") alice <# "@bob [LIVE] hello there" bob <# "alice> [LIVE ended] hello there" -- empty live message is also sent instantly alice `send` "/live @bob" - bob <# "alice> [LIVE started] use /show [on/off/6]" + bob <# "alice> [LIVE started] use /show [on/off/7]" alice ##> ("/_update item @2 " <> itemId 2 <> " text hello 2") alice <# "@bob [LIVE] hello 2" bob <# "alice> [LIVE ended] hello 2" @@ -1691,14 +1693,15 @@ testUserPrivacy = alice <##? chatHistory alice ##> "/_get items count=10" alice <##? chatHistory - alice ##> "/_get items before=9 count=10" + alice ##> "/_get items before=11 count=10" alice <##? [ "bob> Disappearing messages: allowed", "bob> Full deletion: off", + "bob> Message reactions: enabled", "bob> Voice messages: enabled", "bob> Audio/video calls: enabled" ] - alice ##> "/_get items after=8 count=10" + alice ##> "/_get items after=10 count=10" alice <##? [ "@bob hello", "bob> hey", @@ -1756,6 +1759,7 @@ testUserPrivacy = chatHistory = [ "bob> Disappearing messages: allowed", "bob> Full deletion: off", + "bob> Message reactions: enabled", "bob> Voice messages: enabled", "bob> Audio/video calls: enabled", "@bob hello", @@ -1938,3 +1942,51 @@ testMsgDecryptError tmp = copyDb from to = do copyFile (chatStoreFile $ tmp from) (chatStoreFile $ tmp to) copyFile (agentStoreFile $ tmp from) (agentStoreFile $ tmp to) + +testSetMessageReactions :: HasCallStack => FilePath -> IO () +testSetMessageReactions = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice #> "@bob hi" + bob <# "alice> hi" + bob ##> "+1 alice hi" + bob <## "added 👍" + alice <# "bob> >> hi" + alice <## " + 👍" + bob ##> "+1 alice hi" + bob <## "bad chat command: reaction already added" + bob ##> "+^ alice hi" + bob <## "added 🚀" + alice <# "bob> >> hi" + alice <## " + 🚀" + alice ##> "/tail @bob 1" + alice <# "@bob hi" + alice <## " 👍 1 🚀 1" + bob ##> "/tail @alice 1" + bob <# "alice> hi" + bob <## " 👍 1 🚀 1" + alice ##> "+1 bob hi" + alice <## "added 👍" + bob <# "alice> > hi" + bob <## " + 👍" + alice ##> "/tail @bob 1" + alice <# "@bob hi" + alice <## " 👍 2 🚀 1" + bob ##> "/tail @alice 1" + bob <# "alice> hi" + bob <## " 👍 2 🚀 1" + bob ##> "-1 alice hi" + bob <## "removed 👍" + alice <# "bob> >> hi" + alice <## " - 👍" + bob ##> "-^ alice hi" + bob <## "removed 🚀" + alice <# "bob> >> hi" + alice <## " - 🚀" + alice ##> "/tail @bob 1" + alice <# "@bob hi" + alice <## " 👍 1" + bob ##> "/tail @alice 1" + bob <# "alice> hi" + bob <## " 👍 1" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 79af235cd6..3319ef8486 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -54,6 +54,8 @@ chatGroupTests = do it "leaving and deleting the group joined via link should NOT delete previously existing direct contacts" testGroupLinkLeaveDelete describe "group message errors" $ do xit "show message decryption error and update count" testGroupMsgDecryptError + describe "message reactions" $ do + it "set group message reactions" testSetGroupMessageReactions testGroup :: HasCallStack => SpecWith FilePath testGroup = versionTestMatrix3 runTestGroup @@ -1289,6 +1291,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile alice <## "Disappearing messages: off" alice <## "Direct messages: on" alice <## "Full deletion: off" + alice <## "Message reactions: on" alice <## "Voice messages: on" bobAddedDan :: HasCallStack => TestCC -> IO () bobAddedDan cc = do @@ -2155,3 +2158,72 @@ testGroupMsgDecryptError tmp = copyDb from to = do copyFile (chatStoreFile $ tmp from) (chatStoreFile $ tmp to) copyFile (agentStoreFile $ tmp from) (agentStoreFile $ tmp to) + +testSetGroupMessageReactions :: HasCallStack => FilePath -> IO () +testSetGroupMessageReactions = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath + threadDelay 1000000 + alice #> "#team hi" + bob <# "#team alice> hi" + cath <# "#team alice> hi" + bob ##> "+1 #team hi" + bob <## "added 👍" + alice <# "#team bob> > alice hi" + alice <## " + 👍" + cath <# "#team bob> > alice hi" + cath <## " + 👍" + bob ##> "+1 #team hi" + bob <## "bad chat command: reaction already added" + bob ##> "+^ #team hi" + bob <## "added 🚀" + alice <# "#team bob> > alice hi" + alice <## " + 🚀" + cath <# "#team bob> > alice hi" + cath <## " + 🚀" + alice ##> "/tail #team 1" + alice <# "#team hi" + alice <## " 👍 1 🚀 1" + bob ##> "/tail #team 1" + bob <# "#team alice> hi" + bob <## " 👍 1 🚀 1" + bob ##> "/tail #team 1" + bob <# "#team alice> hi" + bob <## " 👍 1 🚀 1" + alice ##> "+1 #team hi" + alice <## "added 👍" + bob <# "#team alice> > alice hi" + bob <## " + 👍" + cath <# "#team alice> > alice hi" + cath <## " + 👍" + alice ##> "/tail #team 1" + alice <# "#team hi" + alice <## " 👍 2 🚀 1" + bob ##> "/tail #team 1" + bob <# "#team alice> hi" + bob <## " 👍 2 🚀 1" + cath ##> "/tail #team 1" + cath <# "#team alice> hi" + cath <## " 👍 2 🚀 1" + bob ##> "-1 #team hi" + bob <## "removed 👍" + alice <# "#team bob> > alice hi" + alice <## " - 👍" + cath <# "#team bob> > alice hi" + cath <## " - 👍" + bob ##> "-^ #team hi" + bob <## "removed 🚀" + alice <# "#team bob> > alice hi" + alice <## " - 🚀" + cath <# "#team bob> > alice hi" + cath <## " - 🚀" + alice ##> "/tail #team 1" + alice <# "#team hi" + alice <## " 👍 1" + bob ##> "/tail #team 1" + bob <# "#team alice> hi" + bob <## " 👍 1" + cath ##> "/tail #team 1" + cath <# "#team alice> hi" + cath <## " 👍 1" diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 6bbd4b1447..ccb638fb18 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1054,7 +1054,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $ alice ##> "/_set prefs @2 {}" alice <## "your preferences for bob did not change" (bob ("/_get chat @2 count=100", chat, startFeatures) bob #$> ("/_get chat @2 count=100", chat, startFeatures) let sendVoice = "/_send @2 json {\"filePath\": \"test.txt\", \"msgContent\": {\"type\": \"voice\", \"text\": \"\", \"duration\": 10}}" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 5abfbb0136..5b9a993486 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -183,7 +183,13 @@ chatFeaturesF :: [((Int, String), Maybe String)] chatFeaturesF = map (\(a, _, c) -> (a, c)) chatFeatures'' chatFeatures'' :: [((Int, String), Maybe (Int, String), Maybe String)] -chatFeatures'' = [((0, "Disappearing messages: allowed"), Nothing, Nothing), ((0, "Full deletion: off"), Nothing, Nothing), ((0, "Voice messages: enabled"), Nothing, Nothing), ((0, "Audio/video calls: enabled"), Nothing, Nothing)] +chatFeatures'' = + [ ((0, "Disappearing messages: allowed"), Nothing, Nothing), + ((0, "Full deletion: off"), Nothing, Nothing), + ((0, "Message reactions: enabled"), Nothing, Nothing), + ((0, "Voice messages: enabled"), Nothing, Nothing), + ((0, "Audio/video calls: enabled"), Nothing, Nothing) + ] lastChatFeature :: String lastChatFeature = snd $ last chatFeatures @@ -192,7 +198,13 @@ groupFeatures :: [(Int, String)] groupFeatures = map (\(a, _, _) -> a) groupFeatures'' groupFeatures'' :: [((Int, String), Maybe (Int, String), Maybe String)] -groupFeatures'' = [((0, "Disappearing messages: off"), Nothing, Nothing), ((0, "Direct messages: on"), Nothing, Nothing), ((0, "Full deletion: off"), Nothing, Nothing), ((0, "Voice messages: on"), Nothing, Nothing)] +groupFeatures'' = + [ ((0, "Disappearing messages: off"), Nothing, Nothing), + ((0, "Direct messages: on"), Nothing, Nothing), + ((0, "Full deletion: off"), Nothing, Nothing), + ((0, "Message reactions: on"), Nothing, Nothing), + ((0, "Voice messages: on"), Nothing, Nothing) + ] itemId :: Int -> String itemId i = show $ length chatFeatures + i diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 92119aa8fb..339dee6bb2 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -33,9 +33,9 @@ activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1 activeUser :: String #if defined(darwin_HOST_OS) && defined(swiftJSON) -activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}}" +activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}}" #else -activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}" +activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}" #endif chatStarted :: String diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index dcc7e88c9f..601f136615 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -86,10 +86,10 @@ s #==# msg = do s ==# msg testChatPreferences :: Maybe Preferences -testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing} +testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}} testGroupPreferences :: Maybe GroupPreferences -testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, voice = Just VoiceGroupPreference {enable = FEOn}, fullDelete = Nothing} +testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, fullDelete = Nothing} testProfile :: Profile testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), contactLink = Nothing, preferences = testChatPreferences} @@ -194,46 +194,46 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}" #==# XFileCancel (SharedMsgId "\1\2\3\4") it "x.info" $ - "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XInfo testProfile it "x.info with empty full name" $ - "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XInfo Profile {displayName = "alice", fullName = "", image = Nothing, contactLink = Nothing, preferences = testChatPreferences} it "x.contact with xContactId" $ - "{\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XContact testProfile (Just $ XContactId "\1\2\3\4") it "x.contact without XContactId" $ - "{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XContact testProfile Nothing it "x.contact with content null" $ - "{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" ==# XContact testProfile Nothing it "x.contact with content (ignored)" $ - "{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" ==# XContact testProfile Nothing it "x.grp.inv" $ - "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" + "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Nothing} it "x.grp.inv with group link id" $ - "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" + "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Just $ GroupLinkId "\1\2\3\4"} it "x.grp.acpt without incognito profile" $ "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4") it "x.grp.mem.new" $ - "{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} it "x.grp.mem.intro" $ - "{\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} it "x.grp.mem.inv" $ "{\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq} it "x.grp.mem.fwd" $ - "{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq} it "x.grp.mem.info" $ - "{\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}" + "{\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile it "x.grp.mem.con" $ "{\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}"