mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-29 12:49:53 +00:00
core: deleted timestamps for chat item (#2459)
* core: edited and deleted timestamps for item * migration * add deleted timestamp to chat item, use chat item if there are no versions * use broker timestamp for remote deletions * refactor
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
f155611d29
commit
9978957e6c
9 changed files with 138 additions and 83 deletions
|
|
@ -96,6 +96,7 @@ library
|
|||
Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
|
||||
Simplex.Chat.Migrations.M20230505_chat_item_versions
|
||||
Simplex.Chat.Migrations.M20230511_reactions
|
||||
Simplex.Chat.Migrations.M20230519_item_deleted_ts
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.WebRTC
|
||||
Simplex.Chat.Options
|
||||
|
|
|
|||
|
|
@ -469,9 +469,10 @@ processChatCommand = \case
|
|||
chatItems <- withStore $ \db -> getAllChatItems db user pagination search
|
||||
pure $ CRChatItems user chatItems
|
||||
APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do
|
||||
(chatItem, itemVersions) <- withStore $ \db ->
|
||||
(aci@(AChatItem _ _ _ ci), versions) <- withStore $ \db ->
|
||||
(,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId)
|
||||
pure $ CRChatItemInfo user chatItem ChatItemInfo {itemVersions}
|
||||
let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions
|
||||
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions}
|
||||
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
|
||||
|
|
@ -704,13 +705,13 @@ processChatCommand = \case
|
|||
setActive $ ActiveC c
|
||||
if featureAllowed SCFFullDelete forUser ct
|
||||
then deleteDirectCI user ct ci True False
|
||||
else markDirectCIDeleted user ct ci msgId True
|
||||
else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime
|
||||
(CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
|
||||
CTGroup -> do
|
||||
Group gInfo ms <- withStore $ \db -> getGroup db user chatId
|
||||
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 False Nothing
|
||||
(CIDMInternal, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime
|
||||
(CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
|
||||
assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
|
||||
SndMessage {msgId} <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
|
||||
|
|
@ -1778,9 +1779,10 @@ processChatCommand = \case
|
|||
delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> m ChatResponse
|
||||
delGroupChatItem user gInfo@GroupInfo {localDisplayName = gName} ci msgId byGroupMember = do
|
||||
setActive $ ActiveG gName
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
if groupFeatureAllowed SGFFullDelete gInfo
|
||||
then deleteGroupCI user gInfo ci True False byGroupMember
|
||||
else markGroupCIDeleted user gInfo ci msgId True byGroupMember
|
||||
then deleteGroupCI user gInfo ci True False byGroupMember deletedTs
|
||||
else markGroupCIDeleted user gInfo ci msgId True byGroupMember deletedTs
|
||||
updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> m ChatResponse
|
||||
updateGroupProfileByName gName update = withUser $ \user -> do
|
||||
g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db ->
|
||||
|
|
@ -2402,7 +2404,8 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do
|
|||
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 Nothing >>= toView
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
deleteGroupCI user gInfo ci True True Nothing deletedTs >>= toView
|
||||
_ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType"
|
||||
|
||||
startUpdatedTimedItemThread :: ChatMonad m => User -> ChatRef -> ChatItem c d -> ChatItem c d -> m ()
|
||||
|
|
@ -2932,7 +2935,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
XMsgFileDescr sharedMsgId fileDescr -> canSend $ groupMessageFileDescription gInfo m sharedMsgId fileDescr msgMeta
|
||||
XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m sharedMsgId msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> canSend $ groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg msgMeta
|
||||
XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m sharedMsgId memberId reaction add msg msgMeta
|
||||
-- TODO discontinue XFile
|
||||
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
|
||||
|
|
@ -3399,7 +3402,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
_ -> messageError "x.msg.update: contact attempted invalid message update"
|
||||
|
||||
messageDelete :: Contact -> SharedMsgId -> RcvMessage -> MsgMeta -> m ()
|
||||
messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta = do
|
||||
messageDelete ct@Contact {contactId} sharedMsgId RcvMessage {msgId} msgMeta@MsgMeta {broker = (_, brokerTs)} = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct)
|
||||
where
|
||||
|
|
@ -3409,7 +3412,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
SMDRcv ->
|
||||
if featureAllowed SCFFullDelete forContact ct
|
||||
then deleteDirectCI user ct ci False False >>= toView
|
||||
else markDirectCIDeleted user ct ci msgId False >>= toView
|
||||
else markDirectCIDeleted user ct ci msgId False brokerTs >>= toView
|
||||
SMDSnd -> messageError "x.msg.del: contact attempted invalid message delete"
|
||||
|
||||
directMsgReaction :: Contact -> SharedMsgId -> MsgReaction -> Bool -> RcvMessage -> MsgMeta -> m ()
|
||||
|
|
@ -3523,8 +3526,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
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 ()
|
||||
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} = do
|
||||
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> MsgMeta -> m ()
|
||||
groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do
|
||||
let msgMemberId = fromMaybe memberId sndMemberId_
|
||||
withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case
|
||||
Right ci@(CChatItem _ ChatItem {chatDir}) -> case chatDir of
|
||||
|
|
@ -3545,8 +3548,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
|||
messageError "x.msg.del: message of another member with insufficient member permissions"
|
||||
| otherwise = a
|
||||
delete ci byGroupMember
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCI user gInfo ci False False byGroupMember
|
||||
| otherwise = markGroupCIDeleted user gInfo ci msgId False byGroupMember
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCI user gInfo ci False False byGroupMember brokerTs
|
||||
| otherwise = markGroupCIDeleted user gInfo ci msgId False byGroupMember brokerTs
|
||||
|
||||
-- TODO remove once XFile is discontinued
|
||||
processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
|
|
@ -4409,13 +4412,13 @@ deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser
|
|||
withStore' $ \db -> deleteDirectChatItem db user ct ci
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) Nothing byUser timed
|
||||
|
||||
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> Maybe GroupMember -> m ChatResponse
|
||||
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed byGroupMember_ = do
|
||||
deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed byGroupMember_ deletedTs = do
|
||||
deleteCIFile user file
|
||||
toCi <- withStore' $ \db ->
|
||||
case byGroupMember_ of
|
||||
Nothing -> deleteGroupChatItem db user gInfo ci $> Nothing
|
||||
Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m
|
||||
Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs
|
||||
pure $ CRChatItemDeleted user (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) toCi byUser timed
|
||||
|
||||
deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m ()
|
||||
|
|
@ -4425,21 +4428,21 @@ deleteCIFile user file =
|
|||
fileAgentConnIds <- deleteFile' user fileInfo True
|
||||
deleteAgentConnectionsAsync user fileAgentConnIds
|
||||
|
||||
markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> m ChatResponse
|
||||
markDirectCIDeleted user ct@Contact {contactId} ci@(CChatItem _ ChatItem {file}) msgId byUser = do
|
||||
markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> UTCTime -> m ChatResponse
|
||||
markDirectCIDeleted user ct@Contact {contactId} ci@(CChatItem _ ChatItem {file}) msgId byUser deletedTs = do
|
||||
cancelCIFile user file
|
||||
toCi <- withStore $ \db -> do
|
||||
liftIO $ markDirectChatItemDeleted db user ct ci msgId
|
||||
liftIO $ markDirectChatItemDeleted db user ct ci msgId deletedTs
|
||||
getDirectChatItem db user contactId (cchatItemId ci)
|
||||
pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem toCi) byUser False
|
||||
where
|
||||
ctItem (CChatItem msgDir ci') = AChatItem SCTDirect msgDir (DirectChat ct) ci'
|
||||
|
||||
markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> Maybe GroupMember -> m ChatResponse
|
||||
markGroupCIDeleted user gInfo@GroupInfo {groupId} ci@(CChatItem _ ChatItem {file}) msgId byUser byGroupMember_ = do
|
||||
markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
|
||||
markGroupCIDeleted user gInfo@GroupInfo {groupId} ci@(CChatItem _ ChatItem {file}) msgId byUser byGroupMember_ deletedTs = do
|
||||
cancelCIFile user file
|
||||
toCi <- withStore $ \db -> do
|
||||
liftIO $ markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_
|
||||
liftIO $ markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs
|
||||
getGroupChatItem db user groupId (cchatItemId ci)
|
||||
pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem toCi) byUser False
|
||||
where
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
|
|||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (isNothing)
|
||||
import Data.Maybe (isNothing, isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
|
|
@ -229,8 +229,8 @@ chatItemDeletedState ChatItem {meta = CIMeta {itemDeleted}, content} =
|
|||
_ -> CIDeletedState {markedDeleted = True, deletedByMember = byMember cid}
|
||||
byMember :: CIDeleted c -> Maybe GroupMember
|
||||
byMember = \case
|
||||
CIModerated m -> Just m
|
||||
CIDeleted -> Nothing
|
||||
CIModerated _ m -> Just m
|
||||
CIDeleted _ -> Nothing
|
||||
|
||||
data ChatDirection (c :: ChatType) (d :: MsgDirection) where
|
||||
CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd
|
||||
|
|
@ -797,6 +797,12 @@ data CIContent (d :: MsgDirection) where
|
|||
|
||||
deriving instance Show (CIContent d)
|
||||
|
||||
ciMsgContent :: CIContent d -> Maybe MsgContent
|
||||
ciMsgContent = \case
|
||||
CISndMsgContent mc -> Just mc
|
||||
CIRcvMsgContent mc -> Just mc
|
||||
_ -> Nothing
|
||||
|
||||
data MsgDecryptError = MDERatchetHeader | MDETooManySkipped
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
|
|
@ -809,10 +815,7 @@ instance FromJSON MsgDecryptError where
|
|||
|
||||
ciReactionAllowed :: ChatItem c d -> Bool
|
||||
ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False
|
||||
ciReactionAllowed ChatItem {content} = case content of
|
||||
CISndMsgContent _ -> True
|
||||
CIRcvMsgContent _ -> True
|
||||
_ -> False
|
||||
ciReactionAllowed ChatItem {content} = isJust $ ciMsgContent content
|
||||
|
||||
ciRequiresAttention :: forall d. MsgDirectionI d => CIContent d -> Bool
|
||||
ciRequiresAttention content = case msgDirection @d of
|
||||
|
|
@ -1477,8 +1480,8 @@ checkDirection x = case testEquality (msgDirection @d) (msgDirection @d') of
|
|||
Nothing -> Left "bad direction"
|
||||
|
||||
data CIDeleted (c :: ChatType) where
|
||||
CIDeleted :: CIDeleted c
|
||||
CIModerated :: GroupMember -> CIDeleted 'CTGroup
|
||||
CIDeleted :: Maybe UTCTime -> CIDeleted c
|
||||
CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup
|
||||
|
||||
deriving instance Show (CIDeleted c)
|
||||
|
||||
|
|
@ -1487,8 +1490,8 @@ instance ToJSON (CIDeleted d) where
|
|||
toEncoding = J.toEncoding . jsonCIDeleted
|
||||
|
||||
data JSONCIDeleted
|
||||
= JCIDDeleted
|
||||
| JCIDModerated {byGroupMember :: GroupMember}
|
||||
= JCIDDeleted {deletedTs :: Maybe UTCTime}
|
||||
| JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON JSONCIDeleted where
|
||||
|
|
@ -1497,8 +1500,13 @@ instance ToJSON JSONCIDeleted where
|
|||
|
||||
jsonCIDeleted :: CIDeleted d -> JSONCIDeleted
|
||||
jsonCIDeleted = \case
|
||||
CIDeleted -> JCIDDeleted
|
||||
CIModerated m -> JCIDModerated m
|
||||
CIDeleted ts -> JCIDDeleted ts
|
||||
CIModerated ts m -> JCIDModerated ts m
|
||||
|
||||
itemDeletedTs :: CIDeleted d -> Maybe UTCTime
|
||||
itemDeletedTs = \case
|
||||
CIDeleted ts -> ts
|
||||
CIModerated ts _ -> ts
|
||||
|
||||
data ChatItemInfo = ChatItemInfo
|
||||
{ itemVersions :: [ChatItemVersion]
|
||||
|
|
@ -1517,3 +1525,16 @@ data ChatItemVersion = ChatItemVersion
|
|||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON ChatItemVersion where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
mkItemVersion :: ChatItem c d -> Maybe ChatItemVersion
|
||||
mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
|
||||
where
|
||||
CIMeta {itemId, itemTs, createdAt} = meta
|
||||
version mc =
|
||||
ChatItemVersion
|
||||
{ chatItemVersionId = itemId,
|
||||
msgContent = mc,
|
||||
formattedText = parseMaybeMarkdownList $ msgContentText mc,
|
||||
itemVersionTs = itemTs,
|
||||
createdAt = createdAt
|
||||
}
|
||||
|
|
|
|||
18
src/Simplex/Chat/Migrations/M20230519_item_deleted_ts.hs
Normal file
18
src/Simplex/Chat/Migrations/M20230519_item_deleted_ts.hs
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230519_item_deleted_ts where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20230519_item_deleted_ts :: Query
|
||||
m20230519_item_deleted_ts =
|
||||
[sql|
|
||||
ALTER TABLE chat_items ADD COLUMN item_deleted_ts TEXT;
|
||||
|]
|
||||
|
||||
down_m20230519_item_deleted_ts :: Query
|
||||
down_m20230519_item_deleted_ts =
|
||||
[sql|
|
||||
ALTER TABLE chat_items DROP COLUMN item_deleted_ts;
|
||||
|]
|
||||
|
|
@ -377,7 +377,8 @@ CREATE TABLE chat_items(
|
|||
timed_ttl INTEGER,
|
||||
timed_delete_at TEXT,
|
||||
item_live INTEGER,
|
||||
item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL
|
||||
item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
|
||||
item_deleted_ts TEXT
|
||||
);
|
||||
CREATE TABLE chat_item_messages(
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
|
|
|
|||
|
|
@ -392,6 +392,7 @@ import Simplex.Chat.Migrations.M20230422_profile_contact_links
|
|||
import Simplex.Chat.Migrations.M20230504_recreate_msg_delivery_events_cleanup_messages
|
||||
import Simplex.Chat.Migrations.M20230505_chat_item_versions
|
||||
import Simplex.Chat.Migrations.M20230511_reactions
|
||||
import Simplex.Chat.Migrations.M20230519_item_deleted_ts
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (week)
|
||||
|
|
@ -470,7 +471,8 @@ schemaMigrations =
|
|||
("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),
|
||||
("20230505_chat_item_versions", m20230505_chat_item_versions, Just down_m20230505_chat_item_versions),
|
||||
("20230511_reactions", m20230511_reactions, Just down_m20230511_reactions)
|
||||
("20230511_reactions", m20230511_reactions, Just down_m20230511_reactions),
|
||||
("20230519_item_deleted_ts", m20230519_item_deleted_ts, Just down_m20230519_item_deleted_ts)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
|
@ -3796,7 +3798,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_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
|
|
@ -3861,7 +3863,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_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- Maybe GroupMember - sender
|
||||
|
|
@ -4027,7 +4029,7 @@ getDirectChatItemsLast db User {userId} contactId count search = ExceptT $ do
|
|||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
|
|
@ -4057,7 +4059,7 @@ getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId coun
|
|||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
|
|
@ -4088,7 +4090,7 @@ getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId co
|
|||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
|
|
@ -4409,14 +4411,15 @@ updateDirectChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> UserId ->
|
|||
updateDirectChatItem_ db userId contactId ChatItem {meta, content} msgId_ = do
|
||||
let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, itemTimed, itemLive, updatedAt} = meta
|
||||
itemDeleted' = isJust itemDeleted
|
||||
itemDeletedTs' = itemDeletedTs =<< itemDeleted
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
((content, itemText, itemStatus, itemDeleted', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
|
||||
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, contactId, itemId))
|
||||
forM_ msgId_ $ \msgId -> liftIO $ insertChatItemMessage_ db itemId msgId updatedAt
|
||||
|
||||
addInitialAndNewCIVersions :: DB.Connection -> ChatItemId -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
|
||||
|
|
@ -4475,8 +4478,8 @@ 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 User {userId} Contact {contactId} (CChatItem _ ci) msgId = do
|
||||
markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> MessageId -> UTCTime -> IO ()
|
||||
markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) msgId deletedTs = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let itemId = chatItemId' ci
|
||||
insertChatItemMessage_ db itemId msgId currentTs
|
||||
|
|
@ -4484,10 +4487,10 @@ markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci)
|
|||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, updated_at = ?
|
||||
SET item_deleted = 1, item_deleted_ts = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(currentTs, userId, contactId, itemId)
|
||||
(deletedTs, currentTs, userId, contactId, itemId)
|
||||
|
||||
getDirectChatItemBySharedMsgId :: DB.Connection -> User -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItemBySharedMsgId db user@User {userId} contactId sharedMsgId = do
|
||||
|
|
@ -4525,7 +4528,7 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
|||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
|
|
@ -4578,14 +4581,15 @@ updateGroupChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> User -> In
|
|||
updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ = do
|
||||
let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, itemTimed, itemLive, updatedAt} = meta
|
||||
itemDeleted' = isJust itemDeleted
|
||||
itemDeletedTs' = itemDeletedTs =<< itemDeleted
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted = 0, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
|
||||
SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, item_live = ?, updated_at = ?, timed_ttl = ?, timed_delete_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
((content, itemText, itemStatus, itemDeleted', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
|
||||
((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId updatedAt
|
||||
|
||||
deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> IO ()
|
||||
|
|
@ -4602,8 +4606,8 @@ deleteGroupChatItem db User {userId} g@GroupInfo {groupId} (CChatItem _ ci) = do
|
|||
|]
|
||||
(userId, groupId, itemId)
|
||||
|
||||
updateGroupChatItemModerated :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> GroupMember -> IO AChatItem
|
||||
updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatItem msgDir ci) m@GroupMember {groupMemberId} = do
|
||||
updateGroupChatItemModerated :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> GroupMember -> UTCTime -> IO AChatItem
|
||||
updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatItem msgDir ci) m@GroupMember {groupMemberId} deletedTs = do
|
||||
currentTs <- getCurrentTime
|
||||
let toContent = msgDirToModeratedContent_ msgDir
|
||||
toText = ciModeratedText
|
||||
|
|
@ -4615,14 +4619,14 @@ updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatIt
|
|||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
|
||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated m)}, formattedText = Nothing})
|
||||
(deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
|
||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just currentTs) m)}, formattedText = Nothing})
|
||||
|
||||
markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> IO ()
|
||||
markGroupChatItemDeleted db User {userId} GroupInfo {groupId} (CChatItem _ ci) msgId byGroupMember_ = do
|
||||
markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> UTCTime -> IO ()
|
||||
markGroupChatItemDeleted db User {userId} GroupInfo {groupId} (CChatItem _ ci) msgId byGroupMember_ deletedTs = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let itemId = chatItemId' ci
|
||||
deletedByGroupMemberId = case byGroupMember_ of
|
||||
|
|
@ -4633,10 +4637,10 @@ markGroupChatItemDeleted db User {userId} GroupInfo {groupId} (CChatItem _ ci) m
|
|||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_by_group_member_id = ?, updated_at = ?
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(deletedByGroupMemberId, currentTs, userId, groupId, itemId)
|
||||
(deletedTs, deletedByGroupMemberId, currentTs, userId, groupId, itemId)
|
||||
|
||||
getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupId -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
getGroupChatItemBySharedMsgId db user@User {userId} groupId groupMemberId sharedMsgId = do
|
||||
|
|
@ -4685,7 +4689,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
|||
[sql|
|
||||
SELECT
|
||||
-- ChatItem
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, f.protocol,
|
||||
-- GroupMember
|
||||
|
|
@ -5109,9 +5113,9 @@ type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath,
|
|||
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool)
|
||||
|
||||
type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) :. (Bool, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId) :. (Maybe Bool, Maybe UTCTime, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
|
||||
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
|
||||
|
||||
|
|
@ -5126,7 +5130,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
|||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
|
|
@ -5151,15 +5155,15 @@ toDirectChatItem tz currentTs (((itemId, itemTs, AMsgDirection msgDir, itemConte
|
|||
badItem = Left $ SEBadChatItem itemId
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d
|
||||
ciMeta content status =
|
||||
let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect) else Nothing
|
||||
let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect deletedTs) else Nothing
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive tz currentTs itemTs createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect]
|
||||
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow) =
|
||||
either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
|
||||
toDirectChatItemList _ _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
|
|
@ -5176,7 +5180,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
|||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
|
|
@ -5206,7 +5210,7 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgD
|
|||
ciMeta content status =
|
||||
let itemDeleted' =
|
||||
if itemDeleted
|
||||
then Just (maybe (CIDeleted @'CTGroup) CIModerated deletedByGroupMember_)
|
||||
then Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
else Nothing
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive tz currentTs itemTs createdAt updatedAt
|
||||
|
|
@ -5214,8 +5218,8 @@ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, AMsgDirection msgD
|
|||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList _ _ _ _ = []
|
||||
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
|
||||
|
|
|
|||
|
|
@ -493,38 +493,37 @@ viewItemNotChanged (AChatItem _ msgDir _ _) = case msgDir of
|
|||
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
|
||||
viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem byUser timed ts testView
|
||||
| timed = [plain ("timed message deleted: " <> T.unpack (ciContentToText deletedContent)) | testView]
|
||||
| byUser = [plain $ "message " <> T.unpack (fromMaybe "deleted" deletedText_)] -- deletedText_ Nothing should be impossible here
|
||||
| otherwise = case chat of
|
||||
DirectChat c -> case (chatDir, deletedContent) of
|
||||
(CIDirectRcv, CIRcvMsgContent mc) -> viewReceivedMessage (ttyFromContactDeleted c deletedText_) [] mc ts meta
|
||||
_ -> prohibited
|
||||
GroupChat g@GroupInfo {membership} -> case (chatDir, deletedContent) of
|
||||
(CIGroupRcv m, CIRcvMsgContent mc) -> viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts meta
|
||||
(CIGroupSnd, CISndMsgContent mc) -> viewReceivedMessage (ttyFromGroupDeleted g membership deletedText_) [] mc ts meta
|
||||
GroupChat g -> case ciMsgContent deletedContent of
|
||||
Just mc ->
|
||||
let m = chatItemMember g ci
|
||||
in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts meta
|
||||
_ -> prohibited
|
||||
_ -> prohibited
|
||||
where
|
||||
deletedText_ :: Maybe Text
|
||||
deletedText_ = case toItem of
|
||||
Nothing -> Just "deleted"
|
||||
Just (AChatItem _ _ _ ci) -> chatItemDeletedText ci $ chatInfoMembership chat
|
||||
Just (AChatItem _ _ _ ci') -> chatItemDeletedText ci' $ chatInfoMembership chat
|
||||
prohibited = [styled (colored Red) ("[unexpected message deletion, please report to developers]" :: String)]
|
||||
|
||||
viewItemReaction :: forall c d. Bool -> ChatInfo c -> CIReaction c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
||||
viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md ChatItem {chatDir = itemDir, content}, sentAt, reaction} added ts tz =
|
||||
case (chat, chatDir) of
|
||||
(DirectChat c, CIDirectRcv) -> case content of
|
||||
CIRcvMsgContent mc -> view from $ reactionMsg mc
|
||||
CISndMsgContent mc -> view from $ reactionMsg mc
|
||||
(DirectChat c, CIDirectRcv) -> case ciMsgContent content of
|
||||
Just mc -> view from $ reactionMsg mc
|
||||
_ -> []
|
||||
where
|
||||
from = ttyFromContact c
|
||||
reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then ">>" else ">"
|
||||
(GroupChat g, CIGroupRcv m) -> case content of
|
||||
CIRcvMsgContent mc -> view from $ reactionMsg mc
|
||||
CISndMsgContent mc -> view from $ reactionMsg mc
|
||||
(GroupChat g, CIGroupRcv m) -> case ciMsgContent content of
|
||||
Just mc -> view from $ reactionMsg mc
|
||||
_ -> []
|
||||
where
|
||||
from = ttyFromGroup g m
|
||||
|
|
|
|||
|
|
@ -285,9 +285,13 @@ testDirectMessageEditHistory =
|
|||
|
||||
alice ##> ("/_get item info @2 " <> itemId 1)
|
||||
alice <##. "sent at: "
|
||||
alice <## "message history:"
|
||||
alice .<## ": hello!"
|
||||
bob ##> ("/_get item info @2 " <> itemId 1)
|
||||
bob <##. "sent at: "
|
||||
bob <##. "received at: "
|
||||
bob <## "message history:"
|
||||
bob .<## ": hello!"
|
||||
|
||||
alice ##> ("/_update item @2 " <> itemId 1 <> " text hey 👋")
|
||||
alice <# "@bob [edited] hey 👋"
|
||||
|
|
|
|||
|
|
@ -894,9 +894,13 @@ testGroupMessageEditHistory =
|
|||
|
||||
alice ##> ("/_get item info #1 " <> aliceItemId)
|
||||
alice <##. "sent at: "
|
||||
alice <## "message history:"
|
||||
alice .<## ": hello!"
|
||||
bob ##> ("/_get item info #1 " <> bobItemId)
|
||||
bob <##. "sent at: "
|
||||
bob <##. "received at: "
|
||||
bob <## "message history:"
|
||||
bob .<## ": hello!"
|
||||
|
||||
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey 👋")
|
||||
alice <# "#team [edited] hey 👋"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue