mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: change quoted messages types/protocol (#443)
* core: change quoted messages types/protocol * remove comments and unused field * rename CIQuote type * change type for quote direction to allow unknown group member, use QuotedMsg to save received chat item * change queries of quoted items when the sending group member is known * refactor * fix: make ciQuote polymorphic
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
d4765bcfec
commit
148474e1ba
+63
-71
@@ -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)
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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);
|
||||
|]
|
||||
|
||||
@@ -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
|
||||
|
||||
+161
-112
@@ -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
|
||||
|
||||
+25
-13
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user