mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-25 14:14:39 +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
committed by
GitHub
GitHub
parent
f155611d29
commit
9978957e6c
@@ -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
|
||||
}
|
||||
|
||||
@@ -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,
|
||||
|
||||
+39
-35
@@ -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]
|
||||
|
||||
+10
-11
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user