diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index a685be571..66fac0bdd 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -177,36 +177,43 @@ processChatCommand = \case APISendMessage cType chatId mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of CTDirect -> do ct <- withStore $ \st -> getContact st userId chatId - sendNewMsg user ct (MCSimple mc) mc + sendNewMsg user ct (MCSimple mc) mc Nothing CTGroup -> do group@(Group GroupInfo {membership} _) <- withStore $ \st -> getGroup st user chatId unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved - sendNewGroupMsg user group (MCSimple mc) mc + sendNewGroupMsg user group (MCSimple mc) mc Nothing CTContactRequest -> pure $ chatCmdError "not supported" APISendMessageQuote cType chatId quotedItemId mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of CTDirect -> do - (ct, ci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId quotedItemId - case ci of - CChatItem _ (ChatItem {meta, content}) -> do - let CIMeta {itemTs, itemSharedMsgId} = meta - (qmc, sent) <- case content of - CISndMsgContent qmc -> pure (qmc, True) - CIRcvMsgContent qmc -> pure (qmc, False) + (ct, qci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId quotedItemId + case qci of + CChatItem _ (ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText}) -> do + case ciContent of + CISndMsgContent qmc -> send_ CIQDirectSnd True qmc + CIRcvMsgContent qmc -> send_ CIQDirectRcv False qmc _ -> throwChatError CEInvalidQuote - let msgRef = MsgRefDirect {msgId = itemSharedMsgId, sentAt = itemTs, sent} - sendNewMsg user ct (MCQuote QuotedMsg {msgRef, content = qmc} mc) mc + where + send_ :: CIQDirection 'CTDirect -> Bool -> MsgContent -> m ChatResponse + send_ chatDir sent qmc = + let quotedItem = CIQuote {chatDir, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} + msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing} + in sendNewMsg user ct (MCQuote QuotedMsg {msgRef, content = qmc} mc) mc (Just quotedItem) CTGroup -> do group@(Group GroupInfo {membership} _) <- withStore $ \st -> getGroup st user chatId unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved - withStore (\st -> getGroupChatItem st user chatId quotedItemId) >>= \case - CChatItem _ (ChatItem {chatDir, meta, content}) -> do - let CIMeta {itemTs, itemSharedMsgId} = meta - (qmc, GroupMember {memberId}) <- case (content, chatDir) of - (CISndMsgContent qmc, _) -> pure (qmc, membership) - (CIRcvMsgContent qmc, CIGroupRcv m) -> pure (qmc, m) + qci <- withStore $ \st -> getGroupChatItem st user chatId quotedItemId + case qci of + CChatItem _ (ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText}) -> do + case (ciContent, chatDir) of + (CISndMsgContent qmc, _) -> send_ CIQGroupSnd True membership qmc + (CIRcvMsgContent qmc, CIGroupRcv m) -> send_ (CIQGroupRcv $ Just m) False m qmc _ -> throwChatError CEInvalidQuote - let msgRef = MsgRefGroup {msgId = itemSharedMsgId, sentAt = itemTs, memberId} - sendNewGroupMsg user group (MCQuote QuotedMsg {msgRef, content = qmc} mc) mc + where + send_ :: CIQDirection 'CTGroup -> Bool -> GroupMember -> MsgContent -> m ChatResponse + send_ qd sent GroupMember {memberId} content = + let quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content, formattedText} + msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId} + in sendNewGroupMsg user group (MCQuote QuotedMsg {msgRef, content} mc) mc (Just quotedItem) CTContactRequest -> pure $ chatCmdError "not supported" APIChatRead cType chatId fromToIds -> withChatLock $ case cType of CTDirect -> withStore (\st -> updateDirectChatItemsRead st chatId fromToIds) $> CRCmdOk @@ -378,7 +385,7 @@ processChatCommand = \case let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq} SndFileTransfer {fileId} <- withStore $ \st -> createSndFileTransfer st userId contact f fileInv agentConnId chSize - ci <- sendDirectChatItem user contact (XFile fileInv) (CISndFileInvitation fileId f) + ci <- sendDirectChatItem user contact (XFile fileInv) (CISndFileInvitation fileId f) Nothing withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci setActive $ ActiveC cName pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci @@ -395,12 +402,10 @@ processChatCommand = \case forM_ ms $ \(m, _, fileInv) -> traverse (\conn -> sendDirectMessage conn (XFile fileInv) (GroupId groupId)) $ memberConn m setActive $ ActiveG gName - createdAt <- liftIO getCurrentTime -- this is a hack as we have multiple direct messages instead of one per group - let msg = Message {msgId = 0, direction = MDSnd, chatMsgEvent = XOk, sharedMsgId_ = Nothing, msgBody = ""} + let msg = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = ""} ciContent = CISndFileInvitation fileId f - ci = mkNewChatItem ciContent msg createdAt createdAt - cItem@ChatItem {meta = CIMeta {itemId}} <- saveChatItem user (CDGroupSnd gInfo) ci + cItem@ChatItem {meta = CIMeta {itemId}} <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent Nothing withStore $ \st -> updateFileTransferChatItemId st fileId itemId pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) cItem ReceiveFile fileId filePath_ -> withUser $ \User {userId} -> do @@ -463,15 +468,14 @@ processChatCommand = \case connId <- withAgent $ \a -> joinConnection a cReq $ directMessage (XContact profile $ Just xContactId) withStore $ \st -> createConnReqConnection st userId connId cReqHash xContactId pure CRSentInvitation - sendNewMsg user ct@Contact {localDisplayName = c} msgContainer mc = do - ci <- sendDirectChatItem user ct (XMsgNew msgContainer) (CISndMsgContent mc) + sendNewMsg user ct@Contact {localDisplayName = c} msgContainer mc quotedItem = do + ci <- sendDirectChatItem user ct (XMsgNew msgContainer) (CISndMsgContent mc) quotedItem setActive $ ActiveC c pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci - sendNewGroupMsg user g@(Group gInfo@GroupInfo {localDisplayName = gName} _) msgContainer mc = do - ci <- sendGroupChatItem user g (XMsgNew msgContainer) (CISndMsgContent mc) + sendNewGroupMsg user g@(Group gInfo@GroupInfo {localDisplayName = gName} _) msgContainer mc quotedItem = do + ci <- sendGroupChatItem user g (XMsgNew msgContainer) (CISndMsgContent mc) quotedItem setActive $ ActiveG gName pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci - contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> @@ -675,7 +679,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage _ -> pure () Just ct@Contact {localDisplayName = c, contactId} -> case agentMsg of MSG msgMeta msgBody -> do - msg@Message {chatMsgEvent} <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody + msg@RcvMessage {chatMsgEvent} <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody withAckMessage agentConnId msgMeta $ case chatMsgEvent of XMsgNew mc -> newContentMessage ct mc msg msgMeta @@ -814,7 +818,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage notifyMemberConnected gInfo m when (memberCategory m == GCPreMember) $ probeMatchingContacts ct MSG msgMeta msgBody -> do - msg@Message {chatMsgEvent} <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody + msg@RcvMessage {chatMsgEvent} <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody withAckMessage agentConnId msgMeta $ case chatMsgEvent of XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta @@ -987,7 +991,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage messageError :: Text -> m () messageError = toView . CRMessageError "error" - newContentMessage :: Contact -> MsgContainer -> Message -> MsgMeta -> m () + newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m () newContentMessage ct@Contact {localDisplayName = c} mc msg msgMeta = do let content = mcContent mc ci@ChatItem {formattedText} <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent content) @@ -996,7 +1000,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage showMsgToast (c <> "> ") content formattedText setActive $ ActiveC c - newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> Message -> MsgMeta -> m () + newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m () newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msg msgMeta = do let content = mcContent mc ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content) @@ -1005,7 +1009,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText setActive $ ActiveG g - processFileInvitation :: Contact -> FileInvitation -> Message -> MsgMeta -> m () + processFileInvitation :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m () processFileInvitation ct@Contact {localDisplayName = c} fInv msg msgMeta = do -- TODO chunk size has to be sent as part of invitation chSize <- asks $ fileChunkSize . config @@ -1017,7 +1021,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage showToast (c <> "> ") "wants to send a file" setActive $ ActiveC c - processGroupFileInvitation :: GroupInfo -> GroupMember -> FileInvitation -> Message -> MsgMeta -> m () + processGroupFileInvitation :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () processGroupFileInvitation gInfo m@GroupMember {localDisplayName = c} fInv msg msgMeta = do chSize <- asks $ fileChunkSize . config ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize @@ -1315,7 +1319,7 @@ createSndMessage chatMsgEvent connOrGroupId = do gVar <- asks idsDrg withStore $ \st -> createNewSndMessage st gVar connOrGroupId $ \sharedMsgId -> let msgBody = strEncode ChatMessage {msgId = Just sharedMsgId, chatMsgEvent} - in NewMessage {direction = MDSnd, chatMsgEvent, msgBody} + in NewMessage {chatMsgEvent, msgBody} directMessage :: ChatMsgEvent -> ByteString directMessage chatMsgEvent = strEncode ChatMessage {msgId = Nothing, chatMsgEvent} @@ -1359,54 +1363,42 @@ sendPendingGroupMessages GroupMember {groupMemberId, localDisplayName} conn = do Nothing -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName Just introId -> withStore (\st -> updateIntroStatus st introId GMIntroInvForwarded) -saveRcvMSG :: ChatMonad m => Connection -> ConnOrGroupId -> MsgMeta -> MsgBody -> m Message +saveRcvMSG :: ChatMonad m => Connection -> ConnOrGroupId -> MsgMeta -> MsgBody -> m RcvMessage saveRcvMSG Connection {connId} connOrGroupId agentMsgMeta msgBody = do ChatMessage {msgId = sharedMsgId_, chatMsgEvent} <- liftEither $ parseChatMessage msgBody let agentMsgId = fst $ recipient agentMsgMeta - newMsg = NewMessage {direction = MDRcv, chatMsgEvent, msgBody} + newMsg = NewMessage {chatMsgEvent, msgBody} rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} withStore $ \st -> createNewMessageAndRcvMsgDelivery st connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery -sendDirectChatItem :: ChatMonad m => User -> Contact -> ChatMsgEvent -> CIContent 'MDSnd -> m (ChatItem 'CTDirect 'MDSnd) -sendDirectChatItem user ct chatMsgEvent ciContent = do +sendDirectChatItem :: ChatMonad m => User -> Contact -> ChatMsgEvent -> CIContent 'MDSnd -> Maybe (CIQuote 'CTDirect) -> m (ChatItem 'CTDirect 'MDSnd) +sendDirectChatItem user ct chatMsgEvent ciContent quotedItem = do msg <- sendDirectContactMessage ct chatMsgEvent - saveSndChatItem user (CDDirectSnd ct) msg ciContent + saveSndChatItem user (CDDirectSnd ct) msg ciContent quotedItem -sendGroupChatItem :: ChatMonad m => User -> Group -> ChatMsgEvent -> CIContent 'MDSnd -> m (ChatItem 'CTGroup 'MDSnd) -sendGroupChatItem user (Group g ms) chatMsgEvent ciContent = do +sendGroupChatItem :: ChatMonad m => User -> Group -> ChatMsgEvent -> CIContent 'MDSnd -> Maybe (CIQuote 'CTGroup) -> m (ChatItem 'CTGroup 'MDSnd) +sendGroupChatItem user (Group g ms) chatMsgEvent ciContent quotedItem = do msg <- sendGroupMessage g ms chatMsgEvent - saveSndChatItem user (CDGroupSnd g) msg ciContent + saveSndChatItem user (CDGroupSnd g) msg ciContent quotedItem -saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd) -saveSndChatItem user cd msg ciContent = do +saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd) +saveSndChatItem user cd msg@SndMessage {sharedMsgId} content quotedItem = do createdAt <- liftIO getCurrentTime - saveChatItem user cd $ mkNewChatItem ciContent (anyMessage msg) createdAt createdAt + ciId <- withStore $ \st -> createNewSndChatItem st user cd msg content quotedItem createdAt + liftIO $ mkChatItem cd ciId content quotedItem (Just sharedMsgId) createdAt createdAt -saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> Message -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) -saveRcvChatItem user cd msg MsgMeta {broker = (_, brokerTs)} ciContent = do +saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) +saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} MsgMeta {broker = (_, brokerTs)} content = do createdAt <- liftIO getCurrentTime - saveChatItem user cd $ mkNewChatItem ciContent msg brokerTs createdAt + (ciId, quotedItem) <- withStore $ \st -> createNewRcvChatItem st user cd msg content brokerTs createdAt -- createNewChatItem st user cd $ mkNewChatItem content msg brokerTs createdAt + liftIO $ mkChatItem cd ciId content quotedItem sharedMsgId_ brokerTs createdAt -saveChatItem :: (ChatMonad m, MsgDirectionI d) => User -> ChatDirection c d -> NewChatItem d -> m (ChatItem c d) -saveChatItem user cd ci@NewChatItem {itemContent = content, itemTs, itemText, itemSharedMsgId, createdAt} = do - tz <- liftIO getCurrentTimeZone - (ciId, quotedItem) <- withStore $ \st -> createNewChatItem st user cd ci - let meta = mkCIMeta ciId itemText ciStatusNew itemSharedMsgId tz itemTs createdAt - pure $ ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem} - -mkNewChatItem :: forall d. MsgDirectionI d => CIContent d -> Message -> UTCTime -> UTCTime -> NewChatItem d -mkNewChatItem itemContent Message {msgId, chatMsgEvent, sharedMsgId_ = itemSharedMsgId} itemTs createdAt = - NewChatItem - { createdByMsgId = if msgId == 0 then Nothing else Just msgId, - itemSent = msgDirection @d, - itemTs, - itemContent, - itemText = ciContentToText itemContent, - itemStatus = ciStatusNew, - itemSharedMsgId, - itemQuotedMsg = cmToQuotedMsg chatMsgEvent, - createdAt - } +mkChatItem :: MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> IO (ChatItem c d) +mkChatItem cd ciId content quotedItem sharedMsgId itemTs createdAt = do + tz <- getCurrentTimeZone + let itemText = ciContentToText content + meta = mkCIMeta ciId itemText ciStatusNew sharedMsgId tz itemTs createdAt + pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem} allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m () allowAgentConnection conn confId msg = do @@ -1524,7 +1516,7 @@ chatCommandP = <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP) <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal) <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP) - <|> "/_send_quote" *> (APISendMessageQuote <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP) + <|> "/_send_quote " *> (APISendMessageQuote <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP) <|> "/_read chat " *> (APIChatRead <$> chatTypeP <*> A.decimal <* A.space <*> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal))) <|> "/_delete " *> (APIDeleteChat <$> chatTypeP <*> A.decimal) <|> "/_accept " *> (APIAcceptContact <$> A.decimal) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index e09364861..a286e0970 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -103,9 +103,6 @@ data JSONCIDirection | JCIGroupRcv {groupMember :: GroupMember} deriving (Generic, Show) -instance FromJSON JSONCIDirection where - parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI" - instance ToJSON JSONCIDirection where toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI" toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI" @@ -189,7 +186,7 @@ instance ToJSON ChatStats where toEncoding = J.genericToEncoding J.defaultOptions -- | type to show a mix of messages from multiple chats -data AChatItem = forall c d. AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d) +data AChatItem = forall c d. MsgDirectionI d => AChatItem (SChatType c) (SMsgDirection d) (ChatInfo c) (ChatItem c d) deriving instance Show AChatItem @@ -222,41 +219,46 @@ mkCIMeta itemId itemText itemStatus itemSharedMsgId tz itemTs createdAt = instance ToJSON (CIMeta d) where toEncoding = J.genericToEncoding J.defaultOptions -data CIQuoteData = CIQuoteData - { itemId :: Maybe ChatItemId, +data CIQuote (c :: ChatType) = CIQuote + { chatDir :: CIQDirection c, + itemId :: Maybe ChatItemId, -- Nothing in case MsgRef references the item the user did not receive yet + sharedMsgId :: Maybe SharedMsgId, -- Nothing for the messages from the old clients sentAt :: UTCTime, content :: MsgContent, formattedText :: Maybe MarkdownList } deriving (Show, Generic) -instance ToJSON CIQuoteData where +instance ToJSON (CIQuote c) where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} -data CIQuote (c :: ChatType) where - CIQuoteDirect :: CIQuoteData -> Bool -> CIQuote 'CTDirect - CIQuoteGroup :: CIQuoteData -> GroupMember -> CIQuote 'CTGroup +data CIQDirection (c :: ChatType) where + CIQDirectSnd :: CIQDirection 'CTDirect + CIQDirectRcv :: CIQDirection 'CTDirect + CIQGroupSnd :: CIQDirection 'CTGroup + CIQGroupRcv :: Maybe GroupMember -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet -deriving instance Show (CIQuote c) +deriving instance Show (CIQDirection c) -instance ToJSON (CIQuote c) where - toJSON = J.toJSON . jsonCIQuote - toEncoding = J.toEncoding . jsonCIQuote +instance ToJSON (CIQDirection c) where + toJSON = J.toJSON . jsonCIQDirection + toEncoding = J.toEncoding . jsonCIQDirection -data JSONCIQuote - = JCIQuoteDirect {quote :: CIQuoteData, sent :: Bool} - | JCIQuoteGroup {quote :: CIQuoteData, member :: GroupMember} - deriving (Show, Generic) +jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection +jsonCIQDirection = \case + CIQDirectSnd -> Just JCIDirectSnd + CIQDirectRcv -> Just JCIDirectRcv + CIQGroupSnd -> Just JCIGroupSnd + CIQGroupRcv (Just m) -> Just $ JCIGroupRcv m + CIQGroupRcv Nothing -> Nothing -instance ToJSON JSONCIQuote where - toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIQuote" - toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIQuote" - -jsonCIQuote :: CIQuote c -> JSONCIQuote -jsonCIQuote = \case - CIQuoteDirect quote sent -> JCIQuoteDirect {quote, sent} - CIQuoteGroup quote member -> JCIQuoteGroup {quote, member} +quoteMsgDirection :: CIQDirection c -> MsgDirection +quoteMsgDirection = \case + CIQDirectSnd -> MDSnd + CIQDirectRcv -> MDRcv + CIQGroupSnd -> MDSnd + CIQGroupRcv _ -> MDRcv data CIStatus (d :: MsgDirection) where CISSndNew :: CIStatus 'MDSnd @@ -452,31 +454,24 @@ instance ChatTypeI 'CTDirect where chatType = SCTDirect instance ChatTypeI 'CTGroup where chatType = SCTGroup data NewMessage = NewMessage - { direction :: MsgDirection, - chatMsgEvent :: ChatMsgEvent, + { chatMsgEvent :: ChatMsgEvent, msgBody :: MsgBody } deriving (Show) data SndMessage = SndMessage { msgId :: MessageId, - direction :: MsgDirection, - chatMsgEvent :: ChatMsgEvent, sharedMsgId :: SharedMsgId, msgBody :: MsgBody } -data Message = Message +data RcvMessage = RcvMessage { msgId :: MessageId, - direction :: MsgDirection, chatMsgEvent :: ChatMsgEvent, sharedMsgId_ :: Maybe SharedMsgId, msgBody :: MsgBody } -anyMessage :: SndMessage -> Message -anyMessage SndMessage {..} = Message {msgId, direction, chatMsgEvent, sharedMsgId_ = Just sharedMsgId, msgBody} - data PendingGroupMessage = PendingGroupMessage { msgId :: MessageId, cmEventTag :: CMEventTag, @@ -489,7 +484,7 @@ type MessageId = Int64 data ConnOrGroupId = ConnectionId Int64 | GroupId Int64 data MsgDirection = MDRcv | MDSnd - deriving (Show, Generic) + deriving (Eq, Show, Generic) instance FromJSON MsgDirection where parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MD" diff --git a/src/Simplex/Chat/Migrations/M20220304_msg_quotes.hs b/src/Simplex/Chat/Migrations/M20220304_msg_quotes.hs index 897f6554a..129c3616a 100644 --- a/src/Simplex/Chat/Migrations/M20220304_msg_quotes.hs +++ b/src/Simplex/Chat/Migrations/M20220304_msg_quotes.hs @@ -18,7 +18,7 @@ m20220304_msg_quotes = ALTER TABLE chat_items ADD COLUMN quoted_shared_msg_id BLOB; -- from MessageRef in QuotedMsg ALTER TABLE chat_items ADD COLUMN quoted_sent_at TEXT; -- from MessageRef in QuotedMsg ALTER TABLE chat_items ADD COLUMN quoted_content TEXT; -- from MsgContent in QuotedMsg (JSON) - ALTER TABLE chat_items ADD COLUMN quoted_sent INTEGER; -- from MessageRef, 1 for sent, 0 for received, NULL for group items (or not reply messages) + ALTER TABLE chat_items ADD COLUMN quoted_sent INTEGER; -- from MessageRef, 1 for sent, 0 for received, NULL for messages without quote ALTER TABLE chat_items ADD COLUMN quoted_member_id BLOB; -- from MessageRef CREATE INDEX idx_chat_items_shared_msg_id ON chat_items (shared_msg_id); |] diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index bd308ec0f..ff93e139f 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -33,7 +33,6 @@ import Simplex.Chat.Types import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8) import Simplex.Messaging.Agent.Store.SQLite (fromTextField_) import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON) import Simplex.Messaging.Util ((<$?>)) data ConnectionEntity @@ -85,28 +84,20 @@ instance ToJSON SharedMsgId where toJSON = strToJSON toEncoding = strToJEncoding -data MessageRef - = MsgRefDirect - { msgId :: Maybe SharedMsgId, - sentAt :: UTCTime, - sent :: Bool - } - | MsgRefGroup - { msgId :: Maybe SharedMsgId, - sentAt :: UTCTime, - memberId :: MemberId - } +data MsgRef = MsgRef + { msgId :: Maybe SharedMsgId, + sentAt :: UTCTime, + sent :: Bool, + memberId :: Maybe MemberId -- must be present in all group message references, both referencing sent and received + } deriving (Eq, Show, Generic) -msgRefJSONOpts :: J.Options -msgRefJSONOpts = taggedObjectJSON $ dropPrefix "MsgRef" +instance FromJSON MsgRef where + parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True} -instance FromJSON MessageRef where - parseJSON = J.genericParseJSON msgRefJSONOpts - -instance ToJSON MessageRef where - toJSON = J.genericToJSON msgRefJSONOpts - toEncoding = J.genericToEncoding msgRefJSONOpts +instance ToJSON MsgRef where + toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} + toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} data ChatMessage = ChatMessage {msgId :: Maybe SharedMsgId, chatMsgEvent :: ChatMsgEvent} deriving (Eq, Show) @@ -141,7 +132,7 @@ data ChatMsgEvent | XUnknown {event :: Text, params :: J.Object} deriving (Eq, Show) -data QuotedMsg = QuotedMsg {msgRef :: MessageRef, content :: MsgContent} +data QuotedMsg = QuotedMsg {msgRef :: MsgRef, content :: MsgContent} deriving (Eq, Show, Generic, FromJSON) instance ToJSON QuotedMsg where diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 6b44f71a6..34350e1a8 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -113,7 +113,8 @@ module Simplex.Chat.Store createPendingGroupMessage, getPendingGroupMessages, deletePendingGroupMessage, - createNewChatItem, + createNewSndChatItem, + createNewRcvChatItem, getChatPreviews, getDirectChat, getGroupChat, @@ -147,7 +148,7 @@ import Data.Function (on) import Data.Functor (($>)) import Data.Int (Int64) import Data.List (find, sortBy, sortOn) -import Data.Maybe (listToMaybe) +import Data.Maybe (isJust, listToMaybe) import Data.Ord (Down (..)) import Data.Text (Text) import qualified Data.Text as T @@ -2040,7 +2041,7 @@ createNewSndMessage st gVar connOrGroupId mkMessage = "INSERT INTO messages (msg_sent, chat_msg_event, msg_body, shared_msg_id, shared_msg_id_user, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" (MDSnd, XUnknown_ "", "" :: MsgBody, sharedMsgId, Just True, createdAt, createdAt) msgId <- insertedRowId db - let NewMessage {direction, chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId + let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId DB.execute db [sql| @@ -2048,8 +2049,8 @@ createNewSndMessage st gVar connOrGroupId mkMessage = SET msg_sent = ?, chat_msg_event = ?, msg_body = ?, connection_id = ?, group_id = ? WHERE message_id = ? |] - (direction, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, msgId) - pure SndMessage {msgId, direction, chatMsgEvent, sharedMsgId = SharedMsgId sharedMsgId, msgBody} + (MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, msgId) + pure SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody} where (connId_, groupId_) = case connOrGroupId of ConnectionId connId -> (Just connId, Nothing) @@ -2062,14 +2063,14 @@ createSndMsgDelivery st sndMsgDelivery messageId = msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId currentTs createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs -createNewMessageAndRcvMsgDelivery :: MonadUnliftIO m => SQLiteStore -> ConnOrGroupId -> NewMessage -> Maybe SharedMsgId -> RcvMsgDelivery -> m Message -createNewMessageAndRcvMsgDelivery st connOrGroupId NewMessage {direction, chatMsgEvent, msgBody} sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} = +createNewMessageAndRcvMsgDelivery :: MonadUnliftIO m => SQLiteStore -> ConnOrGroupId -> NewMessage -> Maybe SharedMsgId -> RcvMsgDelivery -> m RcvMessage +createNewMessageAndRcvMsgDelivery st connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} = liftIO . withTransaction st $ \db -> do currentTs <- getCurrentTime DB.execute db "INSERT INTO messages (msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id) VALUES (?,?,?,?,?,?,?,?)" - (direction, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_) + (MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_) msgId <- insertedRowId db DB.execute db @@ -2077,7 +2078,7 @@ createNewMessageAndRcvMsgDelivery st connOrGroupId NewMessage {direction, chatMs (msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, snd $ broker agentMsgMeta, currentTs, currentTs) msgDeliveryId <- insertedRowId db createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs - pure Message {msgId, direction, chatMsgEvent, sharedMsgId_, msgBody} + pure RcvMessage {msgId, chatMsgEvent, sharedMsgId_, msgBody} where (connId_, groupId_) = case connOrGroupId of ConnectionId connId' -> (Just connId', Nothing) @@ -2170,74 +2171,113 @@ deletePendingGroupMessage st groupMemberId messageId = liftIO . withTransaction st $ \db -> DB.execute db "DELETE FROM pending_group_messages WHERE group_member_id = ? AND message_id = ?" (groupMemberId, messageId) -createNewChatItem :: (MonadUnliftIO m, MsgDirectionI d) => SQLiteStore -> User -> ChatDirection c d -> NewChatItem d -> m (ChatItemId, Maybe (CIQuote c)) -createNewChatItem st user@User {userId} chatDirection NewChatItem {createdByMsgId, itemSent, itemTs, itemContent, itemText, itemStatus, itemSharedMsgId, itemQuotedMsg, createdAt} = - liftIO . withTransaction st $ \db -> do - let itemMeta = (itemSent, itemTs, itemContent, itemText, itemStatus, itemSharedMsgId, createdAt, createdAt) - DB.execute - db - [sql| - INSERT INTO chat_items ( - -- user and IDs - user_id, created_by_msg_id, contact_id, group_id, group_member_id, - -- meta - item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, - -- quote - quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) - |] - ((userId, createdByMsgId) :. ids :. itemMeta :. quote) - ciId <- insertedRowId db - case createdByMsgId of - Nothing -> pure () - Just msgId -> - DB.execute - db - "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" - (ciId, msgId, createdAt, createdAt) - ciRef <- getChatItemRef_ db user chatDirection itemQuotedMsg - pure (ciId, ciRef) - where - ids :: (Maybe Int64, Maybe Int64, Maybe Int64) - ids = case chatDirection of - CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing) - CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing) - CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing) - CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId) - quote :: (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId) - quote = case itemQuotedMsg of - Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing) - Just QuotedMsg {msgRef = MsgRefDirect {msgId, sentAt, sent}, content} -> (msgId, Just sentAt, Just content, Just sent, Nothing) - Just QuotedMsg {msgRef = MsgRefGroup {msgId, sentAt, memberId}, content} -> (msgId, Just sentAt, Just content, Nothing, Just memberId) +type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId) -getChatItemRef_ :: DB.Connection -> User -> ChatDirection c d -> Maybe QuotedMsg -> IO (Maybe (CIQuote c)) -getChatItemRef_ db User {userId, userContactId} chatDirection = \case - Just QuotedMsg {msgRef = MsgRefDirect {msgId, sentAt, sent}, content} -> case chatDirection of - CDDirectSnd Contact {contactId} -> Just <$> getDirectChatItemRef_ sentAt content contactId msgId sent - CDDirectRcv Contact {contactId} -> Just <$> getDirectChatItemRef_ sentAt content contactId msgId (not sent) - _ -> pure Nothing - Just QuotedMsg {msgRef = MsgRefGroup {msgId, sentAt, memberId}, content} -> case chatDirection of - CDGroupSnd GroupInfo {groupId} -> getGroupChatItemRef_ sentAt content groupId msgId memberId - CDGroupRcv GroupInfo {groupId} _ -> getGroupChatItemRef_ sentAt content groupId msgId memberId - _ -> pure Nothing - _ -> pure Nothing +createNewSndChatItem :: MonadUnliftIO m => SQLiteStore -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> UTCTime -> m ChatItemId +createNewSndChatItem st user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem createdAt = + liftIO . withTransaction st $ \db -> + createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow createdAt createdAt where - getDirectChatItemRef_ :: UTCTime -> MsgContent -> Int64 -> Maybe SharedMsgId -> Bool -> IO (CIQuote 'CTDirect) - getDirectChatItemRef_ sentAt content contactId msgId sent = do - ciRefDirect . listToMaybe . map fromOnly + createdByMsgId = if msgId == 0 then Nothing else Just msgId + quoteRow :: NewQuoteRow + quoteRow = case quotedItem of + Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing) + Just (CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content}) -> + uncurry (quotedSharedMsgId,Just sentAt,Just content,,) $ case chatDir of + CIQDirectSnd -> (Just True, Nothing) + CIQDirectRcv -> (Just False, Nothing) + CIQGroupSnd -> (Just True, Nothing) + CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId) + CIQGroupRcv Nothing -> (Just False, Nothing) + +createNewRcvChatItem :: MonadUnliftIO m => SQLiteStore -> User -> ChatDirection c 'MDRcv -> RcvMessage -> CIContent 'MDRcv -> UTCTime -> UTCTime -> m (ChatItemId, Maybe (CIQuote c)) +createNewRcvChatItem st user chatDirection RcvMessage {msgId, chatMsgEvent, sharedMsgId_} ciContent itemTs createdAt = + liftIO . withTransaction st $ \db -> do + ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemTs createdAt + quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg + pure (ciId, quotedItem) + where + quotedMsg = cmToQuotedMsg chatMsgEvent + quoteRow :: NewQuoteRow + quoteRow = case quotedMsg of + Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing) + Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId}, content} -> + uncurry (sharedMsgId,Just sentAt,Just content,,) $ case chatDirection of + CDDirectRcv _ -> (Just $ not sent, Nothing) + CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ -> + (Just $ Just userMemberId == memberId, memberId) + +createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> UTCTime -> UTCTime -> IO ChatItemId +createNewChatItem_ db User {userId} chatDirection msgId sharedMsgId ciContent quoteRow itemTs createdAt = do + DB.execute + db + [sql| + INSERT INTO chat_items ( + -- user and IDs + user_id, created_by_msg_id, contact_id, group_id, group_member_id, + -- meta + item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, + -- quote + quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + |] + ((userId, msgId) :. idsRow :. itemRow :. quoteRow) + ciId <- insertedRowId db + when (isJust msgId) $ + DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, createdAt, createdAt) + pure ciId + where + itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, UTCTime, UTCTime) + itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciStatusNew @d, sharedMsgId, createdAt, createdAt) + idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64) + idsRow = case chatDirection of + CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing) + CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing) + CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId) + CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing) + +getChatItemQuote_ :: DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c) +getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} = + case chatDirection of + CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent) + CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} -> + case memberId of + Just mId + | mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId + | mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId mId + | otherwise -> getGroupChatItemQuote_ groupId mId + _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing + where + ciQuote :: Maybe ChatItemId -> CIQDirection c -> CIQuote c + ciQuote itemId dir = CIQuote dir itemId msgId sentAt content . parseMaybeMarkdownList $ msgContentText content + getDirectChatItemQuote_ :: Int64 -> Bool -> IO (CIQuote 'CTDirect) + getDirectChatItemQuote_ contactId userSent = do + ciQuoteDirect . listToMaybe . map fromOnly <$> DB.query db "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND contact_id = ? AND shared_msg_id = ? AND item_sent = ?" - (userId, contactId, msgId, sent) + (userId, contactId, msgId, userSent) where - ciRefDirect :: Maybe ChatItemId -> CIQuote 'CTDirect - ciRefDirect chatItemId = - let quote = CIQuoteData chatItemId sentAt content . parseMaybeMarkdownList $ msgContentText content - in CIQuoteDirect quote sent - getGroupChatItemRef_ :: UTCTime -> MsgContent -> Int64 -> Maybe SharedMsgId -> MemberId -> IO (Maybe (CIQuote 'CTGroup)) - getGroupChatItemRef_ sentAt content groupId msgId memberId = do - ciRefGroup + ciQuoteDirect :: Maybe ChatItemId -> CIQuote 'CTDirect + ciQuoteDirect = (`ciQuote` if userSent then CIQDirectSnd else CIQDirectRcv) + getUserGroupChatItemId_ :: Int64 -> IO (Maybe ChatItemId) + getUserGroupChatItemId_ groupId = + listToMaybe . map fromOnly <$> DB.query + db + "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id IS NULL" + (userId, groupId, msgId, MDSnd) + getGroupChatItemId_ :: Int64 -> MemberId -> IO (Maybe ChatItemId) + getGroupChatItemId_ groupId mId = + listToMaybe . map fromOnly + <$> DB.query + db + "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? AND item_sent = ? AND group_member_id = ?" + (userId, groupId, msgId, MDRcv, mId) + getGroupChatItemQuote_ :: Int64 -> MemberId -> IO (CIQuote 'CTGroup) + getGroupChatItemQuote_ groupId mId = do + ciQuoteGroup + <$> DB.queryNamed db [sql| SELECT i.chat_item_id, @@ -2246,20 +2286,18 @@ getChatItemRef_ db User {userId, userContactId} chatDirection = \case m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image FROM group_members m - JOIN contact_profiles p USING (contact_profile_id) + JOIN contact_profiles p ON m.contact_profile_id = p.contact_profile_id + LEFT JOIN contacts c ON m.contact_id = c.contact_id LEFT JOIN chat_items i ON i.group_id = m.group_id - AND (m.group_member_id = i.group_member_id OR i.group_member_id IS NULL) - WHERE (i.shared_msg_id = ? OR i.shared_msg_id IS NULL) - AND m.user_id = ? AND m.group_id = ? AND m.member_id = ? + AND m.group_member_id = i.group_member_id + AND i.shared_msg_id = :msg_id + WHERE m.user_id = :user_id AND m.group_id = :group_id AND m.member_id = :member_id |] - (msgId, userId, groupId, memberId) + [":user_id" := userId, ":group_id" := groupId, ":member_id" := mId, ":msg_id" := msgId] where - ciRefGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> Maybe (CIQuote 'CTGroup) - ciRefGroup [] = Nothing - ciRefGroup ((Only chatItemId :. memberRow) : _) = - let member = toGroupMember userContactId memberRow - quote = CIQuoteData chatItemId sentAt content . parseMaybeMarkdownList $ msgContentText content - in Just $ CIQuoteGroup quote member + ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup + ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing + ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow getChatPreviews :: MonadUnliftIO m => SQLiteStore -> User -> m [AChat] getChatPreviews st user = @@ -2297,7 +2335,7 @@ getDirectChatPreviews_ db User {userId} = do -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.created_at, -- DirectQuote - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM contacts ct JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id JOIN connections c ON c.contact_id = ct.contact_id @@ -2332,7 +2370,7 @@ getDirectChatPreviews_ db User {userId} = do |] (CISRcvNew, userId, ConnReady, ConnSndReady) where - toDirectChatPreview :: TimeZone -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeDirectChatItemRow -> AChat + toDirectChatPreview :: TimeZone -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat toDirectChatPreview tz (contactRow :. connRow :. statsRow :. ciRow_) = let contact = toContact $ contactRow :. connRow ci_ = toDirectChatItemList tz ciRow_ @@ -2362,7 +2400,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image, -- quoted ChatItem - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, @@ -2450,7 +2488,7 @@ getDirectChatLast_ db User {userId} contactId count = do -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.created_at, -- DirectQuote - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? @@ -2477,7 +2515,7 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.created_at, -- DirectQuote - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id > ? @@ -2504,7 +2542,7 @@ getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.created_at, -- DirectQuote - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id < ? @@ -2607,7 +2645,7 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image, -- quoted ChatItem - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, @@ -2646,7 +2684,7 @@ getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image, -- quoted ChatItem - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, @@ -2685,7 +2723,7 @@ getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemI m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image, -- quoted ChatItem - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, @@ -2800,7 +2838,7 @@ getDirectChatItem_ db userId contactId itemId = do -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.created_at, -- DirectQuote - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id = ? @@ -2840,7 +2878,7 @@ getGroupChatItem st User {userId, userContactId} groupId itemId = m.member_status, m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image, -- quoted ChatItem - ri.chat_item_id, i.quoted_sent_at, i.quoted_content, + ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, @@ -2918,20 +2956,27 @@ type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe Shared type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe UTCTime) -type QuoteDataRow = (Maybe ChatItemId, Maybe UTCTime, Maybe MsgContent) +type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool) -type DirectQuote = QuoteDataRow :. Only (Maybe Bool) +-- type DirectChatItemRow = ChatItemRow :. DirectQuoteRow -type DirectChatItemRow = ChatItemRow :. DirectQuote +-- type MaybeDirectChatItemRow = MaybeChatItemRow :. DirectQuoteRow -type MaybeDirectChatItemRow = MaybeChatItemRow :. DirectQuote +-- toQuoteData :: QuoteDataRow -> Maybe CIQuoteData +-- toQuoteData (quotedItemId, quotedSentAt, quotedMsgContent) = +-- CIQuoteData quotedItemId <$> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) -toQuoteData :: QuoteDataRow -> Maybe CIQuoteData -toQuoteData (quotedItemId, quotedSentAt, quotedMsgContent) = - CIQuoteData quotedItemId <$> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) +toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect) +toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent + where + direction sent = if sent then CIQDirectSnd else CIQDirectRcv -toDirectChatItem :: TimeZone -> DirectChatItemRow -> Either StoreError (CChatItem 'CTDirect) -toDirectChatItem tz ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, createdAt) :. quoteRow :. Only quotedSent) = +toQuote :: QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c) +toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir = + CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) + +toDirectChatItem :: TimeZone -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect) +toDirectChatItem tz ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, createdAt) :. quoteRow) = case (itemContent, itemStatus) of (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus) -> Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus) -> Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent @@ -2939,24 +2984,29 @@ toDirectChatItem tz ((itemId, itemTs, itemContent, itemText, itemStatus, sharedM where cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> CChatItem 'CTDirect cItem d chatDir ciStatus content = - let quotedItem = CIQuoteDirect <$> toQuoteData quoteRow <*> quotedSent - in CChatItem d ChatItem {chatDir, meta = ciMeta ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem} + CChatItem d ChatItem {chatDir, meta = ciMeta ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow} badItem = Left $ SEBadChatItem itemId ciMeta :: CIStatus d -> CIMeta d ciMeta status = mkCIMeta itemId itemText status sharedMsgId tz itemTs createdAt -toDirectChatItemList :: TimeZone -> MaybeDirectChatItemRow -> [CChatItem 'CTDirect] -toDirectChatItemList tz ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just createdAt) :. quoteRow :. Only quotedSent) = - either (const []) (: []) $ toDirectChatItem tz ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, createdAt) :. quoteRow :. Only quotedSent) +toDirectChatItemList :: TimeZone -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect] +toDirectChatItemList tz ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just createdAt) :. quoteRow) = + either (const []) (: []) $ toDirectChatItem tz ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, createdAt) :. quoteRow) toDirectChatItemList _ _ = [] -type GroupQuote = QuoteDataRow :. MaybeGroupMemberRow +type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow -type GroupChatItemRow = ChatItemRow :. MaybeGroupMemberRow :. GroupQuote +type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuote +toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup) +toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_ + where + direction (Just True) _ = Just CIQGroupSnd + direction (Just False) (Just member) = Just . CIQGroupRcv $ Just member + direction (Just False) Nothing = Just $ CIQGroupRcv Nothing + direction _ _ = Nothing -toGroupChatItem :: TimeZone -> Int64 -> GroupChatItemRow -> Either StoreError (CChatItem 'CTGroup) +toGroupChatItem :: TimeZone -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -> Either StoreError (CChatItem 'CTGroup) toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do let member_ = toMaybeGroupMember userContactId memberRow_ let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_ @@ -2967,8 +3017,7 @@ toGroupChatItem tz userContactId ((itemId, itemTs, itemContent, itemText, itemSt where cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> CChatItem 'CTGroup cItem d chatDir ciStatus content quotedMember_ = - let quotedItem = CIQuoteGroup <$> toQuoteData quoteRow <*> quotedMember_ - in CChatItem d ChatItem {chatDir, meta = ciMeta ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem} + CChatItem d ChatItem {chatDir, meta = ciMeta ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_} badItem = Left $ SEBadChatItem itemId ciMeta :: CIStatus d -> CIMeta d ciMeta status = mkCIMeta itemId itemText status sharedMsgId tz itemTs createdAt diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index bd6420811..7ae306c08 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -4,6 +4,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module Simplex.Chat.View where @@ -148,12 +151,16 @@ responseToView testView = \case testViewChat :: AChat -> [StyledString] testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems] where - toChatView :: CChatItem c -> (Int, Text) - toChatView (CChatItem dir ChatItem {meta}) = (msgDirectionInt $ toMsgDirection dir, itemText meta) + toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text)) + toChatView (CChatItem dir ChatItem {meta, quotedItem}) = + ((msgDirectionInt $ toMsgDirection dir, itemText meta),) $ case quotedItem of + Nothing -> Nothing + Just CIQuote {chatDir = quoteDir, content} -> + Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content) viewErrorsSummary :: [a] -> StyledString -> [StyledString] viewErrorsSummary summary s = if null summary then [] else [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)"] -viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString] +viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString] viewChatItem chat (ChatItem {chatDir, meta, content, quotedItem}) = case chat of DirectChat c -> case chatDir of CIDirectSnd -> case content of @@ -161,13 +168,13 @@ viewChatItem chat (ChatItem {chatDir, meta, content, quotedItem}) = case chat of CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta where to = ttyToContact' c - quote = maybe [] (directQuote True) quotedItem CIDirectRcv -> case content of CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft where from = ttyFromContact' c - quote = maybe [] (directQuote False) quotedItem + where + quote = maybe [] (directQuote chatDir) quotedItem GroupChat g -> case chatDir of CIGroupSnd -> case content of CISndMsgContent mc -> viewSentMessage to quote mc meta @@ -180,14 +187,18 @@ viewChatItem chat (ChatItem {chatDir, meta, content, quotedItem}) = case chat of where from = ttyFromGroup' g m where - quote = maybe [] groupQuote quotedItem + quote = maybe [] (groupQuote g) quotedItem _ -> [] where - directQuote :: Bool -> CIQuote 'CTDirect -> [StyledString] - directQuote msgSent (CIQuoteDirect CIQuoteData {content = qmc} qouteSent) = - quoteText qmc $ if msgSent == qouteSent then ">>" else ">" - groupQuote :: CIQuote 'CTGroup -> [StyledString] - groupQuote (CIQuoteGroup CIQuoteData {content = qmc} m) = quoteText qmc $ ttyQuotedMember m + directQuote :: forall d'. MsgDirectionI d' => CIDirection 'CTDirect d' -> CIQuote 'CTDirect -> [StyledString] + directQuote _ (CIQuote {content = qmc, chatDir = qouteDir}) = + quoteText qmc $ if toMsgDirection (msgDirection @d') == quoteMsgDirection qouteDir then ">>" else ">" + groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [StyledString] + groupQuote g (CIQuote {content = qmc, chatDir = quoteDir}) = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir + sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember + sentByMember GroupInfo {membership} = \case + CIQGroupSnd -> Just membership + CIQGroupRcv m -> m quoteText qmc sentBy = prependFirst (sentBy <> " ") $ msgPreview qmc msgPreview = msgPlain . preview . msgContentText where @@ -596,8 +607,9 @@ ttyToContact' Contact {localDisplayName = c} = ttyToContact c ttyQuotedContact :: Contact -> StyledString ttyQuotedContact Contact {localDisplayName = c} = ttyFrom $ c <> ">" -ttyQuotedMember :: GroupMember -> StyledString -ttyQuotedMember GroupMember {localDisplayName = c} = "> " <> ttyFrom c +ttyQuotedMember :: Maybe GroupMember -> StyledString +ttyQuotedMember (Just GroupMember {localDisplayName = c}) = "> " <> ttyFrom c +ttyQuotedMember _ = "> " <> ttyFrom "?" ttyFromContact' :: Contact -> StyledString ttyFromContact' Contact {localDisplayName = c} = ttyFromContact c diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index c84707185..889bb8ec0 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -140,11 +140,15 @@ testDirectMessageQuotedReply = do bob <## " all good - you?" alice <# "bob> > hello! how are you?" alice <## " all good - you?" + bob #$> ("/_get chat @2 count=1", chat', [((1, "all good - you?"), Just (0, "hello! how are you?"))]) + alice #$> ("/_get chat @2 count=1", chat', [((0, "all good - you?"), Just (1, "hello! how are you?"))]) bob `send` ">> @alice (all good) will tell more" bob <# "@alice >> all good - you?" bob <## " will tell more" alice <# "bob> >> all good - you?" alice <## " will tell more" + bob #$> ("/_get chat @2 count=1", chat', [((1, "will tell more"), Just (1, "all good - you?"))]) + alice #$> ("/_get chat @2 count=1", chat', [((0, "will tell more"), Just (0, "all good - you?"))]) testGroup :: IO () testGroup = @@ -568,6 +572,7 @@ testGroupMessageQuotedReply = concurrently_ (bob <# "#team alice> hello! how are you?") (cath <# "#team alice> hello! how are you?") + threadDelay 1000000 bob `send` "> #team @alice (hello) hello, all good, you?" bob <# "#team > alice hello! how are you?" bob <## " hello, all good, you?" @@ -580,6 +585,9 @@ testGroupMessageQuotedReply = cath <# "#team bob> > alice hello! how are you?" cath <## " hello, all good, you?" ) + bob #$> ("/_get chat #1 count=100", chat', [((0, "hello! how are you?"), Nothing), ((1, "hello, all good, you?"), Just (0, "hello! how are you?"))]) + alice #$> ("/_get chat #1 count=100", chat', [((1, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (1, "hello! how are you?"))]) + cath #$> ("/_get chat #1 count=100", chat', [((0, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (0, "hello! how are you?"))]) bob `send` "> #team bob (hello, all good) will tell more" bob <# "#team > bob hello, all good, you?" bob <## " will tell more" @@ -592,6 +600,10 @@ testGroupMessageQuotedReply = cath <# "#team bob> > bob hello, all good, you?" cath <## " will tell more" ) + bob #$> ("/_get chat #1 count=1", chat', [((1, "will tell more"), Just (1, "hello, all good, you?"))]) + alice #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))]) + cath #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))]) + threadDelay 1000000 cath `send` "> #team bob (hello) hi there!" cath <# "#team > bob hello, all good, you?" cath <## " hi there!" @@ -604,6 +616,9 @@ testGroupMessageQuotedReply = bob <# "#team cath> > bob hello, all good, you?" bob <## " hi there!" ) + cath #$> ("/_get chat #1 count=1", chat', [((1, "hi there!"), Just (0, "hello, all good, you?"))]) + alice #$> ("/_get chat #1 count=1", chat', [((0, "hi there!"), Just (0, "hello, all good, you?"))]) + bob #$> ("/_get chat #1 count=1", chat', [((0, "hi there!"), Just (1, "hello, all good, you?"))]) testUpdateProfile :: IO () testUpdateProfile = @@ -1132,7 +1147,10 @@ cc #$> (cmd, f, res) = do (f <$> getTermLine cc) `shouldReturn` res chat :: String -> [(Int, String)] -chat = read +chat = map fst . chat' + +chat' :: String -> [((Int, String), Maybe (Int, String))] +chat' = read (#$$>) :: TestCC -> (String, [(String, String)]) -> Expectation cc #$$> (cmd, res) = do diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index 43affb821..fba1ce62a 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -92,13 +92,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do it "x.msg.new" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgNew (MCSimple $ MCText "hello") it "x.msg.new" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## (ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew . MCSimple $ MCText "hello")) it "x.msg.new" $ - "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\",\"type\":\"direct\"}}}}" + "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ( ChatMessage (Just $ SharedMsgId "\1\2\3\4") ( XMsgNew $ MCQuote ( QuotedMsg - (MsgRefDirect (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True) + (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing) $ MCText "hello there!" ) (MCText "hello to you too")