mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-03-30 18:35:49 +00:00
core: support for live messages (#1577)
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
acfb98bd81
commit
6b8705e9f4
@@ -69,6 +69,7 @@ library
|
||||
Simplex.Chat.Migrations.M20221210_idxs
|
||||
Simplex.Chat.Migrations.M20221211_group_description
|
||||
Simplex.Chat.Migrations.M20221212_chat_items_timed
|
||||
Simplex.Chat.Migrations.M20221214_live_message
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Options
|
||||
Simplex.Chat.ProfileGenerator
|
||||
|
||||
@@ -297,7 +297,7 @@ processChatCommand = \case
|
||||
CTContactRequest -> pure $ chatCmdError "not implemented"
|
||||
CTContactConnection -> pure $ chatCmdError "not supported"
|
||||
APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
|
||||
APISendMessage (ChatRef cType chatId) (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
|
||||
APISendMessage (ChatRef cType chatId) live (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
|
||||
CTDirect -> do
|
||||
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
|
||||
assertDirectAllowed user MDSnd ct XMsgNew_
|
||||
@@ -313,7 +313,7 @@ processChatCommand = \case
|
||||
Just ft@FileTransferMeta {fileInline = Just IFMSent} ->
|
||||
sendDirectFileInline ct ft sharedMsgId
|
||||
_ -> pure ()
|
||||
ci <- saveSndChatItemTimed user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_
|
||||
ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
|
||||
case timed_ of
|
||||
Just CITimed {ttl, deleteAt = Just deleteAt} ->
|
||||
when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) deleteAt
|
||||
@@ -346,7 +346,7 @@ processChatCommand = \case
|
||||
Nothing -> pure Nothing
|
||||
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
|
||||
prepareMsg fileInvitation_ timed_ = case quotedItemId_ of
|
||||
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Nothing)
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), Nothing)
|
||||
Just quotedItemId -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getDirectChatItem db userId chatId quotedItemId
|
||||
@@ -354,7 +354,7 @@ processChatCommand = \case
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
||||
qmc = quoteContent origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Just quotedItem)
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), Just quotedItem)
|
||||
where
|
||||
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = True}} = throwChatError CEInvalidQuote
|
||||
@@ -372,7 +372,7 @@ processChatCommand = \case
|
||||
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_ membership
|
||||
msg@SndMessage {sharedMsgId} <- sendGroupMessage gInfo ms (XMsgNew msgContainer)
|
||||
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
|
||||
ci <- saveSndChatItemTimed user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_
|
||||
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
|
||||
case timed_ of
|
||||
Just CITimed {ttl, deleteAt = Just deleteAt} ->
|
||||
when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) deleteAt
|
||||
@@ -407,7 +407,7 @@ processChatCommand = \case
|
||||
_ -> pure ()
|
||||
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
prepareMsg fileInvitation_ timed_ membership = case quotedItemId_ of
|
||||
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Nothing)
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), Nothing)
|
||||
Just quotedItemId -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
|
||||
@@ -415,7 +415,7 @@ processChatCommand = \case
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
|
||||
qmc = quoteContent origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ciTimedToTTL timed_), Just quotedItem)
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ciTimedToTTL timed_) (justTrue live)), Just quotedItem)
|
||||
where
|
||||
quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = True}} _ = throwChatError CEInvalidQuote
|
||||
@@ -450,16 +450,17 @@ processChatCommand = \case
|
||||
unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c)
|
||||
unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c)
|
||||
unzipMaybe3 _ = (Nothing, Nothing, Nothing)
|
||||
APIUpdateChatItem (ChatRef cType chatId) itemId mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of
|
||||
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user@User {userId} -> withChatLock "updateChatItem" $ case cType of
|
||||
CTDirect -> do
|
||||
(ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
|
||||
assertDirectAllowed user MDSnd ct XMsgUpdate_
|
||||
case ci of
|
||||
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, timed}, content = ciContent} -> do
|
||||
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||
case (ciContent, itemSharedMsgId) of
|
||||
(CISndMsgContent _, Just itemSharedMId) -> do
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ciTimedToTTL timed) Nothing)
|
||||
updCi <- withStore $ \db -> updateDirectChatItem db userId contactId itemId (CISndMsgContent mc) $ Just msgId
|
||||
let live' = itemLive && live
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ciTimedToTTL itemTimed) (justTrue live'))
|
||||
updCi <- withStore $ \db -> updateDirectChatItem db userId contactId itemId (CISndMsgContent mc) live' $ Just msgId
|
||||
setActive $ ActiveC c
|
||||
pure . CRChatItemUpdated $ AChatItem SCTDirect SMDSnd (DirectChat ct) updCi
|
||||
_ -> throwChatError CEInvalidChatItemUpdate
|
||||
@@ -469,11 +470,12 @@ processChatCommand = \case
|
||||
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
||||
ci <- withStore $ \db -> getGroupChatItem db user chatId itemId
|
||||
case ci of
|
||||
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, timed}, content = ciContent} -> do
|
||||
CChatItem SMDSnd ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||
case (ciContent, itemSharedMsgId) of
|
||||
(CISndMsgContent _, Just itemSharedMId) -> do
|
||||
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc (ciTimedToTTL timed) Nothing)
|
||||
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CISndMsgContent mc) msgId
|
||||
let live' = itemLive && live
|
||||
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgUpdate itemSharedMId mc (ciTimedToTTL itemTimed) (justTrue live'))
|
||||
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CISndMsgContent mc) live' msgId
|
||||
setActive $ ActiveG gName
|
||||
pure . CRChatItemUpdated $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) updCi
|
||||
_ -> throwChatError CEInvalidChatItemUpdate
|
||||
@@ -643,7 +645,7 @@ processChatCommand = \case
|
||||
let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair}
|
||||
callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair}
|
||||
(msg, _) <- sendDirectContactMessage ct (XCallInv callId invitation)
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) Nothing Nothing
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0)
|
||||
let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
|
||||
call_ <- atomically $ TM.lookupInsert contactId call' calls
|
||||
forM_ call_ $ \call -> updateCallItemStatus userId ct call WCSDisconnected Nothing
|
||||
@@ -658,7 +660,7 @@ processChatCommand = \case
|
||||
CallInvitationReceived {} -> do
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvCall CISCallRejected 0
|
||||
withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId)
|
||||
updateDirectChatItemView userId ct chatItemId aciContent Nothing $> Nothing
|
||||
updateDirectChatItemView userId ct chatItemId aciContent False Nothing $> Nothing
|
||||
_ -> throwChatError . CECallState $ callStateTag callState
|
||||
APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} ->
|
||||
-- party accepting call
|
||||
@@ -670,7 +672,7 @@ processChatCommand = \case
|
||||
aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallOffer callId offer)
|
||||
withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId)
|
||||
updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId
|
||||
updateDirectChatItemView userId ct chatItemId aciContent False $ Just msgId
|
||||
pure $ Just call {callState = callState'}
|
||||
_ -> throwChatError . CECallState $ callStateTag callState
|
||||
APISendCallAnswer contactId rtcSession ->
|
||||
@@ -680,7 +682,7 @@ processChatCommand = \case
|
||||
let callState' = CallNegotiated {localCallType, peerCallType, localCallSession = rtcSession, peerCallSession, sharedKey}
|
||||
aciContent = ACIContent SMDSnd $ CISndCall CISCallNegotiated 0
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallAnswer callId CallAnswer {rtcSession})
|
||||
updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId
|
||||
updateDirectChatItemView userId ct chatItemId aciContent False $ Just msgId
|
||||
pure $ Just call {callState = callState'}
|
||||
_ -> throwChatError . CECallState $ callStateTag callState
|
||||
APISendCallExtraInfo contactId rtcExtraInfo ->
|
||||
@@ -908,7 +910,7 @@ processChatCommand = \case
|
||||
SendMessage chatName msg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
let mc = MCText $ safeDecodeUtf8 msg
|
||||
processChatCommand . APISendMessage chatRef $ ComposedMessage Nothing Nothing mc
|
||||
processChatCommand . APISendMessage chatRef False $ ComposedMessage Nothing Nothing mc
|
||||
SendMessageBroadcast msg -> withUser $ \user -> do
|
||||
contacts <- withStore' (`getUserContacts` user)
|
||||
withChatLock "sendMessageBroadcast" . procCmd $ do
|
||||
@@ -917,8 +919,8 @@ processChatCommand = \case
|
||||
forM_ cts $ \ct ->
|
||||
void
|
||||
( do
|
||||
(sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing Nothing))
|
||||
saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing
|
||||
(sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
|
||||
saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc)
|
||||
)
|
||||
`catchError` (toView . CRChatError)
|
||||
CRBroadcastSent mc (length cts) <$> liftIO getZonedTime
|
||||
@@ -926,7 +928,7 @@ processChatCommand = \case
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir (safeDecodeUtf8 quotedMsg)
|
||||
let mc = MCText $ safeDecodeUtf8 msg
|
||||
processChatCommand . APISendMessage (ChatRef CTDirect contactId) $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
processChatCommand . APISendMessage (ChatRef CTDirect contactId) False $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
DeleteMessage chatName deletedMsg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
|
||||
@@ -935,7 +937,7 @@ processChatCommand = \case
|
||||
chatRef <- getChatRef user chatName
|
||||
editedItemId <- getSentChatItemIdByText user chatRef editedMsg
|
||||
let mc = MCText $ safeDecodeUtf8 msg
|
||||
processChatCommand $ APIUpdateChatItem chatRef editedItemId mc
|
||||
processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc
|
||||
NewGroup gProfile -> withUser $ \user -> do
|
||||
gVar <- asks idsDrg
|
||||
groupInfo <- withStore (\db -> createNewGroup db gVar user gProfile)
|
||||
@@ -985,7 +987,7 @@ processChatCommand = \case
|
||||
case (cInfo, content) of
|
||||
(DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = CIGISAccepted} memRole
|
||||
updateDirectChatItemView userId ct itemId aciContent Nothing
|
||||
updateDirectChatItemView userId ct itemId aciContent False Nothing
|
||||
_ -> pure () -- prohibited
|
||||
APIMemberRole groupId memberId memRole -> withUser $ \user -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
|
||||
@@ -1010,7 +1012,7 @@ processChatCommand = \case
|
||||
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
|
||||
_ -> do
|
||||
msg <- sendGroupMessage gInfo members $ XGrpMemRole mId memRole
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent) Nothing Nothing
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
pure CRMemberRoleUser {groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
|
||||
APIRemoveMember groupId memberId -> withUser $ \user -> do
|
||||
@@ -1028,7 +1030,7 @@ processChatCommand = \case
|
||||
withStore' $ \db -> deleteGroupMember db user m
|
||||
_ -> do
|
||||
msg <- sendGroupMessage gInfo members $ XGrpMemDel mId
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) Nothing Nothing
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
deleteMemberConnection user m
|
||||
-- undeleted "member connected" chat item will prevent deletion of member record
|
||||
@@ -1038,7 +1040,7 @@ processChatCommand = \case
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
|
||||
withChatLock "leaveGroup" . procCmd $ do
|
||||
msg <- sendGroupMessage gInfo members XGrpLeave
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) Nothing Nothing
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
|
||||
-- TODO delete direct connections that were unused
|
||||
deleteGroupLink' user gInfo `catchError` \_ -> pure ()
|
||||
@@ -1107,7 +1109,7 @@ processChatCommand = \case
|
||||
groupId <- withStore $ \db -> getGroupIdByName db user gName
|
||||
quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName (safeDecodeUtf8 quotedMsg)
|
||||
let mc = MCText $ safeDecodeUtf8 msg
|
||||
processChatCommand . APISendMessage (ChatRef CTGroup groupId) $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
processChatCommand . APISendMessage (ChatRef CTGroup groupId) False $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
LastMessages (Just chatName) count search -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
CRLastMessages . aChatItems . chat <$> processChatCommand (APIGetChat chatRef (CPLast count) search)
|
||||
@@ -1115,14 +1117,14 @@ processChatCommand = \case
|
||||
CRLastMessages <$> getAllChatItems db user (CPLast count) search
|
||||
SendFile chatName f -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCFile "")
|
||||
processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCFile "")
|
||||
SendImage chatName f -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
filePath <- toFSFilePath f
|
||||
unless (".jpg" `isSuffixOf` f || ".jpeg" `isSuffixOf` f) $ throwChatError CEFileImageType {filePath}
|
||||
fileSize <- getFileSize filePath
|
||||
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
|
||||
processChatCommand . APISendMessage chatRef $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
|
||||
processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
|
||||
ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
|
||||
ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
|
||||
ReceiveFile fileId rcvInline_ filePath_ -> withUser $ \user ->
|
||||
@@ -1310,7 +1312,7 @@ processChatCommand = \case
|
||||
msg <- sendGroupMessage g' ms (XGrpInfo p')
|
||||
let cd = CDGroupSnd g'
|
||||
unless (sameGroupProfileInfo p p') $ do
|
||||
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') Nothing Nothing
|
||||
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p')
|
||||
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat g') ci
|
||||
createGroupFeatureChangedItems user cd CISndGroupFeature p p'
|
||||
pure $ CRGroupUpdated g g' Nothing
|
||||
@@ -1362,7 +1364,7 @@ processChatCommand = \case
|
||||
groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile Nothing
|
||||
(msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv
|
||||
let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg content Nothing Nothing
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg content
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
||||
setActive $ ActiveG localDisplayName
|
||||
|
||||
@@ -1411,11 +1413,11 @@ deleteFile user CIFileInfo {filePath, fileId, fileStatus} =
|
||||
updateCallItemStatus :: ChatMonad m => UserId -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> m ()
|
||||
updateCallItemStatus userId ct Call {chatItemId} receivedStatus msgId_ = do
|
||||
aciContent_ <- callStatusItemContent userId ct chatItemId receivedStatus
|
||||
forM_ aciContent_ $ \aciContent -> updateDirectChatItemView userId ct chatItemId aciContent msgId_
|
||||
forM_ aciContent_ $ \aciContent -> updateDirectChatItemView userId ct chatItemId aciContent False msgId_
|
||||
|
||||
updateDirectChatItemView :: ChatMonad m => UserId -> Contact -> ChatItemId -> ACIContent -> Maybe MessageId -> m ()
|
||||
updateDirectChatItemView userId ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) msgId_ = do
|
||||
updCi <- withStore $ \db -> updateDirectChatItem db userId contactId chatItemId ciContent msgId_
|
||||
updateDirectChatItemView :: ChatMonad m => UserId -> Contact -> ChatItemId -> ACIContent -> Bool -> Maybe MessageId -> m ()
|
||||
updateDirectChatItemView userId ct@Contact {contactId} chatItemId (ACIContent msgDir ciContent) itemLive msgId_ = do
|
||||
updCi <- withStore $ \db -> updateDirectChatItem db userId contactId chatItemId ciContent itemLive msgId_
|
||||
toView . CRChatItemUpdated $ AChatItem SCTDirect msgDir (DirectChat ct) updCi
|
||||
|
||||
callStatusItemContent :: ChatMonad m => UserId -> Contact -> ChatItemId -> WebRTCCallStatus -> m (Maybe ACIContent)
|
||||
@@ -1889,7 +1891,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
updateChatLock "directMessage" event
|
||||
case event of
|
||||
XMsgNew mc -> newContentMessage ct mc msg msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl _ -> messageUpdate ct sharedMsgId mContent ttl msg msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId -> messageDelete ct sharedMsgId msg msgMeta
|
||||
-- TODO discontinue XFile
|
||||
XFile fInv -> processFileInvitation' ct fInv msg msgMeta
|
||||
@@ -1943,8 +1945,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
|
||||
Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_) -> do
|
||||
forM_ mc_ $ \mc -> do
|
||||
(msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing Nothing))
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) Nothing Nothing
|
||||
(msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
|
||||
forM_ groupId_ $ \groupId -> do
|
||||
gVar <- asks idsDrg
|
||||
@@ -2095,7 +2097,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
withAckMessage agentConnId cmdId msgMeta $
|
||||
case event of
|
||||
XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl _ -> groupMessageUpdate gInfo m sharedMsgId mContent ttl msg msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg
|
||||
-- TODO discontinue XFile
|
||||
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
|
||||
@@ -2396,25 +2398,26 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
messageError = toView . CRMessageError "error"
|
||||
|
||||
newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
||||
newContentMessage ct@Contact {localDisplayName = c, contactUsed, chatSettings} mc msg msgMeta = do
|
||||
newContentMessage ct@Contact {localDisplayName = c, contactUsed, chatSettings} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
let ExtMsgContent content fileInvitation_ _ _ = mcExtMsgContent mc
|
||||
if isVoice content && not (featureAllowed SCFVoice forContact ct)
|
||||
then do
|
||||
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing
|
||||
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
|
||||
setActive $ ActiveC c
|
||||
else do
|
||||
let ExtMsgContent _ _ itemTTL _ = mcExtMsgContent mc
|
||||
let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
|
||||
timed_ = rcvMsgCITimed (contactCITimedTTL ct) itemTTL
|
||||
live = fromMaybe False live_
|
||||
ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct
|
||||
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_
|
||||
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live
|
||||
when (enableNtfs chatSettings) $ do
|
||||
showMsgToast (c <> "> ") content formattedText
|
||||
setActive $ ActiveC c
|
||||
where
|
||||
newChatItem ciContent ciFile_ timed_ = do
|
||||
ci <- saveRcvChatItemTimed user (CDDirectRcv ct) msg msgMeta ciContent ciFile_ timed_
|
||||
newChatItem ciContent ciFile_ timed_ live = do
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
pure ci
|
||||
|
||||
@@ -2431,8 +2434,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
_ -> pure (Nothing, CIFSRcvInvitation)
|
||||
pure CIFile {fileId, fileName, fileSize, filePath, fileStatus}
|
||||
|
||||
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> Maybe Int -> RcvMessage -> MsgMeta -> m ()
|
||||
messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc ttl msg@RcvMessage {msgId} msgMeta = do
|
||||
messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m ()
|
||||
messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
updateRcvChatItem `catchError` \e ->
|
||||
case e of
|
||||
@@ -2441,15 +2444,16 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
let timed_ = rcvMsgCITimed (contactCITimedTTL ct) ttl
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_ live
|
||||
toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
setActive $ ActiveC c
|
||||
_ -> throwError e
|
||||
where
|
||||
live = fromMaybe False live_
|
||||
updateRcvChatItem = do
|
||||
CChatItem msgDir ChatItem {meta = CIMeta {itemId}} <- withStore $ \db -> getDirectChatItemBySharedMsgId db userId contactId sharedMsgId
|
||||
CChatItem msgDir ChatItem {meta = CIMeta {itemId, itemLive}} <- withStore $ \db -> getDirectChatItemBySharedMsgId db userId contactId sharedMsgId
|
||||
case msgDir of
|
||||
SMDRcv -> updateDirectChatItemView userId ct itemId (ACIContent SMDRcv $ CIRcvMsgContent mc) $ Just msgId
|
||||
SMDRcv -> updateDirectChatItemView userId ct itemId (ACIContent SMDRcv $ CIRcvMsgContent mc) (live && itemLive) $ Just msgId
|
||||
SMDSnd -> messageError "x.msg.update: contact attempted invalid message update"
|
||||
|
||||
messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m ()
|
||||
@@ -2470,46 +2474,48 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete"
|
||||
|
||||
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
|
||||
newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg msgMeta = do
|
||||
newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
let (ExtMsgContent content fInv_ _ _) = mcExtMsgContent mc
|
||||
if isVoice content && not (groupFeatureAllowed SGFVoice gInfo)
|
||||
then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing
|
||||
then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing False
|
||||
else do
|
||||
let ExtMsgContent _ _ itemTTL _ = mcExtMsgContent mc
|
||||
let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
|
||||
timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) itemTTL
|
||||
live = fromMaybe False live_
|
||||
ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
|
||||
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_
|
||||
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live
|
||||
let g = groupName' gInfo
|
||||
when (enableNtfs chatSettings) $ do
|
||||
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
|
||||
setActive $ ActiveG g
|
||||
where
|
||||
newChatItem ciContent ciFile_ timed_ = do
|
||||
ci <- saveRcvChatItemTimed user (CDGroupRcv gInfo m) msg msgMeta ciContent ciFile_ timed_
|
||||
newChatItem ciContent ciFile_ timed_ live = do
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
pure ci
|
||||
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> Maybe Int -> RcvMessage -> MsgMeta -> m ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc ttl msg@RcvMessage {msgId} msgMeta =
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ =
|
||||
updateRcvChatItem `catchError` \e ->
|
||||
case e of
|
||||
(ChatErrorStore (SEChatItemSharedMsgIdNotFound _)) -> do
|
||||
-- This patches initial sharedMsgId into chat item when locally deleted chat item
|
||||
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
let timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) ttl
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_
|
||||
let timed_ = rcvMsgCITimed (groupCITimedTTL gInfo) ttl_
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed_ live
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
|
||||
setActive $ ActiveG g
|
||||
_ -> throwError e
|
||||
where
|
||||
live = fromMaybe False live_
|
||||
updateRcvChatItem = do
|
||||
CChatItem msgDir ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
CChatItem msgDir ChatItem {chatDir, meta = CIMeta {itemId, itemLive}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
case (msgDir, chatDir) of
|
||||
(SMDRcv, CIGroupRcv m') ->
|
||||
if sameMemberId memberId m'
|
||||
then do
|
||||
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CIRcvMsgContent mc) msgId
|
||||
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CIRcvMsgContent mc) (live && itemLive) msgId
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) updCi
|
||||
setActive $ ActiveG g
|
||||
else messageError "x.msg.update: group member attempted to update a message of another member" -- shouldn't happen now that query includes group member id
|
||||
@@ -2530,25 +2536,25 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
|
||||
-- TODO remove once XFile is discontinued
|
||||
processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do
|
||||
processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
chSize <- asks $ fileChunkSize . config
|
||||
inline <- receiveInlineMode fInv Nothing chSize
|
||||
RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline chSize
|
||||
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
showToast (c <> "> ") "wants to send a file"
|
||||
setActive $ ActiveC c
|
||||
|
||||
-- TODO remove once XFile is discontinued
|
||||
processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do
|
||||
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
chSize <- asks $ fileChunkSize . config
|
||||
inline <- receiveInlineMode fInv Nothing chSize
|
||||
RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline chSize
|
||||
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
let g = groupName' gInfo
|
||||
showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file"
|
||||
@@ -2699,7 +2705,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
toView $ CRUserAcceptedGroupSent gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct)
|
||||
else do
|
||||
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
|
||||
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing
|
||||
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content
|
||||
withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
toView $ CRReceivedGroupInvitation gInfo ct memRole
|
||||
@@ -2784,7 +2790,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
toView . CRCallInvitation $ RcvCallInvitation {contact = ct, callType, sharedKey, callTs = chatItemTs' ci}
|
||||
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
|
||||
where
|
||||
saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvCall status 0) Nothing
|
||||
saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvCall status 0)
|
||||
|
||||
-- to party initiating call
|
||||
xCallOffer :: Contact -> CallId -> CallOffer -> RcvMessage -> MsgMeta -> m ()
|
||||
@@ -2858,7 +2864,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
withStore' $ \db -> deleteCalls db user ctId'
|
||||
atomically $ TM.delete ctId' calls
|
||||
forM_ aciContent_ $ \aciContent ->
|
||||
updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId
|
||||
updateDirectChatItemView userId ct chatItemId aciContent False $ Just msgId
|
||||
|
||||
msgCallStateError :: Text -> Call -> m ()
|
||||
msgCallStateError eventName Call {callState} =
|
||||
@@ -2888,7 +2894,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
then messageError "x.grp.mem.new error: member already exists"
|
||||
else do
|
||||
newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile) Nothing
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRJoinedGroupMemberConnecting gInfo m newMember
|
||||
|
||||
@@ -2964,7 +2970,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
| senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions"
|
||||
| otherwise = do
|
||||
withStore' $ \db -> updateGroupMemberRole db user member memRole
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) Nothing
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent)
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView CRMemberRole {groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
|
||||
|
||||
@@ -2998,7 +3004,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
messageError "x.grp.mem.del with insufficient member permissions"
|
||||
| otherwise = a
|
||||
deleteMemberItem gEvent = do
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent) Nothing
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent)
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
|
||||
sameMemberId :: MemberId -> GroupMember -> Bool
|
||||
@@ -3009,7 +3015,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
deleteMemberConnection user m
|
||||
-- member record is not deleted to allow creation of "member left" chat item
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) Nothing
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft)
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRLeftMember gInfo m {memberStatus = GSMemLeft}
|
||||
|
||||
@@ -3022,7 +3028,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
pure members
|
||||
-- member records are not deleted to keep history
|
||||
forM_ ms $ deleteMemberConnection user
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) Nothing
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted)
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
toView $ CRGroupDeleted gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m
|
||||
|
||||
@@ -3034,7 +3040,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
toView . CRGroupUpdated g g' $ Just m
|
||||
let cd = CDGroupRcv g' m
|
||||
unless (sameGroupProfileInfo p p') $ do
|
||||
ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p') Nothing
|
||||
ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p')
|
||||
groupMsgToView g' m ci msgMeta
|
||||
createGroupFeatureChangedItems user cd CIRcvGroupFeature p p'
|
||||
|
||||
@@ -3253,37 +3259,33 @@ saveRcvMSG Connection {connId} connOrGroupId agentMsgMeta msgBody agentAckCmdId
|
||||
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
|
||||
withStore' $ \db -> createNewMessageAndRcvMsgDelivery db connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery
|
||||
|
||||
saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd)
|
||||
saveSndChatItem user cd msg content ciFile quotedItem =
|
||||
saveSndChatItemTimed user cd msg content ciFile quotedItem Nothing
|
||||
saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd)
|
||||
saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing False
|
||||
|
||||
saveSndChatItemTimed :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CITimed -> m (ChatItem c 'MDSnd)
|
||||
saveSndChatItemTimed user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem timed = do
|
||||
saveSndChatItem' :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDSnd)
|
||||
saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemTimed itemLive = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
ciId <- withStore' $ \db -> createNewSndChatItem db user cd msg content quotedItem createdAt timed
|
||||
ciId <- withStore' $ \db -> createNewSndChatItem db user cd msg content quotedItem itemTimed itemLive createdAt
|
||||
forM_ ciFile $ \CIFile {fileId} -> withStore' $ \db -> updateFileTransferChatItemId db fileId ciId
|
||||
liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) createdAt createdAt timed
|
||||
liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemTimed itemLive createdAt createdAt
|
||||
|
||||
saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> m (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem user cd msg msgMeta content ciFile =
|
||||
saveRcvChatItemTimed user cd msg msgMeta content ciFile Nothing
|
||||
saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} msgMeta content =
|
||||
saveRcvChatItem' user cd msg sharedMsgId_ msgMeta content Nothing Nothing False
|
||||
|
||||
saveRcvChatItemTimed :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> m (ChatItem c 'MDRcv)
|
||||
saveRcvChatItemTimed user cd msg@RcvMessage {sharedMsgId_} = saveRcvChatItem' user cd msg sharedMsgId_
|
||||
|
||||
saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> m (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} content ciFile timed = do
|
||||
saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} content ciFile itemTimed itemLive = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
(ciId, quotedItem) <- withStore' $ \db -> createNewRcvChatItem db user cd msg sharedMsgId_ content brokerTs createdAt timed
|
||||
(ciId, quotedItem) <- withStore' $ \db -> createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed itemLive brokerTs createdAt
|
||||
forM_ ciFile $ \CIFile {fileId} -> withStore' $ \db -> updateFileTransferChatItemId db fileId ciId
|
||||
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ brokerTs createdAt timed
|
||||
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed itemLive brokerTs createdAt
|
||||
|
||||
mkChatItem :: ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> Maybe CITimed -> IO (ChatItem c d)
|
||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemTs currentTs timed = do
|
||||
mkChatItem :: ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> UTCTime -> IO (ChatItem c d)
|
||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed itemLive itemTs currentTs = do
|
||||
tz <- getCurrentTimeZone
|
||||
let itemText = ciContentToText content
|
||||
itemStatus = ciCreateStatus content
|
||||
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId False False tz currentTs itemTs currentTs currentTs timed
|
||||
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId False False itemTimed itemLive tz currentTs itemTs currentTs currentTs
|
||||
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file}
|
||||
|
||||
deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse
|
||||
@@ -3377,7 +3379,7 @@ createInternalChatItem user cd content itemTs_ = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
let itemTs = fromMaybe createdAt itemTs_
|
||||
ciId <- withStore' $ \db -> createNewChatItemNoMsg db user cd content itemTs createdAt
|
||||
ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing itemTs createdAt Nothing
|
||||
ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs createdAt
|
||||
toView $ CRNewChatItem $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci
|
||||
|
||||
getCreateActiveUser :: SQLiteStore -> IO User
|
||||
@@ -3513,8 +3515,8 @@ chatCommandP =
|
||||
"/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
|
||||
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
|
||||
"/_get items count=" *> (APIGetChatItems <$> A.decimal),
|
||||
"/_send " *> (APISendMessage <$> chatRefP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
|
||||
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> msgContentP),
|
||||
"/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
|
||||
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
|
||||
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
|
||||
"/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))),
|
||||
"/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP),
|
||||
@@ -3669,6 +3671,7 @@ chatCommandP =
|
||||
sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> A.takeByteString
|
||||
quotedMsg = A.char '(' *> A.takeTill (== ')') <* A.char ')' <* optional A.space
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@'
|
||||
liveMessageP = " live=" *> onOffP <|> pure False
|
||||
onOffP = ("on" $> True) <|> ("off" $> False)
|
||||
userNames = do
|
||||
cName <- displayName
|
||||
|
||||
@@ -154,8 +154,8 @@ data ChatCommand
|
||||
| APIGetChats {pendingConnections :: Bool}
|
||||
| APIGetChat ChatRef ChatPagination (Maybe String)
|
||||
| APIGetChatItems Int
|
||||
| APISendMessage ChatRef ComposedMessage
|
||||
| APIUpdateChatItem ChatRef ChatItemId MsgContent
|
||||
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage}
|
||||
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
|
||||
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
|
||||
| APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
|
||||
| APIChatUnread ChatRef Bool
|
||||
|
||||
@@ -273,21 +273,22 @@ data CIMeta (d :: MsgDirection) = CIMeta
|
||||
itemSharedMsgId :: Maybe SharedMsgId,
|
||||
itemDeleted :: Bool,
|
||||
itemEdited :: Bool,
|
||||
itemTimed :: Maybe CITimed,
|
||||
itemLive :: Bool,
|
||||
editable :: Bool,
|
||||
localItemTs :: ZonedTime,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime,
|
||||
timed :: Maybe CITimed
|
||||
updatedAt :: UTCTime
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> Maybe CITimed -> CIMeta d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited tz currentTs itemTs createdAt updatedAt timed =
|
||||
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Bool -> Maybe CITimed -> Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive tz currentTs itemTs createdAt updatedAt =
|
||||
let localItemTs = utcToZonedTime tz itemTs
|
||||
editable = case itemContent of
|
||||
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && not itemDeleted
|
||||
_ -> False
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, editable, localItemTs, createdAt, updatedAt, timed}
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, localItemTs, createdAt, updatedAt}
|
||||
|
||||
instance ToJSON (CIMeta d) where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
|
||||
12
src/Simplex/Chat/Migrations/M20221214_live_message.hs
Normal file
12
src/Simplex/Chat/Migrations/M20221214_live_message.hs
Normal file
@@ -0,0 +1,12 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20221214_live_message where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20221214_live_message :: Query
|
||||
m20221214_live_message =
|
||||
[sql|
|
||||
ALTER TABLE chat_items ADD COLUMN item_live INTEGER;
|
||||
|]
|
||||
@@ -367,7 +367,8 @@ CREATE TABLE chat_items(
|
||||
quoted_member_id BLOB,
|
||||
item_edited INTEGER,
|
||||
timed_ttl INTEGER,
|
||||
timed_delete_at TEXT
|
||||
timed_delete_at TEXT,
|
||||
item_live INTEGER
|
||||
);
|
||||
CREATE TABLE chat_item_messages(
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
|
||||
@@ -367,8 +367,12 @@ parseMsgContainer v =
|
||||
where
|
||||
mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
|
||||
|
||||
extMsgContent :: MsgContent -> Maybe FileInvitation -> Maybe Int -> ExtMsgContent
|
||||
extMsgContent mc file ttl = ExtMsgContent mc file ttl Nothing
|
||||
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
|
||||
extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
|
||||
|
||||
justTrue :: Bool -> Maybe Bool
|
||||
justTrue True = Just True
|
||||
justTrue False = Nothing
|
||||
|
||||
instance FromJSON MsgContent where
|
||||
parseJSON (J.Object v) =
|
||||
|
||||
@@ -316,6 +316,7 @@ import Simplex.Chat.Migrations.M20221209_verified_connection
|
||||
import Simplex.Chat.Migrations.M20221210_idxs
|
||||
import Simplex.Chat.Migrations.M20221211_group_description
|
||||
import Simplex.Chat.Migrations.M20221212_chat_items_timed
|
||||
import Simplex.Chat.Migrations.M20221214_live_message
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
|
||||
@@ -370,7 +371,8 @@ schemaMigrations =
|
||||
("20221209_verified_connection", m20221209_verified_connection),
|
||||
("20221210_idxs", m20221210_idxs),
|
||||
("20221211_group_description", m20221211_group_description),
|
||||
("20221212_chat_items_timed", m20221212_chat_items_timed)
|
||||
("20221212_chat_items_timed", m20221212_chat_items_timed),
|
||||
("20221214_live_message", m20221214_live_message)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -3137,9 +3139,9 @@ deletePendingGroupMessage db groupMemberId messageId =
|
||||
|
||||
type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId)
|
||||
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> UTCTime -> Maybe CITimed -> IO ChatItemId
|
||||
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem createdAt =
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow createdAt createdAt
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem timed live createdAt =
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt createdAt
|
||||
where
|
||||
createdByMsgId = if msgId == 0 then Nothing else Just msgId
|
||||
quoteRow :: NewQuoteRow
|
||||
@@ -3153,9 +3155,9 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
||||
CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
|
||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||
|
||||
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> UTCTime -> UTCTime -> Maybe CITimed -> IO (ChatItemId, Maybe (CIQuote c))
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent itemTs createdAt timed = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemTs createdAt timed
|
||||
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs createdAt
|
||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||
pure (ciId, quotedItem)
|
||||
where
|
||||
@@ -3170,14 +3172,14 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar
|
||||
(Just $ Just userMemberId == memberId, memberId)
|
||||
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg db user chatDirection ciContent itemTs createdAt =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow itemTs createdAt Nothing
|
||||
createNewChatItemNoMsg db user chatDirection ciContent =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False
|
||||
where
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> UTCTime -> UTCTime -> Maybe CITimed -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemTs createdAt timed = do
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs createdAt = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
@@ -3185,18 +3187,18 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
-- 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, timed_ttl, timed_delete_at,
|
||||
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, timed_ttl, timed_delete_at, item_live,
|
||||
-- quote
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
|
||||
ciId <- insertedRowId db
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
|
||||
pure ciId
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, UTCTime, UTCTime, Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, createdAt, createdAt, timedTTL, timedDeleteAt)
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Int, Maybe UTCTime, Bool)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, timedTTL, timedDeleteAt, live)
|
||||
where
|
||||
(timedTTL, timedDeleteAt) = case timed of
|
||||
Just CITimed {ttl, deleteAt} -> (Just ttl, deleteAt)
|
||||
@@ -3303,7 +3305,7 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
-- ChatStats
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat,
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- DirectQuote
|
||||
@@ -3368,7 +3370,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
-- ChatStats
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- Maybe GroupMember - sender
|
||||
@@ -3527,7 +3529,7 @@ getDirectChatLast_ db user@User {userId} contactId count search = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- DirectQuote
|
||||
@@ -3558,7 +3560,7 @@ getDirectChatAfter_ db user@User {userId} contactId afterChatItemId count search
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- DirectQuote
|
||||
@@ -3590,7 +3592,7 @@ getDirectChatBefore_ db user@User {userId} contactId beforeChatItemId count sear
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- DirectQuote
|
||||
@@ -3834,15 +3836,15 @@ updateDirectChatItemStatus db userId contactId itemId itemStatus = do
|
||||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
|
||||
|
||||
updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem db userId contactId itemId newContent msgId_ = do
|
||||
updateDirectChatItem :: forall d. MsgDirectionI d => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> Bool -> Maybe MessageId -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem db userId contactId itemId newContent itemLive msgId_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
ci <- updateDirectChatItem_ db userId contactId itemId newContent currentTs
|
||||
ci <- updateDirectChatItem_ db userId contactId itemId newContent itemLive currentTs
|
||||
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId currentTs
|
||||
pure ci
|
||||
|
||||
updateDirectChatItem_ :: forall d. (MsgDirectionI d) => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> UTCTime -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem_ db userId contactId itemId newContent currentTs = do
|
||||
updateDirectChatItem_ :: forall d. (MsgDirectionI d) => DB.Connection -> UserId -> Int64 -> ChatItemId -> CIContent d -> Bool -> UTCTime -> ExceptT StoreError IO (ChatItem 'CTDirect d)
|
||||
updateDirectChatItem_ db userId contactId itemId newContent itemLive currentTs = do
|
||||
ci <- liftEither . correctDir =<< getDirectChatItem db userId contactId itemId
|
||||
let newText = ciContentToText newContent
|
||||
liftIO $ do
|
||||
@@ -3850,10 +3852,10 @@ updateDirectChatItem_ db userId contactId itemId newContent currentTs = do
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ?
|
||||
SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ?, item_live = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(newContent, newText, currentTs, userId, contactId, itemId)
|
||||
(newContent, newText, currentTs, itemLive, userId, contactId, itemId)
|
||||
pure ci {content = newContent, meta = (meta ci) {itemText = newText, itemEdited = True}, formattedText = parseMaybeMarkdownList newText}
|
||||
where
|
||||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
@@ -3936,7 +3938,7 @@ getDirectChatItem db userId contactId itemId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- DirectQuote
|
||||
@@ -3962,8 +3964,8 @@ getDirectChatItemIdByText db userId contactId msgDir quotedMsg =
|
||||
|]
|
||||
(userId, contactId, msgDir, quotedMsg <> "%")
|
||||
|
||||
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> MessageId -> ExceptT StoreError IO (ChatItem 'CTGroup d)
|
||||
updateGroupChatItem db user@User {userId} groupId itemId newContent msgId = do
|
||||
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItemId -> CIContent d -> Bool -> MessageId -> ExceptT StoreError IO (ChatItem 'CTGroup d)
|
||||
updateGroupChatItem db user@User {userId} groupId itemId newContent itemLive msgId = do
|
||||
ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let newText = ciContentToText newContent
|
||||
@@ -3972,10 +3974,10 @@ updateGroupChatItem db user@User {userId} groupId itemId newContent msgId = do
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ?
|
||||
SET item_content = ?, item_text = ?, item_deleted = 0, item_edited = 1, updated_at = ?, item_live = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(newContent, newText, currentTs, userId, groupId, itemId)
|
||||
(newContent, newText, currentTs, itemLive, userId, groupId, itemId)
|
||||
insertChatItemMessage_ db itemId msgId currentTs
|
||||
pure ci {content = newContent, meta = (meta ci) {itemText = newText, itemEdited = True}, formattedText = parseMaybeMarkdownList newText}
|
||||
where
|
||||
@@ -4037,7 +4039,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at,
|
||||
i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
|
||||
-- GroupMember
|
||||
@@ -4269,9 +4271,11 @@ toChatStats (unreadCount, minUnreadItemId, unreadChat) = ChatStats {unreadCount,
|
||||
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe ACIFileStatus)
|
||||
|
||||
type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime, UTCTime, Maybe Int, Maybe UTCTime) :. MaybeCIFIleRow
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
|
||||
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime, Maybe UTCTime, Maybe Int, Maybe UTCTime) :. MaybeCIFIleRow
|
||||
type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
|
||||
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
|
||||
|
||||
@@ -4285,7 +4289,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
||||
CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
|
||||
|
||||
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) =
|
||||
toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) =
|
||||
case (itemContent, itemStatus, fileStatus_) of
|
||||
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) ->
|
||||
Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent (maybeCIFile fileStatus)
|
||||
@@ -4307,7 +4311,7 @@ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStat
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file}
|
||||
badItem = Left $ SEBadChatItem itemId
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt updatedAt ciTimed
|
||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) ciTimed (fromMaybe False itemLive) tz currentTs itemTs createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed =
|
||||
case (timedTTL, timedDeleteAt) of
|
||||
@@ -4315,8 +4319,8 @@ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStat
|
||||
_ -> Nothing
|
||||
|
||||
toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
|
||||
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
@@ -4332,7 +4336,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
||||
direction _ _ = Nothing
|
||||
|
||||
toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do
|
||||
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do
|
||||
let member_ = toMaybeGroupMember userContactId memberRow_
|
||||
let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
|
||||
case (itemContent, itemStatus, member_, fileStatus_) of
|
||||
@@ -4356,7 +4360,7 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemT
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file}
|
||||
badItem = Left $ SEBadChatItem itemId
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta d
|
||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt updatedAt ciTimed
|
||||
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) ciTimed (fromMaybe False itemLive) tz currentTs itemTs createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed =
|
||||
case (timedTTL, timedDeleteAt) of
|
||||
@@ -4364,8 +4368,8 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemT
|
||||
_ -> Nothing
|
||||
|
||||
toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_)
|
||||
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_)
|
||||
toGroupChatItemList _ _ _ _ = []
|
||||
|
||||
getSMPServers :: DB.Connection -> User -> IO [ServerCfg]
|
||||
|
||||
@@ -101,7 +101,7 @@ decodeChatMessageTest :: Spec
|
||||
decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
it "x.msg.new simple text" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))
|
||||
it "x.msg.new simple text - timed message TTL" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"ttl\":3600}}"
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing))
|
||||
@@ -110,21 +110,21 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
|
||||
it "x.msg.new simple link" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing))
|
||||
it "x.msg.new simple image" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
|
||||
it "x.msg.new simple image with text" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
|
||||
it "x.msg.new chat message " $
|
||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing Nothing)))
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new quote" $
|
||||
"{\"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 (extMsgContent (MCText "hello to you too") Nothing Nothing)))
|
||||
(XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing)))
|
||||
it "x.msg.new quote - timed message TTL" $
|
||||
"{\"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\"}},\"ttl\":3600}}"
|
||||
##==## ChatMessage
|
||||
@@ -137,7 +137,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
(XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing Nothing (Just True))))
|
||||
it "x.msg.new forward" $
|
||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}"
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing Nothing))
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing))
|
||||
it "x.msg.new forward - timed message TTL" $
|
||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}"
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing))
|
||||
@@ -146,10 +146,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
|
||||
it "x.msg.new simple text with file" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})))
|
||||
it "x.msg.new simple file with file" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})))
|
||||
it "x.msg.new quote with file" $
|
||||
"{\"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\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
##==## ChatMessage
|
||||
@@ -160,13 +160,12 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
( extMsgContent
|
||||
(MCText "hello to you too")
|
||||
(Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})
|
||||
Nothing
|
||||
)
|
||||
)
|
||||
)
|
||||
it "x.msg.new forward with file" $
|
||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) Nothing))
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})))
|
||||
it "x.msg.update" $
|
||||
"{\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
#==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing
|
||||
|
||||
Reference in New Issue
Block a user