dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-08-28 14:14:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: replace quoted content with MCText if the message itself is not MCText (#517)

Browse Source 
* core: replace quoted content with MCText if the message itself is not MCText

* core: quoteData in ChatMonad (#518)

* core: quoteData in ChatMonad

* use throwChatError

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2022-04-11 09:34:59 +01:00
committed by GitHub
co-authored by JRoberts
parent fa313caa82
commit 02d21145b2
1 changed files with 15 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+15 -10
View File
@@ -205,15 +205,16 @@ processChatCommand = \case
Just quotedItemId -> do
CChatItem _ ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} <-
withStore $ \st -> getDirectChatItem st userId chatId quotedItemId
(qmc, qd, sent) <- liftEither $ quoteData ciContent
(origQmc, qd, sent) <- quoteData ciContent
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
qmc = quoteContent origQmc mc
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_), Just quotedItem)
where
quoteData :: CIContent d -> Either ChatError (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData (CISndMsgContent qmc) = Right (qmc, CIQDirectSnd, True)
quoteData (CIRcvMsgContent qmc) = Right (qmc, CIQDirectRcv, False)
quoteData _ = Left $ ChatError CEInvalidQuote
quoteData :: CIContent d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData (CISndMsgContent qmc) = pure (qmc, CIQDirectSnd, True)
quoteData (CIRcvMsgContent qmc) = pure (qmc, CIQDirectRcv, False)
quoteData _ = throwChatError CEInvalidQuote
CTGroup -> do
Group gInfo@GroupInfo {membership, localDisplayName = gName} ms <- withStore $ \st -> getGroup st user chatId
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
@@ -240,17 +241,21 @@ processChatCommand = \case
Just quotedItemId -> do
CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} <-
withStore $ \st -> getGroupChatItem st user chatId quotedItemId
(qmc, qd, sent, GroupMember {memberId}) <- liftEither $ quoteData ciContent chatDir membership
(origQmc, qd, sent, GroupMember {memberId}) <- quoteData ciContent chatDir membership
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
qmc = quoteContent origQmc mc
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_), Just quotedItem)
where
quoteData :: CIContent d -> CIDirection 'CTGroup d -> GroupMember -> Either ChatError (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
quoteData (CISndMsgContent qmc) CIGroupSnd membership' = Right (qmc, CIQGroupSnd, True, membership')
quoteData (CIRcvMsgContent qmc) (CIGroupRcv m) _ = Right (qmc, CIQGroupRcv $ Just m, False, m)
quoteData _ _ _ = Left $ ChatError CEInvalidQuote
quoteData :: CIContent d -> CIDirection 'CTGroup d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
quoteData (CISndMsgContent qmc) CIGroupSnd membership' = pure (qmc, CIQGroupSnd, True, membership')
quoteData (CIRcvMsgContent qmc) (CIGroupRcv m) _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
quoteData _ _ _ = throwChatError CEInvalidQuote
CTContactRequest -> pure $ chatCmdError "not supported"
where
quoteContent qmc = \case
MCText _ -> qmc
_ -> MCText $ msgContentText qmc
unzipMaybe :: Maybe (a, b) -> (Maybe a, Maybe b)
unzipMaybe t = (fst <$> t, snd <$> t)
-- TODO discontinue