core: allow to set disappearance interval when sending message; don't check content change on live item updates (#2423)
* core: allow to set disappearance interval when sending message
* remove commented code
* enable tests
* don't check content change on live item updates
* update logic
* rename variable
* refactor, restore that received message can disabled disappearing
* refactor
* Revert "refactor"
This reverts commit 60dee29d76.
* separate event
---------
Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
spaced4ndy
GitHub
parent
635d797b2e
commit
88059a2cc5
@ -222,10 +222,11 @@ startChatController subConns enableExpireCIs startXFTPWorkers = do
|
||||
where
|
||||
start s users = do
|
||||
a1 <- timeItToView "startChatController, a1" $ async $ race_ notificationSubscriber agentSubscriber
|
||||
a2 <- timeItToView "startChatController, a2" $
|
||||
if subConns
|
||||
then Just <$> async (subscribeUsers users)
|
||||
else pure Nothing
|
||||
a2 <-
|
||||
timeItToView "startChatController, a2" $
|
||||
if subConns
|
||||
then Just <$> async (subscribeUsers users)
|
||||
else pure Nothing
|
||||
atomically . writeTVar s $ Just (a1, a2)
|
||||
when startXFTPWorkers $ do
|
||||
timeItToView "startChatController, startXFTP" $ startXFTP
|
||||
@ -471,7 +472,7 @@ processChatCommand = \case
|
||||
let CIMeta {itemTs, createdAt, updatedAt} = meta
|
||||
ciInfo = ChatItemInfo {chatItemId = itemId, itemTs, createdAt, updatedAt, itemVersions}
|
||||
pure $ CRChatItemInfo user chatItem ciInfo
|
||||
APISendMessage (ChatRef cType chatId) live (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
|
||||
APISendMessage (ChatRef cType chatId) live itemTTL (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_
|
||||
@ -480,7 +481,7 @@ processChatCommand = \case
|
||||
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFVoice))
|
||||
else do
|
||||
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
|
||||
timed_ <- sndContactCITimed live ct
|
||||
timed_ <- sndContactCITimed live ct itemTTL
|
||||
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_
|
||||
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
|
||||
case ft_ of
|
||||
@ -540,7 +541,7 @@ processChatCommand = \case
|
||||
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice))
|
||||
else do
|
||||
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
|
||||
timed_ <- sndGroupCITimed live gInfo
|
||||
timed_ <- sndGroupCITimed live gInfo itemTTL
|
||||
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
|
||||
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
|
||||
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
|
||||
@ -651,18 +652,20 @@ processChatCommand = \case
|
||||
case cci of
|
||||
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||
case (ciContent, itemSharedMsgId) of
|
||||
(CISndMsgContent oldMC, Just itemSharedMId) ->
|
||||
if mc /= oldMC
|
||||
(CISndMsgContent oldMC, Just itemSharedMId) -> do
|
||||
let changed = mc /= oldMC
|
||||
if changed || fromMaybe False itemLive
|
||||
then do
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ci' <- withStore' $ \db -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
|
||||
when changed $
|
||||
addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
|
||||
updateDirectChatItem' db user contactId ci (CISndMsgContent mc) live $ Just msgId
|
||||
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
||||
setActive $ ActiveC c
|
||||
pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci')
|
||||
else throwChatError CEInvalidChatItemUpdate
|
||||
else pure $ CRChatItemNotChanged user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
|
||||
_ -> throwChatError CEInvalidChatItemUpdate
|
||||
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
|
||||
CTGroup -> do
|
||||
@ -672,18 +675,20 @@ processChatCommand = \case
|
||||
case cci of
|
||||
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||
case (ciContent, itemSharedMsgId) of
|
||||
(CISndMsgContent oldMC, Just itemSharedMId) ->
|
||||
if mc /= oldMC
|
||||
(CISndMsgContent oldMC, Just itemSharedMId) -> do
|
||||
let changed = mc /= oldMC
|
||||
if changed || fromMaybe False itemLive
|
||||
then do
|
||||
SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ci' <- withStore' $ \db -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
|
||||
when changed $
|
||||
addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
|
||||
updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
setActive $ ActiveG gName
|
||||
pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci')
|
||||
else throwChatError CEInvalidChatItemUpdate
|
||||
else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
|
||||
_ -> throwChatError CEInvalidChatItemUpdate
|
||||
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
@ -1206,7 +1211,7 @@ processChatCommand = \case
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
|
||||
let mc = MCText msg
|
||||
processChatCommand . APISendMessage (ChatRef CTDirect contactId) False $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
processChatCommand . APISendMessage (ChatRef CTDirect contactId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
DeleteMessage chatName deletedMsg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
|
||||
@ -1404,7 +1409,7 @@ processChatCommand = \case
|
||||
groupId <- withStore $ \db -> getGroupIdByName db user gName
|
||||
quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg
|
||||
let mc = MCText msg
|
||||
processChatCommand . APISendMessage (ChatRef CTGroup groupId) False $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
processChatCommand . APISendMessage (ChatRef CTGroup groupId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
|
||||
LastChats count_ -> withUser' $ \user -> do
|
||||
chats <- withStore' $ \db -> getChatPreviews db user False
|
||||
pure $ CRChats $ maybe id take count_ chats
|
||||
@ -1436,7 +1441,7 @@ processChatCommand = \case
|
||||
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
|
||||
SendFile chatName f -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCFile "")
|
||||
processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "")
|
||||
SendImage chatName f -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
filePath <- toFSFilePath f
|
||||
@ -1444,7 +1449,7 @@ processChatCommand = \case
|
||||
fileSize <- getFileSize filePath
|
||||
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
|
||||
-- TODO include file description for preview
|
||||
processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
|
||||
processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
|
||||
ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
|
||||
ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
|
||||
SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
|
||||
@ -1784,17 +1789,18 @@ processChatCommand = \case
|
||||
sendTextMessage chatName msg live = withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
let mc = MCText msg
|
||||
processChatCommand . APISendMessage chatRef live $ ComposedMessage Nothing Nothing mc
|
||||
sndContactCITimed :: Bool -> Contact -> m (Maybe CITimed)
|
||||
sndContactCITimed live = mapM (sndCITimed_ live) . contactTimedTTL
|
||||
sndGroupCITimed :: Bool -> GroupInfo -> m (Maybe CITimed)
|
||||
sndGroupCITimed live = mapM (sndCITimed_ live) . groupTimedTTL
|
||||
sndCITimed_ :: Bool -> Int -> m CITimed
|
||||
sndCITimed_ live ttl =
|
||||
CITimed ttl
|
||||
<$> if live
|
||||
then pure Nothing
|
||||
else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime
|
||||
processChatCommand . APISendMessage chatRef live Nothing $ ComposedMessage Nothing Nothing mc
|
||||
sndContactCITimed :: Bool -> Contact -> Maybe Int -> m (Maybe CITimed)
|
||||
sndContactCITimed live = sndCITimed_ live . contactTimedTTL
|
||||
sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> m (Maybe CITimed)
|
||||
sndGroupCITimed live = sndCITimed_ live . groupTimedTTL
|
||||
sndCITimed_ :: Bool -> Maybe (Maybe Int) -> Maybe Int -> m (Maybe CITimed)
|
||||
sndCITimed_ live chatTTL itemTTL =
|
||||
forM (chatTTL >>= (itemTTL <|>)) $ \ttl ->
|
||||
CITimed ttl
|
||||
<$> if live
|
||||
then pure Nothing
|
||||
else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime
|
||||
drgRandomBytes :: Int -> m ByteString
|
||||
drgRandomBytes n = asks idsDrg >>= liftIO . (`randomBytes` n)
|
||||
privateGetUser :: UserId -> m User
|
||||
@ -3331,15 +3337,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
updateRcvChatItem = do
|
||||
cci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
||||
case cci of
|
||||
CChatItem SMDRcv ci@ChatItem {content = CIRcvMsgContent oldMC} ->
|
||||
if mc /= oldMC
|
||||
CChatItem SMDRcv ci@ChatItem {meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} -> do
|
||||
let changed = mc /= oldMC
|
||||
if changed || fromMaybe False itemLive
|
||||
then do
|
||||
ci' <- withStore' $ \db -> do
|
||||
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
|
||||
when changed $
|
||||
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
|
||||
updateDirectChatItem' db user contactId ci content live $ Just msgId
|
||||
toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci')
|
||||
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
||||
else messageError "x.msg.update: contact attempted invalid message update"
|
||||
else toView $ CRChatItemNotChanged user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
|
||||
_ -> messageError "x.msg.update: contact attempted invalid message update"
|
||||
|
||||
messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m ()
|
||||
@ -3403,16 +3411,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
updateRcvChatItem = do
|
||||
cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
case cci of
|
||||
CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', content = CIRcvMsgContent oldMC} ->
|
||||
if sameMemberId memberId m' && mc /= oldMC
|
||||
CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
|
||||
if sameMemberId memberId m'
|
||||
then do
|
||||
ci' <- withStore' $ \db -> do
|
||||
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
|
||||
updateGroupChatItem db user groupId ci content live $ Just msgId
|
||||
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||
setActive $ ActiveG g
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
else messageError "x.msg.update: group member attempted invalid message update"
|
||||
let changed = mc /= oldMC
|
||||
if changed || fromMaybe False itemLive
|
||||
then do
|
||||
ci' <- withStore' $ \db -> do
|
||||
when changed $
|
||||
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
|
||||
updateGroupChatItem db user groupId ci content live $ Just msgId
|
||||
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||
setActive $ ActiveG g
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
|
||||
else messageError "x.msg.update: group member attempted to update a message of another member"
|
||||
_ -> messageError "x.msg.update: group member attempted invalid message update"
|
||||
|
||||
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> m ()
|
||||
@ -4639,7 +4652,7 @@ chatCommandP =
|
||||
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
|
||||
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
|
||||
"/_get item info " *> (APIGetChatItemInfo <$> A.decimal),
|
||||
"/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
|
||||
"/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" 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),
|
||||
"/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal),
|
||||
@ -4833,6 +4846,7 @@ chatCommandP =
|
||||
quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@'
|
||||
liveMessageP = " live=" *> onOffP <|> pure False
|
||||
sendMessageTTLP = " ttl=" *> ((Just <$> A.decimal) <|> ("default" $> Nothing)) <|> pure Nothing
|
||||
onOffP = ("on" $> True) <|> ("off" $> False)
|
||||
profileNames = (,) <$> displayName <*> fullNameP
|
||||
newUserP = do
|
||||
|
||||
@ -214,7 +214,7 @@ data ChatCommand
|
||||
| APIGetChat ChatRef ChatPagination (Maybe String)
|
||||
| APIGetChatItems ChatPagination (Maybe String)
|
||||
| APIGetChatItemInfo ChatItemId
|
||||
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage}
|
||||
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
|
||||
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
|
||||
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
|
||||
| APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId
|
||||
@ -397,6 +397,7 @@ data ChatResponse
|
||||
| CRNewChatItem {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemStatusUpdated {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemUpdated {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemNotChanged {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
|
||||
| CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
|
||||
| CRBroadcastSent User MsgContent Int ZonedTime
|
||||
|
||||
@ -344,7 +344,7 @@ instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOpt
|
||||
|
||||
data CITimed = CITimed
|
||||
{ ttl :: Int, -- seconds
|
||||
deleteAt :: Maybe UTCTime
|
||||
deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
@ -353,16 +353,16 @@ instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
ttl' :: CITimed -> Int
|
||||
ttl' CITimed {ttl} = ttl
|
||||
|
||||
contactTimedTTL :: Contact -> Maybe Int
|
||||
contactTimedTTL :: Contact -> Maybe (Maybe Int)
|
||||
contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessages = ContactUserPreference {enabled, userPreference}}}
|
||||
| forUser enabled && forContact enabled = ttl
|
||||
| forUser enabled && forContact enabled = Just ttl
|
||||
| otherwise = Nothing
|
||||
where
|
||||
TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference)
|
||||
|
||||
groupTimedTTL :: GroupInfo -> Maybe Int
|
||||
groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
|
||||
groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
|
||||
| enable == FEOn = Just ttl
|
||||
| enable == FEOn = Just $ Just ttl
|
||||
| otherwise = Nothing
|
||||
|
||||
rcvContactCITimed :: Contact -> Maybe Int -> Maybe CITimed
|
||||
@ -371,7 +371,7 @@ rcvContactCITimed = rcvCITimed_ . contactTimedTTL
|
||||
rcvGroupCITimed :: GroupInfo -> Maybe Int -> Maybe CITimed
|
||||
rcvGroupCITimed = rcvCITimed_ . groupTimedTTL
|
||||
|
||||
rcvCITimed_ :: Maybe Int -> Maybe Int -> Maybe CITimed
|
||||
rcvCITimed_ :: Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed
|
||||
rcvCITimed_ chatTTL itemTTL = (`CITimed` Nothing) <$> (chatTTL >> itemTTL)
|
||||
|
||||
data CIQuote (c :: ChatType) = CIQuote
|
||||
|
||||
@ -89,6 +89,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case
|
||||
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated u _ -> ttyUser u []
|
||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||
CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
|
||||
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts testView
|
||||
CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts t
|
||||
@ -478,6 +479,11 @@ hideLive :: CIMeta с d -> [StyledString] -> [StyledString]
|
||||
hideLive CIMeta {itemLive = Just True} _ = []
|
||||
hideLive _ s = s
|
||||
|
||||
viewItemNotChanged :: AChatItem -> [StyledString]
|
||||
viewItemNotChanged (AChatItem _ msgDir _ _) = case msgDir of
|
||||
SMDSnd -> ["message didn't change"]
|
||||
SMDRcv -> []
|
||||
|
||||
viewItemDelete :: ChatInfo c -> ChatItem c d -> Maybe AChatItem -> Bool -> Bool -> CurrentTime -> Bool -> [StyledString]
|
||||
viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} toItem byUser timed ts testView
|
||||
| timed = [plain ("timed message deleted: " <> T.unpack (ciContentToText deletedContent)) | testView]
|
||||
|
||||
@ -34,6 +34,7 @@ chatDirectTests = do
|
||||
it "direct message edit history" testDirectMessageEditHistory
|
||||
it "direct message delete" testDirectMessageDelete
|
||||
it "direct live message" testDirectLiveMessage
|
||||
it "direct timed message" testDirectTimedMessage
|
||||
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
|
||||
it "should send multiline message" testMultilineMessage
|
||||
describe "SMP servers" $ do
|
||||
@ -228,6 +229,9 @@ testDirectMessageUpdate =
|
||||
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "hello 🙂"), Nothing), ((0, "hi alice"), Just (1, "hello 🙂"))])
|
||||
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "hello 🙂"), Nothing), ((1, "hi alice"), Just (0, "hello 🙂"))])
|
||||
|
||||
alice ##> ("/_update item @2 " <> itemId 1 <> " text hello 🙂")
|
||||
alice <## "message didn't change"
|
||||
|
||||
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey 👋")
|
||||
alice <# "@bob [edited] hey 👋"
|
||||
bob <# "alice> [edited] hey 👋"
|
||||
@ -440,6 +444,32 @@ testDirectLiveMessage =
|
||||
bob .<## ": hello 2"
|
||||
bob .<## ":"
|
||||
|
||||
testDirectTimedMessage :: HasCallStack => FilePath -> IO ()
|
||||
testDirectTimedMessage =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
|
||||
alice ##> "/_send @2 ttl=1 text hello!"
|
||||
alice <# "@bob hello!"
|
||||
bob <# "alice> hello!"
|
||||
alice <## "timed message deleted: hello!"
|
||||
bob <## "timed message deleted: hello!"
|
||||
|
||||
alice ##> "/_send @2 live=off ttl=1 text hey"
|
||||
alice <# "@bob hey"
|
||||
bob <# "alice> hey"
|
||||
alice <## "timed message deleted: hey"
|
||||
bob <## "timed message deleted: hey"
|
||||
|
||||
alice ##> "/_send @2 ttl=default text hello"
|
||||
alice <# "@bob hello"
|
||||
bob <# "alice> hello"
|
||||
|
||||
alice ##> "/_send @2 live=off text hi"
|
||||
alice <# "@bob hi"
|
||||
bob <# "alice> hi"
|
||||
|
||||
testRepeatAuthErrorsDisableContact :: HasCallStack => FilePath -> IO ()
|
||||
testRepeatAuthErrorsDisableContact =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
|
||||
@ -820,6 +820,9 @@ testGroupMessageUpdate =
|
||||
(cath <# "#team alice> hello!")
|
||||
|
||||
msgItemId1 <- lastItemId alice
|
||||
alice ##> ("/_update item #1 " <> msgItemId1 <> " text hello!")
|
||||
alice <## "message didn't change"
|
||||
|
||||
alice ##> ("/_update item #1 " <> msgItemId1 <> " text hey 👋")
|
||||
alice <# "#team [edited] hey 👋"
|
||||
concurrently_
|
||||
|
||||
Loading…
Reference in New Issue
Block a user