core: keep chat item edit history (#2410)
This commit is contained in:
parent
27762492d7
commit
c87f4e68f7
@ -4,6 +4,7 @@ module Main where
|
|||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Data.Time.Clock (getCurrentTime)
|
import Data.Time.Clock (getCurrentTime)
|
||||||
|
import Data.Time.LocalTime (getCurrentTimeZone)
|
||||||
import Server
|
import Server
|
||||||
import Simplex.Chat.Controller (versionNumber, versionString)
|
import Simplex.Chat.Controller (versionNumber, versionString)
|
||||||
import Simplex.Chat.Core
|
import Simplex.Chat.Core
|
||||||
@ -29,7 +30,8 @@ main = do
|
|||||||
else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do
|
else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do
|
||||||
r <- sendChatCmd cc chatCmd
|
r <- sendChatCmd cc chatCmd
|
||||||
ts <- getCurrentTime
|
ts <- getCurrentTime
|
||||||
putStrLn $ serializeChatResponse (Just user) ts r
|
tz <- getCurrentTimeZone
|
||||||
|
putStrLn $ serializeChatResponse (Just user) ts tz r
|
||||||
threadDelay $ chatCmdDelay opts * 1000000
|
threadDelay $ chatCmdDelay opts * 1000000
|
||||||
|
|
||||||
welcome :: ChatOpts -> IO ()
|
welcome :: ChatOpts -> IO ()
|
||||||
|
@ -94,6 +94,7 @@ library
|
|||||||
Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
|
Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
|
||||||
Simplex.Chat.Migrations.M20230422_profile_contact_links
|
Simplex.Chat.Migrations.M20230422_profile_contact_links
|
||||||
Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
|
Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
|
||||||
|
Simplex.Chat.Migrations.M20230505_chat_item_versions
|
||||||
Simplex.Chat.Mobile
|
Simplex.Chat.Mobile
|
||||||
Simplex.Chat.Mobile.WebRTC
|
Simplex.Chat.Mobile.WebRTC
|
||||||
Simplex.Chat.Options
|
Simplex.Chat.Options
|
||||||
|
@ -457,6 +457,14 @@ processChatCommand = \case
|
|||||||
APIGetChatItems pagination search -> withUser $ \user -> do
|
APIGetChatItems pagination search -> withUser $ \user -> do
|
||||||
chatItems <- withStore $ \db -> getAllChatItems db user pagination search
|
chatItems <- withStore $ \db -> getAllChatItems db user pagination search
|
||||||
pure $ CRChatItems user chatItems
|
pure $ CRChatItems user chatItems
|
||||||
|
APIGetChatItemInfo itemId -> withUser $ \user -> do
|
||||||
|
(chatItem@(AChatItem _ _ _ ChatItem {meta}), itemVersions) <- withStore $ \db -> do
|
||||||
|
ci <- getAChatItem db user itemId
|
||||||
|
versions <- liftIO $ getChatItemVersions db itemId
|
||||||
|
pure (ci, versions)
|
||||||
|
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 (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
|
||||||
CTDirect -> do
|
CTDirect -> do
|
||||||
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
|
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
|
||||||
@ -637,9 +645,12 @@ processChatCommand = \case
|
|||||||
case cci of
|
case cci of
|
||||||
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||||
case (ciContent, itemSharedMsgId) of
|
case (ciContent, itemSharedMsgId) of
|
||||||
(CISndMsgContent _, Just itemSharedMId) -> do
|
(CISndMsgContent oldMC, Just itemSharedMId) -> do
|
||||||
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
(SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||||
ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci (CISndMsgContent mc) live $ Just msgId
|
ci' <- withStore' $ \db -> do
|
||||||
|
currentTs <- liftIO getCurrentTime
|
||||||
|
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'
|
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
||||||
setActive $ ActiveC c
|
setActive $ ActiveC c
|
||||||
pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci')
|
pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci')
|
||||||
@ -652,9 +663,12 @@ processChatCommand = \case
|
|||||||
case cci of
|
case cci of
|
||||||
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive}, content = ciContent} -> do
|
||||||
case (ciContent, itemSharedMsgId) of
|
case (ciContent, itemSharedMsgId) of
|
||||||
(CISndMsgContent _, Just itemSharedMId) -> do
|
(CISndMsgContent oldMC, Just itemSharedMId) -> do
|
||||||
SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||||
ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
|
ci' <- withStore' $ \db -> do
|
||||||
|
currentTs <- liftIO getCurrentTime
|
||||||
|
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'
|
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||||
setActive $ ActiveG gName
|
setActive $ ActiveG gName
|
||||||
pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci')
|
pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci')
|
||||||
@ -1402,6 +1416,10 @@ processChatCommand = \case
|
|||||||
ShowChatItem Nothing -> withUser $ \user -> do
|
ShowChatItem Nothing -> withUser $ \user -> do
|
||||||
chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing
|
chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing
|
||||||
pure $ CRChatItems user chatItems
|
pure $ CRChatItems user chatItems
|
||||||
|
ShowChatItemInfo chatName msg -> withUser $ \user -> do
|
||||||
|
chatRef <- getChatRef user chatName
|
||||||
|
itemId <- getChatItemIdByText user chatRef msg
|
||||||
|
processChatCommand $ APIGetChatItemInfo itemId
|
||||||
ShowLiveItems on -> withUser $ \_ ->
|
ShowLiveItems on -> withUser $ \_ ->
|
||||||
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
|
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
|
||||||
SendFile chatName f -> withUser $ \user -> do
|
SendFile chatName f -> withUser $ \user -> do
|
||||||
@ -1582,6 +1600,11 @@ processChatCommand = \case
|
|||||||
CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg
|
CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg
|
||||||
CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg
|
CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg
|
||||||
_ -> throwChatError $ CECommandError "not supported"
|
_ -> throwChatError $ CECommandError "not supported"
|
||||||
|
getChatItemIdByText :: User -> ChatRef -> Text -> m Int64
|
||||||
|
getChatItemIdByText user (ChatRef cType cId) msg = case cType of
|
||||||
|
CTDirect -> withStore $ \db -> getDirectChatItemIdByText' db user cId msg
|
||||||
|
CTGroup -> withStore $ \db -> getGroupChatItemIdByText' db user cId msg
|
||||||
|
_ -> throwChatError $ CECommandError "not supported"
|
||||||
connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
||||||
connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
|
connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
|
||||||
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
||||||
@ -3283,21 +3306,26 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||||
let timed_ = rcvContactCITimed ct ttl
|
let timed_ = rcvContactCITimed ct ttl
|
||||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
||||||
ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci content live Nothing
|
ci' <- withStore' $ \db -> do
|
||||||
|
createChatItemVersion db (chatItemId' ci) brokerTs mc
|
||||||
|
updateDirectChatItem' db user contactId ci content live Nothing
|
||||||
toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci')
|
toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci')
|
||||||
setActive $ ActiveC c
|
setActive $ ActiveC c
|
||||||
_ -> throwError e
|
_ -> throwError e
|
||||||
where
|
where
|
||||||
|
MsgMeta {broker = (_, brokerTs)} = msgMeta
|
||||||
content = CIRcvMsgContent mc
|
content = CIRcvMsgContent mc
|
||||||
live = fromMaybe False live_
|
live = fromMaybe False live_
|
||||||
updateRcvChatItem = do
|
updateRcvChatItem = do
|
||||||
CChatItem msgDir ci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
cci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId
|
||||||
case msgDir of
|
case cci of
|
||||||
SMDRcv -> do
|
CChatItem SMDRcv ci@ChatItem {content = CIRcvMsgContent oldMC} -> do
|
||||||
ci' <- withStore' $ \db -> updateDirectChatItem' db user contactId ci content live $ Just msgId
|
ci' <- withStore' $ \db -> do
|
||||||
|
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')
|
toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci')
|
||||||
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci'
|
||||||
SMDSnd -> messageError "x.msg.update: contact attempted invalid message update"
|
_ -> messageError "x.msg.update: contact attempted invalid message update"
|
||||||
|
|
||||||
messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m ()
|
messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m ()
|
||||||
messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do
|
messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do
|
||||||
@ -3347,25 +3375,30 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||||
let timed_ = rcvGroupCITimed gInfo ttl_
|
let timed_ = rcvGroupCITimed gInfo ttl_
|
||||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live
|
||||||
ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci content live Nothing
|
ci' <- withStore' $ \db -> do
|
||||||
|
createChatItemVersion db (chatItemId' ci) brokerTs mc
|
||||||
|
updateGroupChatItem db user groupId ci content live Nothing
|
||||||
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||||
setActive $ ActiveG g
|
setActive $ ActiveG g
|
||||||
_ -> throwError e
|
_ -> throwError e
|
||||||
where
|
where
|
||||||
|
MsgMeta {broker = (_, brokerTs)} = msgMeta
|
||||||
content = CIRcvMsgContent mc
|
content = CIRcvMsgContent mc
|
||||||
live = fromMaybe False live_
|
live = fromMaybe False live_
|
||||||
updateRcvChatItem = do
|
updateRcvChatItem = do
|
||||||
CChatItem msgDir ci@ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||||
case (msgDir, chatDir) of
|
case cci of
|
||||||
(SMDRcv, CIGroupRcv m') ->
|
CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', content = CIRcvMsgContent oldMC} -> do
|
||||||
if sameMemberId memberId m'
|
if sameMemberId memberId m'
|
||||||
then do
|
then do
|
||||||
ci' <- withStore' $ \db -> updateGroupChatItem db user groupId ci content live $ Just msgId
|
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')
|
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||||
setActive $ ActiveG g
|
setActive $ ActiveG g
|
||||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||||
else messageError "x.msg.update: group member attempted to update a message of another member" -- shouldn't happen now that query includes group member id
|
else messageError "x.msg.update: group member attempted to update a message of another member" -- shouldn't happen now that query includes group member id
|
||||||
(SMDSnd, _) -> messageError "x.msg.update: group member attempted invalid message update"
|
_ -> messageError "x.msg.update: group member attempted invalid message update"
|
||||||
|
|
||||||
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> m ()
|
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> m ()
|
||||||
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} = do
|
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} = do
|
||||||
@ -4594,6 +4627,7 @@ chatCommandP =
|
|||||||
"/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
|
"/_get chats " *> (APIGetChats <$> A.decimal <*> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False)),
|
||||||
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
|
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
|
||||||
"/_get items " *> (APIGetChatItems <$> 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 <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
|
||||||
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
|
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
|
||||||
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
|
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
|
||||||
@ -4723,6 +4757,7 @@ chatCommandP =
|
|||||||
"/last_item_id" *> (LastChatItemId <$> optional (A.space *> chatNameP) <*> (A.space *> A.decimal <|> pure 0)),
|
"/last_item_id" *> (LastChatItemId <$> optional (A.space *> chatNameP) <*> (A.space *> A.decimal <|> pure 0)),
|
||||||
"/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)),
|
"/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)),
|
||||||
"/show " *> (ShowChatItem . Just <$> A.decimal),
|
"/show " *> (ShowChatItem . Just <$> A.decimal),
|
||||||
|
"/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP),
|
||||||
("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath),
|
("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath),
|
||||||
("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
|
("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
|
||||||
("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
|
("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
|
||||||
|
@ -213,6 +213,7 @@ data ChatCommand
|
|||||||
| APIGetChats {userId :: UserId, pendingConnections :: Bool}
|
| APIGetChats {userId :: UserId, pendingConnections :: Bool}
|
||||||
| APIGetChat ChatRef ChatPagination (Maybe String)
|
| APIGetChat ChatRef ChatPagination (Maybe String)
|
||||||
| APIGetChatItems ChatPagination (Maybe String)
|
| APIGetChatItems ChatPagination (Maybe String)
|
||||||
|
| APIGetChatItemInfo ChatItemId
|
||||||
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage}
|
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage}
|
||||||
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
|
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
|
||||||
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
|
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
|
||||||
@ -341,6 +342,7 @@ data ChatCommand
|
|||||||
| LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI)
|
| LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI)
|
||||||
| LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI)
|
| LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI)
|
||||||
| ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
|
| ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
|
||||||
|
| ShowChatItemInfo ChatName Text
|
||||||
| ShowLiveItems Bool
|
| ShowLiveItems Bool
|
||||||
| SendFile ChatName FilePath
|
| SendFile ChatName FilePath
|
||||||
| SendImage ChatName FilePath
|
| SendImage ChatName FilePath
|
||||||
@ -378,6 +380,7 @@ data ChatResponse
|
|||||||
| CRChats {chats :: [AChat]}
|
| CRChats {chats :: [AChat]}
|
||||||
| CRApiChat {user :: User, chat :: AChat}
|
| CRApiChat {user :: User, chat :: AChat}
|
||||||
| CRChatItems {user :: User, chatItems :: [AChatItem]}
|
| CRChatItems {user :: User, chatItems :: [AChatItem]}
|
||||||
|
| CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
|
||||||
| CRChatItemId User (Maybe ChatItemId)
|
| CRChatItemId User (Maybe ChatItemId)
|
||||||
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
|
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
|
||||||
| CRUserProtoServers {user :: User, servers :: AUserProtoServers}
|
| CRUserProtoServers {user :: User, servers :: AUserProtoServers}
|
||||||
|
@ -1451,3 +1451,24 @@ jsonCIDeleted :: CIDeleted d -> JSONCIDeleted
|
|||||||
jsonCIDeleted = \case
|
jsonCIDeleted = \case
|
||||||
CIDeleted -> JCIDDeleted
|
CIDeleted -> JCIDDeleted
|
||||||
CIModerated m -> JCIDModerated m
|
CIModerated m -> JCIDModerated m
|
||||||
|
|
||||||
|
data ChatItemInfo = ChatItemInfo
|
||||||
|
{ chatItemId :: ChatItemId,
|
||||||
|
itemTs :: UTCTime,
|
||||||
|
createdAt :: UTCTime,
|
||||||
|
updatedAt :: UTCTime,
|
||||||
|
itemVersions :: [ChatItemVersion]
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance ToJSON ChatItemInfo where toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
|
||||||
|
data ChatItemVersion = ChatItemVersion
|
||||||
|
{ chatItemVersionId :: Int64,
|
||||||
|
msgContent :: MsgContent,
|
||||||
|
itemVersionTs :: UTCTime,
|
||||||
|
createdAt :: UTCTime
|
||||||
|
}
|
||||||
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance ToJSON ChatItemVersion where toEncoding = J.genericToEncoding J.defaultOptions
|
||||||
|
29
src/Simplex/Chat/Migrations/M20230505_chat_item_versions.hs
Normal file
29
src/Simplex/Chat/Migrations/M20230505_chat_item_versions.hs
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
|
module Simplex.Chat.Migrations.M20230505_chat_item_versions where
|
||||||
|
|
||||||
|
import Database.SQLite.Simple (Query)
|
||||||
|
import Database.SQLite.Simple.QQ (sql)
|
||||||
|
|
||||||
|
m20230505_chat_item_versions :: Query
|
||||||
|
m20230505_chat_item_versions =
|
||||||
|
[sql|
|
||||||
|
CREATE TABLE chat_item_versions ( -- contains versions only for edited chat items, including current version
|
||||||
|
chat_item_version_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||||
|
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||||
|
msg_content TEXT NOT NULL,
|
||||||
|
item_version_ts TEXT NOT NULL,
|
||||||
|
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||||
|
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||||
|
);
|
||||||
|
|
||||||
|
CREATE INDEX idx_chat_item_versions_chat_item_id ON chat_item_versions(chat_item_id);
|
||||||
|
|]
|
||||||
|
|
||||||
|
down_m20230505_chat_item_versions :: Query
|
||||||
|
down_m20230505_chat_item_versions =
|
||||||
|
[sql|
|
||||||
|
DROP INDEX idx_chat_item_versions_chat_item_id;
|
||||||
|
|
||||||
|
DROP TABLE chat_item_versions;
|
||||||
|
|]
|
@ -454,6 +454,15 @@ CREATE TABLE msg_delivery_events(
|
|||||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||||
);
|
);
|
||||||
|
CREATE TABLE chat_item_versions(
|
||||||
|
-- contains versions only for edited chat items, including current version
|
||||||
|
chat_item_version_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||||
|
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||||
|
msg_content TEXT NOT NULL,
|
||||||
|
item_version_ts TEXT NOT NULL,
|
||||||
|
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||||
|
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||||
|
);
|
||||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||||
display_name,
|
display_name,
|
||||||
full_name
|
full_name
|
||||||
@ -595,3 +604,6 @@ CREATE INDEX idx_extra_xftp_file_descriptions_user_id ON extra_xftp_file_descrip
|
|||||||
CREATE INDEX idx_xftp_file_descriptions_user_id ON xftp_file_descriptions(
|
CREATE INDEX idx_xftp_file_descriptions_user_id ON xftp_file_descriptions(
|
||||||
user_id
|
user_id
|
||||||
);
|
);
|
||||||
|
CREATE INDEX idx_chat_item_versions_chat_item_id ON chat_item_versions(
|
||||||
|
chat_item_id
|
||||||
|
);
|
||||||
|
@ -358,6 +358,9 @@ msgContentText = \case
|
|||||||
MCFile t -> t
|
MCFile t -> t
|
||||||
MCUnknown {text} -> text
|
MCUnknown {text} -> text
|
||||||
|
|
||||||
|
toMCText :: MsgContent -> MsgContent
|
||||||
|
toMCText = MCText . msgContentText
|
||||||
|
|
||||||
durationText :: Int -> Text
|
durationText :: Int -> Text
|
||||||
durationText duration =
|
durationText duration =
|
||||||
let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
|
let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
|
||||||
|
@ -226,6 +226,7 @@ module Simplex.Chat.Store
|
|||||||
getGroupChat,
|
getGroupChat,
|
||||||
getAllChatItems,
|
getAllChatItems,
|
||||||
getAChatItem,
|
getAChatItem,
|
||||||
|
getChatItemVersions,
|
||||||
getChatItemIdByAgentMsgId,
|
getChatItemIdByAgentMsgId,
|
||||||
getDirectChatItem,
|
getDirectChatItem,
|
||||||
getDirectChatItemBySharedMsgId,
|
getDirectChatItemBySharedMsgId,
|
||||||
@ -236,13 +237,17 @@ module Simplex.Chat.Store
|
|||||||
getGroupMemberCIBySharedMsgId,
|
getGroupMemberCIBySharedMsgId,
|
||||||
getGroupMemberChatItemLast,
|
getGroupMemberChatItemLast,
|
||||||
getDirectChatItemIdByText,
|
getDirectChatItemIdByText,
|
||||||
|
getDirectChatItemIdByText',
|
||||||
getGroupChatItemIdByText,
|
getGroupChatItemIdByText,
|
||||||
|
getGroupChatItemIdByText',
|
||||||
getChatItemByFileId,
|
getChatItemByFileId,
|
||||||
getChatItemByGroupId,
|
getChatItemByGroupId,
|
||||||
updateDirectChatItemStatus,
|
updateDirectChatItemStatus,
|
||||||
updateDirectCIFileStatus,
|
updateDirectCIFileStatus,
|
||||||
updateDirectChatItem,
|
updateDirectChatItem,
|
||||||
updateDirectChatItem',
|
updateDirectChatItem',
|
||||||
|
addInitialAndNewCIVersions,
|
||||||
|
createChatItemVersion,
|
||||||
deleteDirectChatItem,
|
deleteDirectChatItem,
|
||||||
markDirectChatItemDeleted,
|
markDirectChatItemDeleted,
|
||||||
updateGroupChatItem,
|
updateGroupChatItem,
|
||||||
@ -377,6 +382,7 @@ import Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions
|
|||||||
import Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
|
import Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
|
||||||
import Simplex.Chat.Migrations.M20230422_profile_contact_links
|
import Simplex.Chat.Migrations.M20230422_profile_contact_links
|
||||||
import Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
|
import Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
|
||||||
|
import Simplex.Chat.Migrations.M20230505_chat_item_versions
|
||||||
import Simplex.Chat.Protocol
|
import Simplex.Chat.Protocol
|
||||||
import Simplex.Chat.Types
|
import Simplex.Chat.Types
|
||||||
import Simplex.Chat.Util (week)
|
import Simplex.Chat.Util (week)
|
||||||
@ -453,7 +459,8 @@ schemaMigrations =
|
|||||||
("20230411_extra_xftp_file_descriptions", m20230411_extra_xftp_file_descriptions, Just down_m20230411_extra_xftp_file_descriptions),
|
("20230411_extra_xftp_file_descriptions", m20230411_extra_xftp_file_descriptions, Just down_m20230411_extra_xftp_file_descriptions),
|
||||||
("20230420_rcv_files_to_receive", m20230420_rcv_files_to_receive, Just down_m20230420_rcv_files_to_receive),
|
("20230420_rcv_files_to_receive", m20230420_rcv_files_to_receive, Just down_m20230420_rcv_files_to_receive),
|
||||||
("20230422_profile_contact_links", m20230422_profile_contact_links, Just down_m20230422_profile_contact_links),
|
("20230422_profile_contact_links", m20230422_profile_contact_links, Just down_m20230422_profile_contact_links),
|
||||||
("20230504_recreate_msg_delivery_events_cleanup_messages", m20230504_recreate_msg_delivery_events_cleanup_messages, Just down_m20230504_recreate_msg_delivery_events_cleanup_messages)
|
("20230504_recreate_msg_delivery_events_cleanup_messages", m20230504_recreate_msg_delivery_events_cleanup_messages, Just down_m20230504_recreate_msg_delivery_events_cleanup_messages),
|
||||||
|
("20230505_chat_item_versions", m20230505_chat_item_versions, Just down_m20230505_chat_item_versions)
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | The list of migrations in ascending order by date
|
-- | The list of migrations in ascending order by date
|
||||||
@ -4399,10 +4406,35 @@ updateDirectChatItem_ db userId contactId ChatItem {meta, content} msgId_ = do
|
|||||||
((content, itemText, itemStatus, itemDeleted', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
|
((content, itemText, itemStatus, itemDeleted', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
|
||||||
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId updatedAt
|
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId updatedAt
|
||||||
|
|
||||||
|
addInitialAndNewCIVersions :: DB.Connection -> ChatItemId -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
|
||||||
|
addInitialAndNewCIVersions db itemId (initialTs, initialMC) (newTs, newMC) = do
|
||||||
|
versionsCount <- getChatItemVersionsCount db itemId
|
||||||
|
when (versionsCount == 0) $
|
||||||
|
createChatItemVersion db itemId initialTs initialMC
|
||||||
|
createChatItemVersion db itemId newTs newMC
|
||||||
|
|
||||||
|
getChatItemVersionsCount :: DB.Connection -> ChatItemId -> IO Int
|
||||||
|
getChatItemVersionsCount db itemId = do
|
||||||
|
count <-
|
||||||
|
maybeFirstRow fromOnly $
|
||||||
|
DB.query db "SELECT COUNT(1) FROM chat_item_versions WHERE chat_item_id = ?" (Only itemId)
|
||||||
|
pure $ fromMaybe 0 count
|
||||||
|
|
||||||
|
createChatItemVersion :: DB.Connection -> ChatItemId -> UTCTime -> MsgContent -> IO ()
|
||||||
|
createChatItemVersion db itemId itemVersionTs msgContent =
|
||||||
|
DB.execute
|
||||||
|
db
|
||||||
|
[sql|
|
||||||
|
INSERT INTO chat_item_versions (chat_item_id, msg_content, item_version_ts)
|
||||||
|
VALUES (?,?,?)
|
||||||
|
|]
|
||||||
|
(itemId, toMCText msgContent, itemVersionTs)
|
||||||
|
|
||||||
deleteDirectChatItem :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO ()
|
deleteDirectChatItem :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO ()
|
||||||
deleteDirectChatItem db User {userId} Contact {contactId} (CChatItem _ ci) = do
|
deleteDirectChatItem db User {userId} Contact {contactId} (CChatItem _ ci) = do
|
||||||
let itemId = chatItemId' ci
|
let itemId = chatItemId' ci
|
||||||
deleteChatItemMessages_ db itemId
|
deleteChatItemMessages_ db itemId
|
||||||
|
deleteChatItemVersions_ db itemId
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
[sql|
|
[sql|
|
||||||
@ -4425,6 +4457,10 @@ deleteChatItemMessages_ db itemId =
|
|||||||
|]
|
|]
|
||||||
(Only itemId)
|
(Only itemId)
|
||||||
|
|
||||||
|
deleteChatItemVersions_ :: DB.Connection -> ChatItemId -> IO ()
|
||||||
|
deleteChatItemVersions_ db itemId =
|
||||||
|
DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id = ?" (Only itemId)
|
||||||
|
|
||||||
markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> MessageId -> IO ()
|
markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> MessageId -> IO ()
|
||||||
markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) msgId = do
|
markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) msgId = do
|
||||||
currentTs <- liftIO getCurrentTime
|
currentTs <- liftIO getCurrentTime
|
||||||
@ -4489,18 +4525,32 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
|||||||
|
|
||||||
getDirectChatItemIdByText :: DB.Connection -> UserId -> Int64 -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId
|
getDirectChatItemIdByText :: DB.Connection -> UserId -> Int64 -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId
|
||||||
getDirectChatItemIdByText db userId contactId msgDir quotedMsg =
|
getDirectChatItemIdByText db userId contactId msgDir quotedMsg =
|
||||||
ExceptT . firstRow fromOnly SEQuotedChatItemNotFound $
|
ExceptT . firstRow fromOnly (SEChatItemNotFoundByText quotedMsg) $
|
||||||
DB.query
|
DB.query
|
||||||
db
|
db
|
||||||
[sql|
|
[sql|
|
||||||
SELECT chat_item_id
|
SELECT chat_item_id
|
||||||
FROM chat_items
|
FROM chat_items
|
||||||
WHERE user_id = ? AND contact_id = ? AND item_sent = ? AND item_text like ?
|
WHERE user_id = ? AND contact_id = ? AND item_sent = ? AND item_text LIKE ?
|
||||||
ORDER BY chat_item_id DESC
|
ORDER BY chat_item_id DESC
|
||||||
LIMIT 1
|
LIMIT 1
|
||||||
|]
|
|]
|
||||||
(userId, contactId, msgDir, quotedMsg <> "%")
|
(userId, contactId, msgDir, quotedMsg <> "%")
|
||||||
|
|
||||||
|
getDirectChatItemIdByText' :: DB.Connection -> User -> ContactId -> Text -> ExceptT StoreError IO ChatItemId
|
||||||
|
getDirectChatItemIdByText' db User {userId} contactId msg =
|
||||||
|
ExceptT . firstRow fromOnly (SEChatItemNotFoundByText msg) $
|
||||||
|
DB.query
|
||||||
|
db
|
||||||
|
[sql|
|
||||||
|
SELECT chat_item_id
|
||||||
|
FROM chat_items
|
||||||
|
WHERE user_id = ? AND contact_id = ? AND item_text LIKE ?
|
||||||
|
ORDER BY chat_item_id DESC
|
||||||
|
LIMIT 1
|
||||||
|
|]
|
||||||
|
(userId, contactId, msg <> "%")
|
||||||
|
|
||||||
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
|
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
|
||||||
updateGroupChatItem db user groupId ci newContent live msgId_ = do
|
updateGroupChatItem db user groupId ci newContent live msgId_ = do
|
||||||
currentTs <- liftIO getCurrentTime
|
currentTs <- liftIO getCurrentTime
|
||||||
@ -4528,6 +4578,7 @@ deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup
|
|||||||
deleteGroupChatItem db User {userId} GroupInfo {groupId} (CChatItem _ ci) = do
|
deleteGroupChatItem db User {userId} GroupInfo {groupId} (CChatItem _ ci) = do
|
||||||
let itemId = chatItemId' ci
|
let itemId = chatItemId' ci
|
||||||
deleteChatItemMessages_ db itemId
|
deleteChatItemMessages_ db itemId
|
||||||
|
deleteChatItemVersions_ db itemId
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
[sql|
|
[sql|
|
||||||
@ -4543,6 +4594,7 @@ updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatIt
|
|||||||
toText = ciModeratedText
|
toText = ciModeratedText
|
||||||
itemId = chatItemId' ci
|
itemId = chatItemId' ci
|
||||||
deleteChatItemMessages_ db itemId
|
deleteChatItemMessages_ db itemId
|
||||||
|
deleteChatItemVersions_ db itemId
|
||||||
liftIO $
|
liftIO $
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
@ -4648,9 +4700,9 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
|||||||
|]
|
|]
|
||||||
(userId, groupId, itemId)
|
(userId, groupId, itemId)
|
||||||
|
|
||||||
getGroupChatItemIdByText :: DB.Connection -> User -> Int64 -> Maybe ContactName -> Text -> ExceptT StoreError IO ChatItemId
|
getGroupChatItemIdByText :: DB.Connection -> User -> GroupId -> Maybe ContactName -> Text -> ExceptT StoreError IO ChatItemId
|
||||||
getGroupChatItemIdByText db User {userId, localDisplayName = userName} groupId contactName_ quotedMsg =
|
getGroupChatItemIdByText db User {userId, localDisplayName = userName} groupId contactName_ quotedMsg =
|
||||||
ExceptT . firstRow fromOnly SEQuotedChatItemNotFound $ case contactName_ of
|
ExceptT . firstRow fromOnly (SEChatItemNotFoundByText quotedMsg) $ case contactName_ of
|
||||||
Nothing -> anyMemberChatItem_
|
Nothing -> anyMemberChatItem_
|
||||||
Just cName
|
Just cName
|
||||||
| userName == cName -> userChatItem_
|
| userName == cName -> userChatItem_
|
||||||
@ -4692,6 +4744,20 @@ getGroupChatItemIdByText db User {userId, localDisplayName = userName} groupId c
|
|||||||
|]
|
|]
|
||||||
(userId, groupId, cName, quotedMsg <> "%")
|
(userId, groupId, cName, quotedMsg <> "%")
|
||||||
|
|
||||||
|
getGroupChatItemIdByText' :: DB.Connection -> User -> GroupId -> Text -> ExceptT StoreError IO ChatItemId
|
||||||
|
getGroupChatItemIdByText' db User {userId} groupId msg =
|
||||||
|
ExceptT . firstRow fromOnly (SEChatItemNotFoundByText msg) $
|
||||||
|
DB.query
|
||||||
|
db
|
||||||
|
[sql|
|
||||||
|
SELECT chat_item_id
|
||||||
|
FROM chat_items
|
||||||
|
WHERE user_id = ? AND group_id = ? AND item_text like ?
|
||||||
|
ORDER BY chat_item_id DESC
|
||||||
|
LIMIT 1
|
||||||
|
|]
|
||||||
|
(userId, groupId, msg <> "%")
|
||||||
|
|
||||||
getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem
|
getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem
|
||||||
getChatItemByFileId db user@User {userId} fileId = do
|
getChatItemByFileId db user@User {userId} fileId = do
|
||||||
(itemId, chatRef) <-
|
(itemId, chatRef) <-
|
||||||
@ -4748,6 +4814,22 @@ getAChatItem_ db user itemId = \case
|
|||||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci
|
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci
|
||||||
_ -> throwError $ SEChatItemNotFound itemId
|
_ -> throwError $ SEChatItemNotFound itemId
|
||||||
|
|
||||||
|
getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion]
|
||||||
|
getChatItemVersions db itemId = do
|
||||||
|
map toChatItemVersion
|
||||||
|
<$> DB.query
|
||||||
|
db
|
||||||
|
[sql|
|
||||||
|
SELECT chat_item_version_id, msg_content, item_version_ts, created_at
|
||||||
|
FROM chat_item_versions
|
||||||
|
WHERE chat_item_id = ?
|
||||||
|
ORDER BY chat_item_version_id DESC
|
||||||
|
|]
|
||||||
|
(Only itemId)
|
||||||
|
where
|
||||||
|
toChatItemVersion :: (Int64, MsgContent, UTCTime, UTCTime) -> ChatItemVersion
|
||||||
|
toChatItemVersion (chatItemVersionId, msgContent, itemVersionTs, createdAt) = ChatItemVersion {chatItemVersionId, msgContent, itemVersionTs, createdAt}
|
||||||
|
|
||||||
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
|
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
|
||||||
updateDirectCIFileStatus db user fileId fileStatus = do
|
updateDirectCIFileStatus db user fileId fileStatus = do
|
||||||
aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId
|
aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId
|
||||||
@ -5353,7 +5435,7 @@ data StoreError
|
|||||||
| SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId}
|
| SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId}
|
||||||
| SEBadChatItem {itemId :: ChatItemId}
|
| SEBadChatItem {itemId :: ChatItemId}
|
||||||
| SEChatItemNotFound {itemId :: ChatItemId}
|
| SEChatItemNotFound {itemId :: ChatItemId}
|
||||||
| SEQuotedChatItemNotFound
|
| SEChatItemNotFoundByText {text :: Text}
|
||||||
| SEChatItemSharedMsgIdNotFound {sharedMsgId :: SharedMsgId}
|
| SEChatItemSharedMsgIdNotFound {sharedMsgId :: SharedMsgId}
|
||||||
| SEChatItemNotFoundByFileId {fileId :: FileTransferId}
|
| SEChatItemNotFoundByFileId {fileId :: FileTransferId}
|
||||||
| SEChatItemNotFoundByGroupId {groupId :: GroupId}
|
| SEChatItemNotFoundByGroupId {groupId :: GroupId}
|
||||||
|
@ -14,6 +14,7 @@ import Control.Monad.Except
|
|||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import Data.Time.Clock (getCurrentTime)
|
import Data.Time.Clock (getCurrentTime)
|
||||||
|
import Data.Time.LocalTime (getCurrentTimeZone)
|
||||||
import Simplex.Chat (processChatCommand)
|
import Simplex.Chat (processChatCommand)
|
||||||
import Simplex.Chat.Controller
|
import Simplex.Chat.Controller
|
||||||
import Simplex.Chat.Messages hiding (NewChatItem (..))
|
import Simplex.Chat.Messages hiding (NewChatItem (..))
|
||||||
@ -137,7 +138,8 @@ responseString :: ChatController -> Bool -> ChatResponse -> IO [StyledString]
|
|||||||
responseString cc liveItems r = do
|
responseString cc liveItems r = do
|
||||||
user <- readTVarIO $ currentUser cc
|
user <- readTVarIO $ currentUser cc
|
||||||
ts <- getCurrentTime
|
ts <- getCurrentTime
|
||||||
pure $ responseToView user (config cc) liveItems ts r
|
tz <- getCurrentTimeZone
|
||||||
|
pure $ responseToView user (config cc) liveItems ts tz r
|
||||||
|
|
||||||
printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
|
printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
|
||||||
printToTerminal ct s =
|
printToTerminal ct s =
|
||||||
|
@ -26,7 +26,7 @@ import qualified Data.Text as T
|
|||||||
import Data.Text.Encoding (decodeLatin1)
|
import Data.Text.Encoding (decodeLatin1)
|
||||||
import Data.Time.Clock (DiffTime, UTCTime)
|
import Data.Time.Clock (DiffTime, UTCTime)
|
||||||
import Data.Time.Format (defaultTimeLocale, formatTime)
|
import Data.Time.Format (defaultTimeLocale, formatTime)
|
||||||
import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToZonedTime)
|
import Data.Time.LocalTime (TimeZone, ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToLocalTime, utcToZonedTime)
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import qualified Network.HTTP.Types as Q
|
import qualified Network.HTTP.Types as Q
|
||||||
@ -57,11 +57,11 @@ import System.Console.ANSI.Types
|
|||||||
|
|
||||||
type CurrentTime = UTCTime
|
type CurrentTime = UTCTime
|
||||||
|
|
||||||
serializeChatResponse :: Maybe User -> CurrentTime -> ChatResponse -> String
|
serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse -> String
|
||||||
serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ defaultChatConfig False ts
|
serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz
|
||||||
|
|
||||||
responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
|
responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString]
|
||||||
responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
responseToView user_ ChatConfig {logLevel, testView} liveItems ts tz = \case
|
||||||
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
|
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
|
||||||
CRUsersList users -> viewUsersList users
|
CRUsersList users -> viewUsersList users
|
||||||
CRChatStarted -> ["chat started"]
|
CRChatStarted -> ["chat started"]
|
||||||
@ -85,6 +85,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
|||||||
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
|
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
|
||||||
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts
|
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts
|
||||||
CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
||||||
|
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
|
||||||
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
|
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
|
||||||
CRChatItemStatusUpdated u _ -> ttyUser u []
|
CRChatItemStatusUpdated u _ -> ttyUser u []
|
||||||
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
|
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||||
@ -415,6 +416,29 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
|
|||||||
plainContent = plain . ciContentToText
|
plainContent = plain . ciContentToText
|
||||||
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
|
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
|
||||||
|
|
||||||
|
viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [StyledString]
|
||||||
|
viewChatItemInfo (AChatItem _ msgDir _ _) ChatItemInfo {itemTs, createdAt, itemVersions} tz = case msgDir of
|
||||||
|
SMDRcv ->
|
||||||
|
[ "sent at: " <> ts itemTs,
|
||||||
|
"received at: " <> ts createdAt
|
||||||
|
]
|
||||||
|
<> versions
|
||||||
|
SMDSnd ->
|
||||||
|
["sent at: " <> ts itemTs] <> versions
|
||||||
|
where
|
||||||
|
ts = styleTime . localTs tz
|
||||||
|
versions =
|
||||||
|
if null itemVersions
|
||||||
|
then []
|
||||||
|
else ["message history:"] <> concatMap version itemVersions
|
||||||
|
version ChatItemVersion {msgContent, itemVersionTs} = prependFirst (ts itemVersionTs <> styleTime ": ") $ ttyMsgContent msgContent
|
||||||
|
|
||||||
|
localTs :: TimeZone -> UTCTime -> String
|
||||||
|
localTs tz ts = do
|
||||||
|
let localTime = utcToLocalTime tz ts
|
||||||
|
formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime
|
||||||
|
formattedTime
|
||||||
|
|
||||||
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString]
|
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> [StyledString]
|
||||||
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts = case chat of
|
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts = case chat of
|
||||||
DirectChat c -> case chatDir of
|
DirectChat c -> case chatDir of
|
||||||
@ -1368,7 +1392,7 @@ viewChatError logLevel = \case
|
|||||||
SEContactRequestNotFoundByName c -> ["no contact request from " <> ttyContact c]
|
SEContactRequestNotFoundByName c -> ["no contact request from " <> ttyContact c]
|
||||||
SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file
|
SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file
|
||||||
SEConnectionNotFound agentConnId -> ["event connection not found, agent ID: " <> sShow agentConnId | logLevel <= CLLWarning] -- mutes delete group error
|
SEConnectionNotFound agentConnId -> ["event connection not found, agent ID: " <> sShow agentConnId | logLevel <= CLLWarning] -- mutes delete group error
|
||||||
SEQuotedChatItemNotFound -> ["message not found - reply is not sent"]
|
SEChatItemNotFoundByText text -> ["message not found by text: " <> plain text]
|
||||||
SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> groupName' g)]
|
SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> groupName' g)]
|
||||||
SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> groupName' g)]
|
SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> groupName' g)]
|
||||||
e -> ["chat db error: " <> sShow e]
|
e -> ["chat db error: " <> sShow e]
|
||||||
|
@ -31,6 +31,7 @@ chatDirectTests = do
|
|||||||
it "deleting contact deletes profile" testDeleteContactDeletesProfile
|
it "deleting contact deletes profile" testDeleteContactDeletesProfile
|
||||||
it "direct message quoted replies" testDirectMessageQuotedReply
|
it "direct message quoted replies" testDirectMessageQuotedReply
|
||||||
it "direct message update" testDirectMessageUpdate
|
it "direct message update" testDirectMessageUpdate
|
||||||
|
it "direct message edit history" testDirectMessageEditHistory
|
||||||
it "direct message delete" testDirectMessageDelete
|
it "direct message delete" testDirectMessageDelete
|
||||||
it "direct live message" testDirectLiveMessage
|
it "direct live message" testDirectLiveMessage
|
||||||
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
|
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
|
||||||
@ -268,6 +269,73 @@ testDirectMessageUpdate =
|
|||||||
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "greetings 🤝"), Nothing), ((0, "hey Alice"), Just (1, "hello 🙂")), ((0, "greetings Alice"), Just (1, "hey 👋"))])
|
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((1, "greetings 🤝"), Nothing), ((0, "hey Alice"), Just (1, "hello 🙂")), ((0, "greetings Alice"), Just (1, "hey 👋"))])
|
||||||
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "greetings 🤝"), Nothing), ((1, "hey Alice"), Just (0, "hello 🙂")), ((1, "greetings Alice"), Just (0, "hey 👋"))])
|
bob #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "greetings 🤝"), Nothing), ((1, "hey Alice"), Just (0, "hello 🙂")), ((1, "greetings Alice"), Just (0, "hey 👋"))])
|
||||||
|
|
||||||
|
testDirectMessageEditHistory :: HasCallStack => FilePath -> IO ()
|
||||||
|
testDirectMessageEditHistory =
|
||||||
|
testChat2 aliceProfile bobProfile $
|
||||||
|
\alice bob -> do
|
||||||
|
connectUsers alice bob
|
||||||
|
alice #> "@bob hello!"
|
||||||
|
bob <# "alice> hello!"
|
||||||
|
|
||||||
|
alice ##> ("/_get item info " <> itemId 1)
|
||||||
|
alice <##. "sent at: "
|
||||||
|
bob ##> ("/_get item info " <> itemId 1)
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
|
||||||
|
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey 👋")
|
||||||
|
alice <# "@bob [edited] hey 👋"
|
||||||
|
bob <# "alice> [edited] hey 👋"
|
||||||
|
|
||||||
|
alice ##> ("/_get item info " <> itemId 1)
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hey 👋"
|
||||||
|
alice .<## ": hello!"
|
||||||
|
bob ##> ("/_get item info " <> itemId 1)
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hey 👋"
|
||||||
|
bob .<## ": hello!"
|
||||||
|
|
||||||
|
alice ##> ("/_update item @2 " <> itemId 1 <> " text hello there")
|
||||||
|
alice <# "@bob [edited] hello there"
|
||||||
|
bob <# "alice> [edited] hello there"
|
||||||
|
|
||||||
|
alice ##> "/item info @bob hello"
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hello there"
|
||||||
|
alice .<## ": hey 👋"
|
||||||
|
alice .<## ": hello!"
|
||||||
|
bob ##> "/item info @alice hello"
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hello there"
|
||||||
|
bob .<## ": hey 👋"
|
||||||
|
bob .<## ": hello!"
|
||||||
|
|
||||||
|
bob #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted")
|
||||||
|
|
||||||
|
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey there")
|
||||||
|
alice <# "@bob [edited] hey there"
|
||||||
|
bob <# "alice> [edited] hey there"
|
||||||
|
|
||||||
|
alice ##> "/item info @bob hey"
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hey there"
|
||||||
|
alice .<## ": hello there"
|
||||||
|
alice .<## ": hey 👋"
|
||||||
|
alice .<## ": hello!"
|
||||||
|
bob ##> "/item info @alice hey"
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hey there"
|
||||||
|
|
||||||
testDirectMessageDelete :: HasCallStack => FilePath -> IO ()
|
testDirectMessageDelete :: HasCallStack => FilePath -> IO ()
|
||||||
testDirectMessageDelete =
|
testDirectMessageDelete =
|
||||||
testChat2 aliceProfile bobProfile $
|
testChat2 aliceProfile bobProfile $
|
||||||
@ -359,6 +427,18 @@ testDirectLiveMessage =
|
|||||||
alice ##> ("/_update item @2 " <> itemId 2 <> " text hello 2")
|
alice ##> ("/_update item @2 " <> itemId 2 <> " text hello 2")
|
||||||
alice <# "@bob [LIVE] hello 2"
|
alice <# "@bob [LIVE] hello 2"
|
||||||
bob <# "alice> [LIVE ended] hello 2"
|
bob <# "alice> [LIVE ended] hello 2"
|
||||||
|
-- live message has edit history
|
||||||
|
alice ##> ("/_get item info " <> itemId 2)
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hello 2"
|
||||||
|
alice .<## ":"
|
||||||
|
bob ##> ("/_get item info " <> itemId 2)
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hello 2"
|
||||||
|
bob .<## ":"
|
||||||
|
|
||||||
testRepeatAuthErrorsDisableContact :: HasCallStack => FilePath -> IO ()
|
testRepeatAuthErrorsDisableContact :: HasCallStack => FilePath -> IO ()
|
||||||
testRepeatAuthErrorsDisableContact =
|
testRepeatAuthErrorsDisableContact =
|
||||||
|
@ -32,6 +32,7 @@ chatGroupTests = do
|
|||||||
it "list groups containing group invitations" testGroupList
|
it "list groups containing group invitations" testGroupList
|
||||||
it "group message quoted replies" testGroupMessageQuotedReply
|
it "group message quoted replies" testGroupMessageQuotedReply
|
||||||
it "group message update" testGroupMessageUpdate
|
it "group message update" testGroupMessageUpdate
|
||||||
|
it "group message edit history" testGroupMessageEditHistory
|
||||||
it "group message delete" testGroupMessageDelete
|
it "group message delete" testGroupMessageDelete
|
||||||
it "group live message" testGroupLiveMessage
|
it "group live message" testGroupLiveMessage
|
||||||
it "update group profile" testUpdateGroupProfile
|
it "update group profile" testUpdateGroupProfile
|
||||||
@ -875,6 +876,76 @@ testGroupMessageUpdate =
|
|||||||
bob #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hey 👋")), ((0, "greetings!"), Just (0, "greetings 🤝"))])
|
bob #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hey 👋")), ((0, "greetings!"), Just (0, "greetings 🤝"))])
|
||||||
cath #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (0, "hey 👋")), ((1, "greetings!"), Just (0, "greetings 🤝"))])
|
cath #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (0, "hey 👋")), ((1, "greetings!"), Just (0, "greetings 🤝"))])
|
||||||
|
|
||||||
|
testGroupMessageEditHistory :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMessageEditHistory =
|
||||||
|
testChat2 aliceProfile bobProfile $
|
||||||
|
\alice bob -> do
|
||||||
|
createGroup2 "team" alice bob
|
||||||
|
threadDelay 1000000
|
||||||
|
alice #> "#team hello!"
|
||||||
|
bob <# "#team alice> hello!"
|
||||||
|
aliceItemId <- lastItemId alice
|
||||||
|
bobItemId <- lastItemId bob
|
||||||
|
|
||||||
|
alice ##> ("/_get item info " <> aliceItemId)
|
||||||
|
alice <##. "sent at: "
|
||||||
|
bob ##> ("/_get item info " <> bobItemId)
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
|
||||||
|
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey 👋")
|
||||||
|
alice <# "#team [edited] hey 👋"
|
||||||
|
bob <# "#team alice> [edited] hey 👋"
|
||||||
|
|
||||||
|
alice ##> ("/_get item info " <> aliceItemId)
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hey 👋"
|
||||||
|
alice .<## ": hello!"
|
||||||
|
bob ##> ("/_get item info " <> bobItemId)
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hey 👋"
|
||||||
|
bob .<## ": hello!"
|
||||||
|
|
||||||
|
alice ##> ("/_update item #1 " <> aliceItemId <> " text hello there")
|
||||||
|
alice <# "#team [edited] hello there"
|
||||||
|
bob <# "#team alice> [edited] hello there"
|
||||||
|
|
||||||
|
alice ##> "/item info #team hello"
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hello there"
|
||||||
|
alice .<## ": hey 👋"
|
||||||
|
alice .<## ": hello!"
|
||||||
|
bob ##> "/item info #team hello"
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hello there"
|
||||||
|
bob .<## ": hey 👋"
|
||||||
|
bob .<## ": hello!"
|
||||||
|
|
||||||
|
bob #$> ("/_delete item #1 " <> bobItemId <> " internal", id, "message deleted")
|
||||||
|
|
||||||
|
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey there")
|
||||||
|
alice <# "#team [edited] hey there"
|
||||||
|
bob <# "#team alice> [edited] hey there"
|
||||||
|
|
||||||
|
alice ##> "/item info #team hey"
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hey there"
|
||||||
|
alice .<## ": hello there"
|
||||||
|
alice .<## ": hey 👋"
|
||||||
|
alice .<## ": hello!"
|
||||||
|
bob ##> "/item info #team hey"
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hey there"
|
||||||
|
|
||||||
testGroupMessageDelete :: HasCallStack => FilePath -> IO ()
|
testGroupMessageDelete :: HasCallStack => FilePath -> IO ()
|
||||||
testGroupMessageDelete =
|
testGroupMessageDelete =
|
||||||
testChat3 aliceProfile bobProfile cathProfile $
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
@ -981,6 +1052,19 @@ testGroupLiveMessage =
|
|||||||
alice <# "#team [LIVE] hello 2"
|
alice <# "#team [LIVE] hello 2"
|
||||||
bob <# "#team alice> [LIVE ended] hello 2"
|
bob <# "#team alice> [LIVE ended] hello 2"
|
||||||
cath <# "#team alice> [LIVE ended] hello 2"
|
cath <# "#team alice> [LIVE ended] hello 2"
|
||||||
|
-- live message has edit history
|
||||||
|
alice ##> ("/_get item info " <> msgItemId2)
|
||||||
|
alice <##. "sent at: "
|
||||||
|
alice <## "message history:"
|
||||||
|
alice .<## ": hello 2"
|
||||||
|
alice .<## ":"
|
||||||
|
bobItemId <- lastItemId bob
|
||||||
|
bob ##> ("/_get item info " <> bobItemId)
|
||||||
|
bob <##. "sent at: "
|
||||||
|
bob <##. "received at: "
|
||||||
|
bob <## "message history:"
|
||||||
|
bob .<## ": hello 2"
|
||||||
|
bob .<## ":"
|
||||||
|
|
||||||
testUpdateGroupProfile :: HasCallStack => FilePath -> IO ()
|
testUpdateGroupProfile :: HasCallStack => FilePath -> IO ()
|
||||||
testUpdateGroupProfile =
|
testUpdateGroupProfile =
|
||||||
|
@ -231,6 +231,13 @@ cc <##. line = do
|
|||||||
unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
|
unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
|
||||||
prefix `shouldBe` True
|
prefix `shouldBe` True
|
||||||
|
|
||||||
|
(.<##) :: HasCallStack => TestCC -> String -> Expectation
|
||||||
|
cc .<## line = do
|
||||||
|
l <- getTermLine cc
|
||||||
|
let suffix = line `isSuffixOf` l
|
||||||
|
unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
|
||||||
|
suffix `shouldBe` True
|
||||||
|
|
||||||
(<#.) :: HasCallStack => TestCC -> String -> Expectation
|
(<#.) :: HasCallStack => TestCC -> String -> Expectation
|
||||||
cc <#. line = do
|
cc <#. line = do
|
||||||
l <- dropTime <$> getTermLine cc
|
l <- dropTime <$> getTermLine cc
|
||||||
|
Loading…
Reference in New Issue
Block a user