core: timed messages (#1561)

* docs: disappearing messages rfc

* change schema

* word

* wip

* wip

* todos

* todos

* remove cancel, refactor

* revert prefs

* CITimed

* schema

* time on send direct

* time on send group

* add ttl to msg container, refactor

* timed on receive

* time on read

* getTimedItems, fix tests

* mark read in terminal - view, input, output, fix tests

* refactor

* comment

* util

* insert atomically

* refactor

* use guards

* refactor startTimedItemThread

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
JRoberts 2022-12-15 15:17:29 +04:00 committed by GitHub
parent 68525b4131
commit 0e837ae392
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
15 changed files with 560 additions and 144 deletions

View file

@ -0,0 +1,106 @@
# Disappearing messages
- ability to turn on/off disappearing messages feature per conversation, specify ttl
- use preferences framework, preference affects local deletion of both sent and received messages
- special chat item on change
- in direct chat - chat item can be interacted with to agree or disagree with preference change, updates preference accordingly
- how does party that offered preference change learn about disagreement? (maybe just no preference update from contact is ok, since it's still not on if it's not mutual)
- how does it learn about disagreement on ttl? (it's on already - so it works for both but differently if there's no agreement)
- single updating chat item or per event? (probably per event is better since they can be spaced in time)
- in group - set by owner
- should it be allowed to be configured globally?
- change of setting shouldn't prevent previous disappearing messages from being deleted
## Design
- add `delete_at` field to `chat_items` table, index `idx_chat_items_delete_at`
- add `disappearingItems :: TMap ChatItemId (Async ())` to ChatController (use `Weak ThreadId`?)
- new background process that periodically scans for disappearing messages bound to be deleted during next 30 minutes:
- add `cleanupManager :: TVar (Async ())` to ChatController
- periodically gets items to schedule for deletion based on delete_at field
- for items to be deleted in next 30 minutes - add thread to disappearingItems - thread delays until deleteAt date, then deletes and sends CRChatItemDeleted to view
- for items past current time - delete in bulk
- race condition between bulk deletion of expired items on start and opening a chat with them - they should be removed from chat view once deleted - don't optimize for bulk deletion and create threads? create multiple CRs after bulk deletion? create single chat response with all ids?
- when chat item is deleted locally, either by user or via "delete for everyone" feature, kill thread and remove from map
- when MsgContent chat item is sent or marked read, add thread to disappearingItems based on chat preference
- UI shows timer based on chat item's createdAt date and deleteAt date
\***
Preference agreement:
- new preference types?
``` haskell
data DisappearingMessagesPreference = DisappearingMessagesPreference
{
allow :: FeatureAllowed,
ttl :: Int
}
data DisappearingMessagesGroupPreference = DisappearingMessagesGroupPreference
{
enable :: GroupFeatureEnabled,
ttl :: Int
}
-- requires changing functions and types using Preference and GroupPreference
```
- chat items to contain old and new preference value
\***
Maybe agreement shouldn't be via preferences framework, but ad-hoc? For example:
- new protocol messages `XMsgTtlOffer ttl`, `XMsgTtlAgree ttl`, `XMsgTtlOff`
- for direct chats on XMsgTtlOffer contact `disappearingMessages` fields is updated to
- for direct chats on XMsgTtlAgree check ttl equals offered, then turn on
- for group chats only XMsgTtlAgree has to be sent, should only be accepted from owner
- XMsgTtlOff turns off unconditionally, for group chats should only be accepted from owner
- types:
``` haskell
data DisappearingMessagesState
= DMSOff
| DMSOffered ttl
| DMSAgreed ttl
data Contact = Contact
{ ...
disappearingMessagesState :: DisappearingMessagesState,
...
}
data GroupInfo = GroupInfo
{ ...
disappearingMessagesState :: DisappearingMessagesState,
...
}
-- make part of ChatSettings?
```

View file

@ -68,6 +68,7 @@ library
Simplex.Chat.Migrations.M20221209_verified_connection
Simplex.Chat.Migrations.M20221210_idxs
Simplex.Chat.Migrations.M20221211_group_description
Simplex.Chat.Migrations.M20221212_chat_items_timed
Simplex.Chat.Mobile
Simplex.Chat.Options
Simplex.Chat.ProfileGenerator
@ -79,6 +80,7 @@ library
Simplex.Chat.Terminal.Notification
Simplex.Chat.Terminal.Output
Simplex.Chat.Types
Simplex.Chat.Util
Simplex.Chat.View
other-modules:
Paths_simplex_chat

View file

@ -55,6 +55,7 @@ import Simplex.Chat.ProfileGenerator (generateRandomProfile)
import Simplex.Chat.Protocol
import Simplex.Chat.Store
import Simplex.Chat.Types
import Simplex.Chat.Util (diffInMicros)
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), AgentDatabase (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
import Simplex.Messaging.Agent.Lock
@ -75,7 +76,7 @@ import System.FilePath (combine, splitExtensions, takeFileName)
import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
import Text.Read (readMaybe)
import UnliftIO.Async
import UnliftIO.Concurrent (forkIO, threadDelay)
import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay)
import UnliftIO.Directory
import qualified UnliftIO.Exception as E
import UnliftIO.IO (hClose, hSeek, hTell)
@ -155,7 +156,9 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
chatStoreChanged <- newTVarIO False
expireCIsAsync <- newTVarIO Nothing
expireCIs <- newTVarIO False
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIsAsync, expireCIs}
cleanupManagerAsync <- newTVarIO Nothing
timedItemThreads <- atomically TM.empty
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIsAsync, expireCIs, cleanupManagerAsync, timedItemThreads}
where
configServers :: InitialAgentServers
configServers =
@ -189,8 +192,16 @@ startChatController user subConns enableExpireCIs = do
then Just <$> async (void . runExceptT $ subscribeUserConnections Agent.subscribeConnections user)
else pure Nothing
atomically . writeTVar s $ Just (a1, a2)
startCleanupManager
when enableExpireCIs startExpireCIs
pure a1
startCleanupManager = do
cleanupAsync <- asks cleanupManagerAsync
readTVarIO cleanupAsync >>= \case
Nothing -> do
a <- Just <$> async (void . runExceptT $ cleanupManager user)
atomically $ writeTVar cleanupAsync a
_ -> pure ()
startExpireCIs = do
expireAsync <- asks expireCIsAsync
readTVarIO expireAsync >>= \case
@ -288,20 +299,25 @@ processChatCommand = \case
APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
APISendMessage (ChatRef cType chatId) (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
CTDirect -> do
ct@Contact {localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
assertDirectAllowed user MDSnd ct XMsgNew_
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
if isVoice mc && not (featureAllowed SCFVoice forUser ct)
then pure $ chatCmdError $ "feature not allowed " <> T.unpack (chatFeatureToText CFVoice)
else do
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_
timed_ <- msgTimed ct
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
case ft_ of
Just ft@FileTransferMeta {fileInline = Just IFMSent} ->
sendDirectFileInline ct ft sharedMsgId
_ -> pure ()
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_
ci <- saveSndChatItemTimed user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_
case timed_ of
Just CITimed {ttl, deleteAt = Just deleteAt} ->
when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) deleteAt
_ -> pure ()
setActive $ ActiveC c
pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
where
@ -321,9 +337,16 @@ processChatCommand = \case
_ -> pure CIFSSndStored
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
pure (fileInvitation, ciFile, ft)
prepareMsg :: Maybe FileInvitation -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
prepareMsg fileInvitation_ = case quotedItemId_ of
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_), Nothing)
msgTimed :: Contact -> m (Maybe CITimed)
msgTimed ct = case contactCITimedTTL ct of
Just ttl -> do
ts <- liftIO getCurrentTime
let deleteAt = addUTCTime (toEnum ttl) ts
pure . Just $ CITimed ttl (Just deleteAt)
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_ $ ttl_ timed_), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getDirectChatItem db userId chatId quotedItemId
@ -331,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_), Just quotedItem)
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ttl_ timed_), Just quotedItem)
where
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem {meta = CIMeta {itemDeleted = True}} = throwChatError CEInvalidQuote
@ -339,16 +362,21 @@ processChatCommand = \case
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
quoteData _ = throwChatError CEInvalidQuote
CTGroup -> do
Group gInfo@GroupInfo {membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
then pure $ chatCmdError $ "feature not allowed " <> T.unpack (groupFeatureToText GFVoice)
else do
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ membership
timed_ <- msgTimed gInfo
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_
ci <- saveSndChatItemTimed user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_
case timed_ of
Just CITimed {ttl, deleteAt = Just deleteAt} ->
when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) deleteAt
_ -> pure ()
setActive $ ActiveG gName
pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
where
@ -362,6 +390,13 @@ processChatCommand = \case
ft@FileTransferMeta {fileId} <- createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
pure (fileInvitation, ciFile, ft)
msgTimed :: GroupInfo -> m (Maybe CITimed)
msgTimed gInfo = case groupCITimedTTL gInfo of
Just ttl -> do
ts <- liftIO getCurrentTime
let deleteAt = addUTCTime (toEnum ttl) ts
pure . Just $ CITimed ttl (Just deleteAt)
Nothing -> pure Nothing
sendGroupFileInline :: [GroupMember] -> SharedMsgId -> FileTransferMeta -> m ()
sendGroupFileInline ms sharedMsgId ft@FileTransferMeta {fileInline} =
when (fileInline == Just IFMSent) . forM_ ms $ \case
@ -370,9 +405,9 @@ processChatCommand = \case
void . withStore' $ \db -> createSndGroupInlineFT db m conn ft
sendMemberFileInline m conn ft sharedMsgId
_ -> pure ()
prepareMsg :: Maybe FileInvitation -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
prepareMsg fileInvitation_ membership = case quotedItemId_ of
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_), Nothing)
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
prepareMsg fileInvitation_ timed_ membership = case quotedItemId_ of
Nothing -> pure (MCSimple (extMsgContent mc fileInvitation_ $ ttl_ timed_), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
@ -380,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_), Just quotedItem)
pure (MCQuote QuotedMsg {msgRef, content = qmc} (extMsgContent mc fileInvitation_ $ ttl_ timed_), Just quotedItem)
where
quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
quoteData ChatItem {meta = CIMeta {itemDeleted = True}} _ = throwChatError CEInvalidQuote
@ -390,6 +425,8 @@ processChatCommand = \case
CTContactRequest -> pure $ chatCmdError "not supported"
CTContactConnection -> pure $ chatCmdError "not supported"
where
ttl_ :: Maybe CITimed -> Maybe Int
ttl_ timed_ = timed_ >>= \CITimed {ttl} -> Just ttl
quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
quoteContent qmc ciFile_
| replaceContent = MCText qTextOrFile
@ -448,14 +485,14 @@ processChatCommand = \case
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user@User {userId} -> withChatLock "deleteChatItem" $ case cType of
CTDirect -> do
(ct@Contact {localDisplayName = c}, ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId}})) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
assertDirectAllowed user MDSnd ct XMsgDel_
case (mode, msgDir, itemSharedMsgId) of
(CIDMInternal, _, _) -> deleteDirectCI user ct ci True
(CIDMInternal, _, _) -> deleteDirectCI user ct ci True False
(CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
assertDirectAllowed user MDSnd ct XMsgDel_
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgDel itemSharedMId)
setActive $ ActiveC c
if featureAllowed SCFFullDelete forUser ct
then deleteDirectCI user ct ci True
then deleteDirectCI user ct ci True False
else markDirectCIDeleted user ct ci msgId True
(CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
CTGroup -> do
@ -463,19 +500,35 @@ processChatCommand = \case
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user chatId itemId
case (mode, msgDir, itemSharedMsgId) of
(CIDMInternal, _, _) -> deleteGroupCI user gInfo ci True
(CIDMInternal, _, _) -> deleteGroupCI user gInfo ci True False
(CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgDel itemSharedMId)
setActive $ ActiveG gName
if groupFeatureAllowed SGFFullDelete gInfo
then deleteGroupCI user gInfo ci True
then deleteGroupCI user gInfo ci True False
else markGroupCIDeleted user gInfo ci msgId True
(CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
CTContactRequest -> pure $ chatCmdError "not supported"
CTContactConnection -> pure $ chatCmdError "not supported"
APIChatRead (ChatRef cType chatId) fromToIds -> case cType of
CTDirect -> withStore' (\db -> updateDirectChatItemsRead db chatId fromToIds) $> CRCmdOk
CTGroup -> withStore' (\db -> updateGroupChatItemsRead db chatId fromToIds) $> CRCmdOk
APIChatRead (ChatRef cType chatId) fromToIds -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do
timedItems <- withStore' $ \db -> getDirectUnreadTimedItems db user chatId fromToIds
ts <- liftIO getCurrentTime
forM_ timedItems $ \(itemId, ttl) -> do
let deleteAt = addUTCTime (toEnum ttl) ts
withStore' $ \db -> setDirectChatItemDeleteAt db user chatId itemId deleteAt
when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTDirect chatId, itemId) deleteAt
withStore' $ \db -> updateDirectChatItemsRead db userId chatId fromToIds
pure CRChatRead
CTGroup -> do
timedItems <- withStore' $ \db -> getGroupUnreadTimedItems db user chatId fromToIds
ts <- liftIO getCurrentTime
forM_ timedItems $ \(itemId, ttl) -> do
let deleteAt = addUTCTime (toEnum ttl) ts
withStore' $ \db -> setGroupChatItemDeleteAt db user chatId itemId deleteAt
when (ttl <= cleanupManagerInterval) $ startTimedItemThread user (ChatRef CTGroup chatId, itemId) deleteAt
withStore' $ \db -> updateGroupChatItemsRead db userId chatId fromToIds
pure CRChatRead
CTContactRequest -> pure $ chatCmdError "not supported"
CTContactConnection -> pure $ chatCmdError "not supported"
APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of
@ -606,7 +659,7 @@ processChatCommand = \case
withCurrentCall contactId $ \userId ct Call {chatItemId, callState} -> case callState of
CallInvitationReceived {} -> do
let aciContent = ACIContent SMDRcv $ CIRcvCall CISCallRejected 0
withStore' $ \db -> updateDirectChatItemsRead db contactId $ Just (chatItemId, chatItemId)
withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId)
updateDirectChatItemView userId ct chatItemId aciContent Nothing $> Nothing
_ -> throwChatError . CECallState $ callStateTag callState
APISendCallOffer contactId WebRTCCallOffer {callType, rtcSession} ->
@ -618,7 +671,7 @@ processChatCommand = \case
callState' = CallOfferSent {localCallType = callType, peerCallType, localCallSession = rtcSession, sharedKey}
aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallOffer callId offer)
withStore' $ \db -> updateDirectChatItemsRead db contactId $ Just (chatItemId, chatItemId)
withStore' $ \db -> updateDirectChatItemsRead db userId contactId $ Just (chatItemId, chatItemId)
updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId
pure $ Just call {callState = callState'}
_ -> throwChatError . CECallState $ callStateTag callState
@ -866,7 +919,7 @@ processChatCommand = \case
forM_ cts $ \ct ->
void
( do
(sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
(sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing Nothing))
saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing
)
`catchError` (toView . CRChatError)
@ -1645,6 +1698,52 @@ subscribeUserConnections agentBatchSubscribe user = do
Just _ -> Nothing
_ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId
cleanupManagerInterval :: Int
cleanupManagerInterval = 1800 -- 30 minutes
cleanupManager :: forall m. ChatMonad m => User -> m ()
cleanupManager user = do
forever $ do
flip catchError (toView . CRChatError) $ do
agentStarted <- asks agentAsync
atomically $ readTVar agentStarted >>= \a -> unless (isJust a) retry
cleanupTimedItems
threadDelay $ cleanupManagerInterval * 1000000
where
cleanupTimedItems = do
ts <- liftIO getCurrentTime
let startTimedThreadCutoff = addUTCTime (toEnum cleanupManagerInterval) ts
timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff
forM_ timedItems $ uncurry (startTimedItemThread user)
startTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
startTimedItemThread user itemRef deleteAt = do
itemThreads <- asks timedItemThreads
threadTVar_ <- atomically $ do
exists <- TM.member itemRef itemThreads
if exists
then do
threadTVar <- newTVar Nothing
TM.insert itemRef threadTVar itemThreads
pure $ Just threadTVar
else pure Nothing
forM_ threadTVar_ $ \threadTVar -> do
tId <- mkWeakThreadId =<< deleteTimedItem user itemRef deleteAt `forkFinally` const (atomically $ TM.delete itemRef itemThreads)
atomically $ writeTVar threadTVar (Just tId)
deleteTimedItem :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
deleteTimedItem user@User {userId} (ChatRef cType chatId, itemId) deleteAt = do
ts <- liftIO getCurrentTime
threadDelay $ diffInMicros deleteAt ts
case cType of
CTDirect -> do
(ct, ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db userId chatId itemId
deleteDirectCI user ct ci True True >>= toView
CTGroup -> do
(gInfo, ci) <- withStore $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId
deleteGroupCI user gInfo ci True True >>= toView
_ -> toView . CRChatError . ChatError $ CEInternalError "bad deleteTimedItem cType"
expireChatItems :: forall m. ChatMonad m => User -> Int64 -> Bool -> m ()
expireChatItems user ttl sync = do
currentTs <- liftIO getCurrentTime
@ -1846,7 +1945,7 @@ 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))
(msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing Nothing))
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) Nothing Nothing
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
forM_ groupId_ $ \groupId -> do
@ -2315,9 +2414,12 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
setActive $ ActiveC c
where
newChatItem ciContent ciFile_ = do
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta ciContent ciFile_
ci <- saveRcvChatItemTimed user (CDDirectRcv ct) msg msgMeta ciContent ciFile_ timed
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
pure ci
timed = case (contactCITimedTTL ct, mcExtMsgContent mc) of
(Just _, ExtMsgContent _ _ (Just ttl) _) -> Just $ CITimed ttl Nothing
_ -> Nothing
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
@ -2341,9 +2443,11 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
-- 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...
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed
toView . CRChatItemUpdated $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
setActive $ ActiveC c
where
timed = contactCITimedTTL ct >>= \ttl -> Just $ CITimed ttl Nothing
_ -> throwError e
where
updateRcvChatItem = do
@ -2365,7 +2469,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
case msgDir of
SMDRcv ->
if featureAllowed SCFFullDelete forContact ct
then deleteDirectCI user ct ci False >>= toView
then deleteDirectCI user ct ci False False >>= toView
else markDirectCIDeleted user ct ci msgId False >>= toView
SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete"
@ -2383,9 +2487,12 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
setActive $ ActiveG g
where
newChatItem ciContent ciFile_ = do
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta ciContent ciFile_
ci <- saveRcvChatItemTimed user (CDGroupRcv gInfo m) msg msgMeta ciContent ciFile_ timed
groupMsgToView gInfo m ci msgMeta
pure ci
timed = case (groupCITimedTTL gInfo, mcExtMsgContent mc) of
(Just _, ExtMsgContent _ _ (Just ttl) _) -> Just $ CITimed ttl Nothing
_ -> Nothing
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta =
@ -2395,9 +2502,11 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
-- 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...
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing timed
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
setActive $ ActiveG g
where
timed = groupCITimedTTL gInfo >>= \ttl -> Just $ CITimed ttl Nothing
_ -> throwError e
where
updateRcvChatItem = do
@ -2420,7 +2529,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
if sameMemberId memberId m
then
if groupFeatureAllowed SGFFullDelete gInfo
then deleteGroupCI user gInfo ci False >>= toView
then deleteGroupCI user gInfo ci False False >>= toView
else markGroupCIDeleted user gInfo ci msgId False >>= toView
else messageError "x.msg.del: group member attempted to delete a message of another member" -- shouldn't happen now that query includes group member id
(SMDSnd, _) -> messageError "x.msg.del: group member attempted invalid message delete"
@ -3151,41 +3260,49 @@ saveRcvMSG Connection {connId} connOrGroupId agentMsgMeta msgBody 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@SndMessage {sharedMsgId} content ciFile quotedItem = do
saveSndChatItem user cd msg content ciFile quotedItem =
saveSndChatItemTimed user cd msg content ciFile quotedItem Nothing
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
createdAt <- liftIO getCurrentTime
ciId <- withStore' $ \db -> createNewSndChatItem db user cd msg content quotedItem createdAt
ciId <- withStore' $ \db -> createNewSndChatItem db user cd msg content quotedItem createdAt timed
forM_ ciFile $ \CIFile {fileId} -> withStore' $ \db -> updateFileTransferChatItemId db fileId ciId
liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) createdAt createdAt
liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) createdAt createdAt timed
saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> m (ChatItem c 'MDRcv)
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} = saveRcvChatItem' user cd msg sharedMsgId_
saveRcvChatItem user cd msg msgMeta content ciFile =
saveRcvChatItemTimed user cd msg msgMeta content ciFile Nothing
saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> m (ChatItem c 'MDRcv)
saveRcvChatItem' user cd msg sharedMsgId_ MsgMeta {broker = (_, brokerTs)} content ciFile = do
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
createdAt <- liftIO getCurrentTime
(ciId, quotedItem) <- withStore' $ \db -> createNewRcvChatItem db user cd msg sharedMsgId_ content brokerTs createdAt
(ciId, quotedItem) <- withStore' $ \db -> createNewRcvChatItem db user cd msg sharedMsgId_ content brokerTs createdAt timed
forM_ ciFile $ \CIFile {fileId} -> withStore' $ \db -> updateFileTransferChatItemId db fileId ciId
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ brokerTs createdAt
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ brokerTs createdAt timed
mkChatItem :: ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> IO (ChatItem c d)
mkChatItem cd ciId content file quotedItem sharedMsgId itemTs currentTs = do
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
tz <- getCurrentTimeZone
let itemText = ciContentToText content
itemStatus = ciCreateStatus content
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId False False tz currentTs itemTs currentTs currentTs
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId False False tz currentTs itemTs currentTs currentTs timed
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file}
deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> m ChatResponse
deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser = do
deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse
deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed = do
deleteCIFile user file
withStore' $ \db -> deleteDirectChatItem db user ct ci
pure $ CRChatItemDeleted (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) Nothing byUser
pure $ CRChatItemDeleted (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) Nothing byUser timed
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> m ChatResponse
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser = do
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> m ChatResponse
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed = do
deleteCIFile user file
withStore' $ \db -> deleteGroupChatItem db user gInfo ci
pure $ CRChatItemDeleted (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) Nothing byUser
pure $ CRChatItemDeleted (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) Nothing byUser timed
deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m ()
deleteCIFile user file =
@ -3196,12 +3313,12 @@ deleteCIFile user file =
markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> m ChatResponse
markDirectCIDeleted user ct ci@(CChatItem msgDir deletedItem) msgId byUser = do
toCi <- withStore' $ \db -> markDirectChatItemDeleted db user ct ci msgId
pure $ CRChatItemDeleted (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) (Just toCi) byUser
pure $ CRChatItemDeleted (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) (Just toCi) byUser False
markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> m ChatResponse
markGroupCIDeleted user gInfo ci@(CChatItem msgDir deletedItem) msgId byUser = do
toCi <- withStore' $ \db -> markGroupChatItemDeleted db user gInfo ci msgId
pure $ CRChatItemDeleted (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) (Just toCi) byUser
pure $ CRChatItemDeleted (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) (Just toCi) byUser False
createAgentConnectionAsync :: forall m c. (ChatMonad m, ConnectionModeI c) => User -> CommandFunction -> Bool -> SConnectionMode c -> m (CommandId, ConnId)
createAgentConnectionAsync user cmdFunction enableNtfs cMode = do
@ -3266,7 +3383,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
ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing itemTs createdAt Nothing
toView $ CRNewChatItem $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci
getCreateActiveUser :: SQLiteStore -> IO User

View file

@ -10,6 +10,7 @@
module Simplex.Chat.Controller where
import Control.Concurrent (ThreadId)
import Control.Concurrent.Async (Async)
import Control.Exception
import Control.Monad.Except
@ -53,6 +54,7 @@ import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags)
import Simplex.Messaging.TMap (TMap)
import Simplex.Messaging.Transport.Client (TransportHost)
import System.IO (Handle)
import System.Mem.Weak (Weak)
import UnliftIO.STM
versionNumber :: String
@ -121,7 +123,9 @@ data ChatController = ChatController
filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
incognitoMode :: TVar Bool,
expireCIsAsync :: TVar (Maybe (Async ())),
expireCIs :: TVar Bool
expireCIs :: TVar Bool,
cleanupManagerAsync :: TVar (Maybe (Async ())),
timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId)))
}
data HelpSection = HSMain | HSFiles | HSGroups | HSMyAddress | HSMarkdown | HSMessages | HSSettings
@ -292,8 +296,9 @@ data ChatResponse
| CRNewChatItem {chatItem :: AChatItem}
| CRChatItemStatusUpdated {chatItem :: AChatItem}
| CRChatItemUpdated {chatItem :: AChatItem}
| CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool}
| CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
| CRChatItemDeletedNotFound {contact :: Contact, sharedMsgId :: SharedMsgId}
| CRChatRead
| CRBroadcastSent MsgContent Int ZonedTime
| CRMsgIntegrityError {msgError :: MsgErrorType}
| CRCmdAccepted {corr :: CorrId}
@ -566,6 +571,7 @@ data ChatErrorType
| CEAgentNoSubResult {agentConnId :: AgentConnId}
| CECommandError {message :: String}
| CEAgentCommandError {message :: String}
| CEInternalError {message :: String}
deriving (Show, Exception, Generic)
instance ToJSON ChatErrorType where

View file

@ -39,13 +39,23 @@ import Simplex.Messaging.Protocol (MsgBody)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
deriving (Show, Generic)
deriving (Eq, Show, Ord, Generic)
serializeChatType :: ChatType -> String
serializeChatType = \case
CTDirect -> "@"
CTGroup -> "#"
CTContactRequest -> "?" -- this isn't being parsed
CTContactConnection -> ":"
data ChatName = ChatName ChatType Text
deriving (Show)
data ChatRef = ChatRef ChatType Int64
deriving (Show)
deriving (Eq, Show, Ord)
serializeChatRef :: ChatRef -> String
serializeChatRef (ChatRef cType chatId) = serializeChatType cType <> show chatId
instance ToJSON ChatType where
toJSON = J.genericToJSON . enumJSON $ dropPrefix "CT"
@ -66,6 +76,13 @@ chatInfoUpdatedAt = \case
ContactRequest UserContactRequest {updatedAt} -> updatedAt
ContactConnection PendingContactConnection {updatedAt} -> updatedAt
chatInfoToRef :: ChatInfo c -> ChatRef
chatInfoToRef = \case
DirectChat Contact {contactId} -> ChatRef CTDirect contactId
GroupChat GroupInfo {groupId} -> ChatRef CTGroup groupId
ContactRequest UserContactRequest {contactRequestId} -> ChatRef CTContactRequest contactRequestId
ContactConnection PendingContactConnection {pccConnId} -> ChatRef CTContactConnection pccConnId
data JSONChatInfo
= JCInfoDirect {contact :: Contact}
| JCInfoGroup {groupInfo :: GroupInfo}
@ -259,20 +276,41 @@ data CIMeta (d :: MsgDirection) = CIMeta
editable :: Bool,
localItemTs :: ZonedTime,
createdAt :: UTCTime,
updatedAt :: UTCTime
updatedAt :: UTCTime,
timed :: Maybe CITimed
}
deriving (Show, Generic)
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Bool -> Bool -> TimeZone -> UTCTime -> ChatItemTs -> UTCTime -> UTCTime -> CIMeta d
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited tz currentTs itemTs createdAt updatedAt =
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 =
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}
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, editable, localItemTs, createdAt, updatedAt, timed}
instance ToJSON (CIMeta d) where toEncoding = J.genericToEncoding J.defaultOptions
data CITimed = CITimed
{ ttl :: Int, -- seconds
deleteAt :: Maybe UTCTime
}
deriving (Show, Generic)
instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
contactCITimedTTL :: Contact -> Maybe Int
contactCITimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessages = ContactUserPreference {enabled, userPreference}}}
| forUser enabled && forContact enabled = case userPreference of
CUPContact TimedMessagesPreference {ttl = t} -> Just t
CUPUser TimedMessagesPreference {ttl = t} -> Just t
| otherwise = Nothing
groupCITimedTTL :: GroupInfo -> Maybe Int
groupCITimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
| enable == FEOn = Just ttl
| otherwise = Nothing
data CIQuote (c :: ChatType) = CIQuote
{ chatDir :: CIQDirection c,
itemId :: Maybe ChatItemId, -- Nothing in case MsgRef references the item the user did not receive yet

View file

@ -0,0 +1,16 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221212_chat_items_timed where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20221212_chat_items_timed :: Query
m20221212_chat_items_timed =
[sql|
ALTER TABLE chat_items ADD COLUMN timed_ttl INTEGER;
ALTER TABLE chat_items ADD COLUMN timed_delete_at TEXT;
CREATE INDEX idx_chat_items_timed_delete_at ON chat_items(timed_delete_at);
|]

View file

@ -365,7 +365,9 @@ CREATE TABLE chat_items(
quoted_content TEXT,
quoted_sent INTEGER,
quoted_member_id BLOB,
item_edited INTEGER
item_edited INTEGER,
timed_ttl INTEGER,
timed_delete_at TEXT
);
CREATE TABLE chat_item_messages(
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
@ -456,3 +458,4 @@ CREATE UNIQUE INDEX idx_snd_files_last_inline_msg_delivery_id ON snd_files(
CREATE INDEX idx_messages_connection_id ON messages(connection_id);
CREATE INDEX idx_chat_items_group_member_id ON chat_items(group_member_id);
CREATE INDEX idx_chat_items_contact_id ON chat_items(contact_id);
CREATE INDEX idx_chat_items_timed_delete_at ON chat_items(timed_delete_at);

View file

@ -367,8 +367,8 @@ parseMsgContainer v =
where
mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
extMsgContent :: MsgContent -> Maybe FileInvitation -> Maybe Int -> ExtMsgContent
extMsgContent mc file ttl = ExtMsgContent mc file ttl Nothing
instance FromJSON MsgContent where
parseJSON (J.Object v) =

View file

@ -208,7 +208,11 @@ module Simplex.Chat.Store
deleteGroupChatItem,
markGroupChatItemDeleted,
updateDirectChatItemsRead,
getDirectUnreadTimedItems,
setDirectChatItemDeleteAt,
updateGroupChatItemsRead,
getGroupUnreadTimedItems,
setGroupChatItemDeleteAt,
getSMPServers,
overwriteSMPServers,
createCall,
@ -222,6 +226,7 @@ module Simplex.Chat.Store
setConnConnReqInv,
getXGrpMemIntroContDirect,
getXGrpMemIntroContGroup,
getTimedItems,
getChatItemTTL,
setChatItemTTL,
getContactExpiredFileInfo,
@ -255,7 +260,7 @@ import Data.Functor (($>))
import Data.Int (Int64)
import Data.List (sortBy, sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
import Data.Ord (Down (..))
import Data.Text (Text)
import qualified Data.Text as T
@ -310,6 +315,7 @@ import Simplex.Chat.Migrations.M20221130_delete_item_deleted
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.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@ -363,7 +369,8 @@ schemaMigrations =
("20221130_delete_item_deleted", m20221130_delete_item_deleted),
("20221209_verified_connection", m20221209_verified_connection),
("20221210_idxs", m20221210_idxs),
("20221211_group_description", m20221211_group_description)
("20221211_group_description", m20221211_group_description),
("20221212_chat_items_timed", m20221212_chat_items_timed)
]
-- | The list of migrations in ascending order by date
@ -3130,7 +3137,7 @@ 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 -> IO ChatItemId
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
where
@ -3146,9 +3153,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 -> IO (ChatItemId, Maybe (CIQuote c))
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent itemTs createdAt = do
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemTs createdAt
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
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
pure (ciId, quotedItem)
where
@ -3163,14 +3170,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 =
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow
createNewChatItemNoMsg db user chatDirection ciContent itemTs createdAt =
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow itemTs createdAt Nothing
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 -> IO ChatItemId
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemTs createdAt = do
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
DB.execute
db
[sql|
@ -3178,18 +3185,22 @@ 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,
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, timed_ttl, timed_delete_at,
-- 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)
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, createdAt, createdAt)
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)
where
(timedTTL, timedDeleteAt) = case timed of
Just CITimed {ttl, deleteAt} -> (Just ttl, deleteAt)
Nothing -> (Nothing, Nothing)
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
idsRow = case chatDirection of
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
@ -3292,7 +3303,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- DirectQuote
@ -3357,7 +3368,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- Maybe GroupMember - sender
@ -3516,7 +3527,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- DirectQuote
@ -3547,7 +3558,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- DirectQuote
@ -3579,7 +3590,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- DirectQuote
@ -3925,7 +3936,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- DirectQuote
@ -4026,7 +4037,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.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,
-- CIFile
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status,
-- GroupMember
@ -4153,8 +4164,8 @@ toChatItemRef = \case
(itemId, Nothing, Just groupId) -> Right (itemId, ChatRef CTGroup groupId)
(itemId, _, _) -> Left $ SEBadChatItem itemId
updateDirectChatItemsRead :: DB.Connection -> Int64 -> Maybe (ChatItemId, ChatItemId) -> IO ()
updateDirectChatItemsRead db contactId itemsRange_ = do
updateDirectChatItemsRead :: DB.Connection -> UserId -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO ()
updateDirectChatItemsRead db userId contactId itemsRange_ = do
currentTs <- getCurrentTime
case itemsRange_ of
Just (fromItemId, toItemId) ->
@ -4162,20 +4173,48 @@ updateDirectChatItemsRead db contactId itemsRange_ = do
db
[sql|
UPDATE chat_items SET item_status = ?, updated_at = ?
WHERE contact_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
WHERE user_id = ? AND contact_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
|]
(CISRcvRead, currentTs, contactId, fromItemId, toItemId, CISRcvNew)
(userId, CISRcvRead, currentTs, contactId, fromItemId, toItemId, CISRcvNew)
_ ->
DB.execute
db
[sql|
UPDATE chat_items SET item_status = ?, updated_at = ?
WHERE contact_id = ? AND item_status = ?
WHERE user_id = ? AND contact_id = ? AND item_status = ?
|]
(CISRcvRead, currentTs, contactId, CISRcvNew)
(userId, CISRcvRead, currentTs, contactId, CISRcvNew)
updateGroupChatItemsRead :: DB.Connection -> Int64 -> Maybe (ChatItemId, ChatItemId) -> IO ()
updateGroupChatItemsRead db groupId itemsRange_ = do
getDirectUnreadTimedItems :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO [(ChatItemId, Int)]
getDirectUnreadTimedItems db User {userId} contactId itemsRange_ = case itemsRange_ of
Just (fromItemId, toItemId) ->
DB.query
db
[sql|
SELECT chat_item_id, timed_ttl
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|]
(userId, contactId, fromItemId, toItemId, CISRcvNew)
_ ->
DB.query
db
[sql|
SELECT chat_item_id, timed_ttl
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|]
(userId, contactId, CISRcvNew)
setDirectChatItemDeleteAt :: DB.Connection -> User -> ContactId -> ChatItemId -> UTCTime -> IO ()
setDirectChatItemDeleteAt db User {userId} contactId chatItemId deleteAt =
DB.execute
db
"UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?"
(deleteAt, userId, contactId, chatItemId)
updateGroupChatItemsRead :: DB.Connection -> UserId -> GroupId -> Maybe (ChatItemId, ChatItemId) -> IO ()
updateGroupChatItemsRead db userId groupId itemsRange_ = do
currentTs <- getCurrentTime
case itemsRange_ of
Just (fromItemId, toItemId) ->
@ -4183,17 +4222,45 @@ updateGroupChatItemsRead db groupId itemsRange_ = do
db
[sql|
UPDATE chat_items SET item_status = ?, updated_at = ?
WHERE group_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
WHERE user_id = ? AND group_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ?
|]
(CISRcvRead, currentTs, groupId, fromItemId, toItemId, CISRcvNew)
(userId, CISRcvRead, currentTs, groupId, fromItemId, toItemId, CISRcvNew)
_ ->
DB.execute
db
[sql|
UPDATE chat_items SET item_status = ?, updated_at = ?
WHERE group_id = ? AND item_status = ?
WHERE user_id = ? AND group_id = ? AND item_status = ?
|]
(CISRcvRead, currentTs, groupId, CISRcvNew)
(userId, CISRcvRead, currentTs, groupId, CISRcvNew)
getGroupUnreadTimedItems :: DB.Connection -> User -> GroupId -> Maybe (ChatItemId, ChatItemId) -> IO [(ChatItemId, Int)]
getGroupUnreadTimedItems db User {userId} groupId itemsRange_ = case itemsRange_ of
Just (fromItemId, toItemId) ->
DB.query
db
[sql|
SELECT chat_item_id, timed_ttl
FROM chat_items
WHERE user_id = ? AND group_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|]
(userId, groupId, fromItemId, toItemId, CISRcvNew)
_ ->
DB.query
db
[sql|
SELECT chat_item_id, timed_ttl
FROM chat_items
WHERE user_id = ? AND group_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|]
(userId, groupId, CISRcvNew)
setGroupChatItemDeleteAt :: DB.Connection -> User -> GroupId -> ChatItemId -> UTCTime -> IO ()
setGroupChatItemDeleteAt db User {userId} groupId chatItemId deleteAt =
DB.execute
db
"UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?"
(deleteAt, userId, groupId, chatItemId)
type ChatStatsRow = (Int, ChatItemId, Bool)
@ -4202,9 +4269,9 @@ 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) :. MaybeCIFIleRow
type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime, UTCTime, Maybe Int, Maybe UTCTime) :. MaybeCIFIleRow
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. MaybeCIFIleRow
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 QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
@ -4218,7 +4285,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) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) =
toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. (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)
@ -4240,11 +4307,16 @@ 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
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt updatedAt ciTimed
ciTimed :: Maybe CITimed
ciTimed =
case (timedTTL, timedDeleteAt) of
(Just ttl, deleteAt) -> Just CITimed {ttl, deleteAt}
_ -> 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) :. fileRow) :. quoteRow) =
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. 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) :. fileRow) :. quoteRow) =
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt, timedTTL, timedDeleteAt) :. fileRow) :. quoteRow)
toDirectChatItemList _ _ _ = []
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
@ -4260,7 +4332,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) :. (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) :. (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
@ -4284,11 +4356,16 @@ 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
ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt updatedAt ciTimed
ciTimed :: Maybe CITimed
ciTimed =
case (timedTTL, timedDeleteAt) of
(Just ttl, deleteAt) -> Just CITimed {ttl, deleteAt}
_ -> 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) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) =
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. 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) :. 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 _ _ _ _ = []
getSMPServers :: DB.Connection -> User -> IO [ServerCfg]
@ -4485,6 +4562,24 @@ getXGrpMemIntroContGroup db User {userId} GroupMember {groupMemberId} = do
Just connReq -> Just (hostConnId, connReq)
_ -> Nothing
getTimedItems :: DB.Connection -> User -> UTCTime -> IO [((ChatRef, ChatItemId), UTCTime)]
getTimedItems db User {userId} startTimedThreadCutoff =
catMaybes . map toCIRefDeleteAt
<$> DB.query
db
[sql|
SELECT chat_item_id, contact_id, group_id, timed_delete_at
FROM chat_items
WHERE user_id = ? AND timed_delete_at IS NOT NULL AND timed_delete_at <= ?
|]
(userId, startTimedThreadCutoff)
where
toCIRefDeleteAt :: (ChatItemId, Maybe ContactId, Maybe GroupId, UTCTime) -> Maybe ((ChatRef, ChatItemId), UTCTime)
toCIRefDeleteAt = \case
(itemId, Just contactId, Nothing, deleteAt) -> Just ((ChatRef CTDirect contactId, itemId), deleteAt)
(itemId, Nothing, Just groupId, deleteAt) -> Just ((ChatRef CTGroup groupId, itemId), deleteAt)
_ -> Nothing
getChatItemTTL :: DB.Connection -> User -> IO (Maybe Int64)
getChatItemTTL db User {userId} =
fmap join . maybeFirstRow fromOnly $ DB.query db "SELECT chat_item_ttl FROM settings WHERE user_id = ? LIMIT 1" (Only userId)

View file

@ -35,7 +35,7 @@ runInputLoop ct cc = forever $ do
s <- atomically . readTBQueue $ inputQ cc
let bs = encodeUtf8 $ T.pack s
cmd = parseChatCommand bs
unless (isMessage cmd) $ echo s
when (doEcho cmd) $ echo s
r <- runReaderT (execChatCommand bs) cc
case r of
CRChatCmdError _ -> when (isMessage cmd) $ echo s
@ -46,6 +46,9 @@ runInputLoop ct cc = forever $ do
printToTerminal ct $ responseToView user testV ts r
where
echo s = printToTerminal ct [plain s]
doEcho cmd = case cmd of
Right APIChatRead {} -> False
_ -> not $ isMessage cmd
isMessage = \case
Right SendMessage {} -> True
Right SendFile {} -> True

View file

@ -12,6 +12,7 @@ import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.Time.Clock (getCurrentTime)
import Simplex.Chat.Controller
import Simplex.Chat.Messages hiding (NewChatItem (..))
import Simplex.Chat.Styled
import Simplex.Chat.View
import System.Console.ANSI.Types
@ -74,13 +75,26 @@ withTermLock ChatTerminal {termLock} action = do
atomically $ putTMVar termLock ()
runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
runTerminalOutput ct cc = do
let testV = testView $ config cc
runTerminalOutput ct ChatController {currentUser, inputQ, outputQ, config = ChatConfig {testView}} = do
forever $ do
(_, r) <- atomically . readTBQueue $ outputQ cc
user <- readTVarIO $ currentUser cc
(_, r) <- atomically $ readTBQueue outputQ
case r of
CRNewChatItem ci -> markChatItemRead ci
CRChatItemUpdated ci -> markChatItemRead ci
_ -> pure ()
user <- readTVarIO currentUser
ts <- getCurrentTime
printToTerminal ct $ responseToView user testV ts r
printToTerminal ct $ responseToView user testView ts r
where
markChatItemRead :: AChatItem -> IO ()
markChatItemRead (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) =
case (muted chat item, itemStatus) of
(False, CISRcvNew) -> do
let itemId = chatItemId' item
chatRef = serializeChatRef $ chatInfoToRef chat
cmd = "/_read chat " <> chatRef <> " from=" <> show itemId <> " to=" <> show itemId
atomically $ writeTBQueue inputQ cmd
_ -> pure ()
printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
printToTerminal ct s =

17
src/Simplex/Chat/Util.hs Normal file
View file

@ -0,0 +1,17 @@
module Simplex.Chat.Util
( diffInMicros,
)
where
import Data.Fixed (Fixed (MkFixed), Pico)
import Data.Time (nominalDiffTimeToSeconds)
import Data.Time.Clock (UTCTime, diffUTCTime)
diffInMicros :: UTCTime -> UTCTime -> Int
diffInMicros a b = (`div` 1000000) $ diffInPicos a b
diffInPicos :: UTCTime -> UTCTime -> Int
diffInPicos a b = fromInteger . fromPico . nominalDiffTimeToSeconds $ diffUTCTime a b
fromPico :: Pico -> Integer
fromPico (MkFixed i) = i

View file

@ -82,8 +82,9 @@ responseToView user_ testView ts = \case
CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
CRChatItemStatusUpdated _ -> []
CRChatItemUpdated (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item ts
CRChatItemDeleted (AChatItem _ _ chat deletedItem) toItem byUser -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser ts
CRChatItemDeleted (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts
CRChatItemDeletedNotFound Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"]
CRChatRead -> []
CRBroadcastSent mc n t -> viewSentBroadcast mc n ts t
CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
CRCmdAccepted _ -> []
@ -251,10 +252,16 @@ responseToView user_ testView ts = \case
contactList :: [ContactRef] -> String
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
unmuted :: ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]
unmuted chat ChatItem {chatDir} s = case (chat, chatDir) of
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> []
(GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> []
_ -> s
unmuted chat chatItem s =
if muted chat chatItem
then []
else s
muted :: ChatInfo c -> ChatItem c d -> Bool
muted chat ChatItem {chatDir} = case (chat, chatDir) of
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
(GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> True
_ -> False
viewGroupSubscribed :: GroupInfo -> [StyledString]
viewGroupSubscribed g@GroupInfo {membership} =
@ -343,8 +350,9 @@ viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} ts = case chat
CIGroupSnd -> ["message updated"]
_ -> []
viewItemDelete :: ChatInfo c -> ChatItem c d -> Bool -> Bool -> CurrentTime -> [StyledString]
viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} markedDeleted byUser ts
viewItemDelete :: ChatInfo c -> ChatItem c d -> Bool -> Bool -> Bool -> CurrentTime -> [StyledString]
viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} markedDeleted byUser timed ts
| timed = []
| byUser = if markedDeleted then ["message marked deleted"] else ["message deleted"]
| otherwise = case chat of
DirectChat Contact {localDisplayName = c} -> case (chatDir, deletedContent) of
@ -421,9 +429,9 @@ viewContactsList :: [Contact] -> [StyledString]
viewContactsList =
let ldn = T.toLower . (localDisplayName :: Contact -> ContactName)
incognito ct = if contactConnIncognito ct then incognitoPrefix else ""
in map (\ct -> incognito ct <> ttyFullContact ct <> muted ct <> alias ct) . sortOn ldn
in map (\ct -> incognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn
where
muted Contact {chatSettings, localDisplayName = ldn}
muted' Contact {chatSettings, localDisplayName = ldn}
| enableNtfs chatSettings = ""
| otherwise = " (muted, you can " <> highlight ("/unmute @" <> ldn) <> ")"
alias Contact {profile = LocalProfile {localAlias}}
@ -1142,6 +1150,7 @@ viewChatError = \case
CEAgentNoSubResult connId -> ["no subscription result for connection: " <> sShow connId]
CECommandError e -> ["bad chat command: " <> plain e]
CEAgentCommandError e -> ["agent command error: " <> plain e]
CEInternalError e -> ["internal chat error: " <> plain e]
-- e -> ["chat error: " <> sShow e]
ChatErrorStore err -> case err of
SEDuplicateName -> ["this display name is already used by user, contact or group"]

View file

@ -305,11 +305,6 @@ testAddContact = versionTestMatrix2 runTestAddContact
alice #$> ("/_get chat @2 before=" <> itemId 2 <> " count=100", chat, chatFeatures <> [(1, "hello there 🙂")])
-- search
alice #$> ("/_get chat @2 count=100 search=ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")])
-- read messages
alice #$> ("/_read chat @2 from=1 to=100", id, "ok")
bob #$> ("/_read chat @2 from=1 to=100", id, "ok")
alice #$> ("/_read chat @2", id, "ok")
bob #$> ("/_read chat @2", id, "ok")
testDeleteContactDeletesProfile :: IO ()
testDeleteContactDeletesProfile =
@ -615,12 +610,6 @@ testGroupShared alice bob cath checkMessages = do
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")])
cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
cath #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "connected"), (0, "hello"), (0, "hi there"), (1, "hey team")])
alice #$> ("/_read chat #1 from=1 to=100", id, "ok")
bob #$> ("/_read chat #1 from=1 to=100", id, "ok")
cath #$> ("/_read chat #1 from=1 to=100", id, "ok")
alice #$> ("/_read chat #1", id, "ok")
bob #$> ("/_read chat #1", id, "ok")
cath #$> ("/_read chat #1", id, "ok")
alice #$> ("/_unread chat #1 on", id, "ok")
alice #$> ("/_unread chat #1 off", id, "ok")

View file

@ -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))
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing 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))
#==# 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))
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))
#==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing 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))
#==# XMsgNew (MCSimple (extMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing 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)))
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing 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)))
(XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing 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))
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing 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})))
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) 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})))
#==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) 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,12 +160,13 @@ 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})))
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}) 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