mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-25 16:22:13 +00:00
core: api to forward messages (#3968)
* wip
* wip
* test
* mute
* tests
* simplify (only bool flag)
* re-encrypt file
* tests
* more tests (wip)
* fix relative paths, refactor
* more tests
* more locks
* fix, tests
* more tests
* rework (revert from bool to ids)
* update schema
* more tests
* add to info
* ForwardedMsg container
* Revert "ForwardedMsg container"
This reverts commit bb57f12151.
* parser
* more tests
* rework api
* more locks
* test
* move
* remove from
* view
* prohibit editing
* item info view
---------
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
f8e6a78a3b
commit
a5db36469d
@@ -292,6 +292,7 @@ data ChatCommand
|
||||
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
|
||||
| APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId
|
||||
| APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction}
|
||||
| APIForwardChatItem {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemId :: ChatItemId}
|
||||
| APIUserRead UserId
|
||||
| UserRead
|
||||
| APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
|
||||
@@ -408,6 +409,9 @@ data ChatCommand
|
||||
| AddressAutoAccept (Maybe AutoAccept)
|
||||
| AcceptContact IncognitoEnabled ContactName
|
||||
| RejectContact ContactName
|
||||
| ForwardMessage {toChatName :: ChatName, fromContactName :: ContactName, forwardedMsg :: Text}
|
||||
| ForwardGroupMessage {toChatName :: ChatName, fromGroupName :: GroupName, fromMemberName_ :: Maybe ContactName, forwardedMsg :: Text}
|
||||
| ForwardLocalMessage {toChatName :: ChatName, forwardedMsg :: Text}
|
||||
| SendMessage ChatName Text
|
||||
| SendMemberContactMessage GroupName ContactName Text
|
||||
| SendLiveMessage ChatName Text
|
||||
@@ -1114,6 +1118,7 @@ data ChatErrorType
|
||||
| CEFallbackToSMPProhibited {fileId :: FileTransferId}
|
||||
| CEInlineFileProhibited {fileId :: FileTransferId}
|
||||
| CEInvalidQuote
|
||||
| CEInvalidForward
|
||||
| CEInvalidChatItemUpdate
|
||||
| CEInvalidChatItemDelete
|
||||
| CEHasCurrentCall
|
||||
|
||||
@@ -339,6 +339,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
||||
itemText :: Text,
|
||||
itemStatus :: CIStatus d,
|
||||
itemSharedMsgId :: Maybe SharedMsgId,
|
||||
itemForwarded :: Maybe CIForwardedFrom,
|
||||
itemDeleted :: Maybe (CIDeleted c),
|
||||
itemEdited :: Bool,
|
||||
itemTimed :: Maybe CITimed,
|
||||
@@ -350,15 +351,15 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt =
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemForwarded itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt =
|
||||
let editable = case itemContent of
|
||||
CISndMsgContent _ ->
|
||||
case chatTypeI @c of
|
||||
SCTLocal -> isNothing itemDeleted
|
||||
_ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
|
||||
SCTLocal -> isNothing itemDeleted && isNothing itemForwarded
|
||||
_ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted && isNothing itemForwarded
|
||||
_ -> False
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByMember, createdAt, updatedAt}
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemForwarded, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByMember, createdAt, updatedAt}
|
||||
|
||||
dummyMeta :: ChatItemId -> UTCTime -> Text -> CIMeta c 'MDSnd
|
||||
dummyMeta itemId ts itemText =
|
||||
@@ -368,6 +369,7 @@ dummyMeta itemId ts itemText =
|
||||
itemText,
|
||||
itemStatus = CISSndNew,
|
||||
itemSharedMsgId = Nothing,
|
||||
itemForwarded = Nothing,
|
||||
itemDeleted = Nothing,
|
||||
itemEdited = False,
|
||||
itemTimed = Nothing,
|
||||
@@ -548,6 +550,21 @@ ciFileEnded = \case
|
||||
CIFSRcvError -> True
|
||||
CIFSInvalid {} -> True
|
||||
|
||||
ciFileLoaded :: CIFileStatus d -> Bool
|
||||
ciFileLoaded = \case
|
||||
CIFSSndStored -> True
|
||||
CIFSSndTransfer {} -> True
|
||||
CIFSSndComplete -> True
|
||||
CIFSSndCancelled -> True
|
||||
CIFSSndError -> True
|
||||
CIFSRcvInvitation -> False
|
||||
CIFSRcvAccepted -> False
|
||||
CIFSRcvTransfer {} -> False
|
||||
CIFSRcvCancelled -> False
|
||||
CIFSRcvComplete -> True
|
||||
CIFSRcvError -> False
|
||||
CIFSInvalid {} -> False
|
||||
|
||||
data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)
|
||||
|
||||
deriving instance Show ACIFileStatus
|
||||
@@ -981,11 +998,43 @@ itemDeletedTs = \case
|
||||
CIBlockedByAdmin ts -> ts
|
||||
CIModerated ts _ -> ts
|
||||
|
||||
data CIForwardedFrom
|
||||
= CIFFUnknown
|
||||
| CIFFContact {chatName :: Text, msgDir :: MsgDirection, contactId :: Maybe ContactId, chatItemId :: Maybe ChatItemId}
|
||||
| CIFFGroup {chatName :: Text, msgDir :: MsgDirection, groupId :: Maybe GroupId, chatItemId :: Maybe ChatItemId}
|
||||
deriving (Show)
|
||||
|
||||
cmForwardedFrom :: AChatMsgEvent -> Maybe CIForwardedFrom
|
||||
cmForwardedFrom = \case
|
||||
ACME _ (XMsgNew (MCForward _)) -> Just CIFFUnknown
|
||||
_ -> Nothing
|
||||
|
||||
data CIForwardedFromTag
|
||||
= CIFFUnknown_
|
||||
| CIFFContact_
|
||||
| CIFFGroup_
|
||||
|
||||
instance FromField CIForwardedFromTag where fromField = fromTextField_ textDecode
|
||||
|
||||
instance ToField CIForwardedFromTag where toField = toField . textEncode
|
||||
|
||||
instance TextEncoding CIForwardedFromTag where
|
||||
textDecode = \case
|
||||
"unknown" -> Just CIFFUnknown_
|
||||
"contact" -> Just CIFFContact_
|
||||
"group" -> Just CIFFGroup_
|
||||
_ -> Nothing
|
||||
textEncode = \case
|
||||
CIFFUnknown_ -> "unknown"
|
||||
CIFFContact_ -> "contact"
|
||||
CIFFGroup_ -> "group"
|
||||
|
||||
data ChatItemInfo = ChatItemInfo
|
||||
{ itemVersions :: [ChatItemVersion],
|
||||
memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
|
||||
memberDeliveryStatuses :: Maybe [MemberDeliveryStatus],
|
||||
forwardedFromChatItem :: Maybe AChatItem
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
deriving (Show)
|
||||
|
||||
data ChatItemVersion = ChatItemVersion
|
||||
{ chatItemVersionId :: Int64,
|
||||
@@ -1043,6 +1092,8 @@ instance ChatTypeI c => ToJSON (CIDeleted c) where
|
||||
toJSON = J.toJSON . jsonCIDeleted
|
||||
toEncoding = J.toEncoding . jsonCIDeleted
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CIFF") ''CIForwardedFrom)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''CITimed)
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "SSP") ''SndCIStatusProgress)
|
||||
@@ -1066,8 +1117,6 @@ $(JQ.deriveJSON defaultJSON ''MemberDeliveryStatus)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ChatItemVersion)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ChatItemInfo)
|
||||
|
||||
instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIMeta c d) where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''CIMeta)
|
||||
|
||||
@@ -1157,6 +1206,8 @@ instance ChatTypeI c => ToJSON (CChatItem c) where
|
||||
toJSON (CChatItem _ ci) = J.toJSON ci
|
||||
toEncoding (CChatItem _ ci) = J.toEncoding ci
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ChatItemInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ChatStats)
|
||||
|
||||
instance ChatTypeI c => ToJSON (Chat c) where
|
||||
|
||||
@@ -43,6 +43,8 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "MD") ''MsgDirection)
|
||||
|
||||
instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP
|
||||
|
||||
instance FromField MsgDirection where fromField = fromIntField_ msgDirectionIntP
|
||||
|
||||
instance ToField MsgDirection where toField = toField . msgDirectionInt
|
||||
|
||||
data SMsgDirection (d :: MsgDirection) where
|
||||
|
||||
36
src/Simplex/Chat/Migrations/M20240402_item_forwarded.hs
Normal file
36
src/Simplex/Chat/Migrations/M20240402_item_forwarded.hs
Normal file
@@ -0,0 +1,36 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20240402_item_forwarded where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20240402_item_forwarded :: Query
|
||||
m20240402_item_forwarded =
|
||||
[sql|
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_tag TEXT;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_chat_name TEXT;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_msg_dir INTEGER;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_contact_id INTEGER REFERENCES contacts ON DELETE SET NULL;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_group_id INTEGER REFERENCES groups ON DELETE SET NULL;
|
||||
ALTER TABLE chat_items ADD COLUMN fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL;
|
||||
|
||||
CREATE INDEX idx_chat_items_fwd_from_contact_id ON chat_items(fwd_from_contact_id);
|
||||
CREATE INDEX idx_chat_items_fwd_from_group_id ON chat_items(fwd_from_group_id);
|
||||
CREATE INDEX idx_chat_items_fwd_from_chat_item_id ON chat_items(fwd_from_chat_item_id);
|
||||
|]
|
||||
|
||||
down_m20240402_item_forwarded :: Query
|
||||
down_m20240402_item_forwarded =
|
||||
[sql|
|
||||
DROP INDEX idx_chat_items_fwd_from_contact_id;
|
||||
DROP INDEX idx_chat_items_fwd_from_group_id;
|
||||
DROP INDEX idx_chat_items_fwd_from_chat_item_id;
|
||||
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_tag;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_chat_name;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_msg_dir;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_contact_id;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_group_id;
|
||||
ALTER TABLE chat_items DROP COLUMN fwd_from_chat_item_id;
|
||||
|]
|
||||
@@ -382,7 +382,13 @@ CREATE TABLE chat_items(
|
||||
item_deleted_ts TEXT,
|
||||
forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
|
||||
item_content_tag TEXT,
|
||||
note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE
|
||||
note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE,
|
||||
fwd_from_tag TEXT,
|
||||
fwd_from_chat_name TEXT,
|
||||
fwd_from_msg_dir INTEGER,
|
||||
fwd_from_contact_id INTEGER REFERENCES contacts ON DELETE SET NULL,
|
||||
fwd_from_group_id INTEGER REFERENCES groups ON DELETE SET NULL,
|
||||
fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL
|
||||
);
|
||||
CREATE TABLE chat_item_messages(
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
@@ -860,3 +866,10 @@ CREATE INDEX idx_chat_items_notes_item_status on chat_items(
|
||||
item_status
|
||||
);
|
||||
CREATE INDEX idx_files_redirect_file_id on files(redirect_file_id);
|
||||
CREATE INDEX idx_chat_items_fwd_from_contact_id ON chat_items(
|
||||
fwd_from_contact_id
|
||||
);
|
||||
CREATE INDEX idx_chat_items_fwd_from_group_id ON chat_items(fwd_from_group_id);
|
||||
CREATE INDEX idx_chat_items_fwd_from_chat_item_id ON chat_items(
|
||||
fwd_from_chat_item_id
|
||||
);
|
||||
|
||||
@@ -588,6 +588,7 @@ parseMsgContainer :: J.Object -> JT.Parser MsgContainer
|
||||
parseMsgContainer v =
|
||||
MCQuote <$> v .: "quote" <*> mc
|
||||
<|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
|
||||
<|> (MCForward <$> ((v .: "forward" :: JT.Parser J.Object) *> mc))
|
||||
<|> MCSimple <$> mc
|
||||
where
|
||||
mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
|
||||
|
||||
@@ -145,8 +145,8 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserI
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
|
||||
import Simplex.Messaging.Util (eitherToMaybe)
|
||||
import UnliftIO.STM
|
||||
|
||||
@@ -330,9 +330,9 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
|
||||
(chatTs, userId, noteFolderId)
|
||||
_ -> pure ()
|
||||
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem timed live createdAt =
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt Nothing createdAt
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt =
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live createdAt Nothing createdAt
|
||||
where
|
||||
createdByMsgId = if msgId == 0 then Nothing else Just msgId
|
||||
quoteRow :: NewQuoteRow
|
||||
@@ -346,12 +346,13 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
||||
CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
|
||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||
|
||||
createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
||||
createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByMember createdAt
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live itemTs forwardedByMember createdAt
|
||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||
pure (ciId, quotedItem)
|
||||
pure (ciId, quotedItem, itemForwarded)
|
||||
where
|
||||
itemForwarded = cmForwardedFrom chatMsgEvent
|
||||
quotedMsg = cmToQuotedMsg chatMsgEvent
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = case quotedMsg of
|
||||
@@ -364,13 +365,13 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forw
|
||||
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg db user chatDirection ciContent itemTs =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False itemTs Nothing
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing Nothing False itemTs Nothing
|
||||
where
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByMember createdAt = do
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live itemTs forwardedByMember createdAt = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
@@ -381,10 +382,12 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id,
|
||||
forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id,
|
||||
-- forwarded from
|
||||
fwd_from_tag, fwd_from_chat_name, fwd_from_msg_dir, fwd_from_contact_id, fwd_from_group_id, fwd_from_chat_item_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow :. forwardedFromRow)
|
||||
ciId <- insertedRowId db
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
|
||||
pure ciId
|
||||
@@ -399,6 +402,16 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing, Nothing)
|
||||
CDLocalRcv NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId)
|
||||
CDLocalSnd NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId)
|
||||
forwardedFromRow :: (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
forwardedFromRow = case itemForwarded of
|
||||
Nothing ->
|
||||
(Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just CIFFUnknown ->
|
||||
(Just CIFFUnknown_, Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
Just CIFFContact {chatName, msgDir, contactId, chatItemId} ->
|
||||
(Just CIFFContact_, Just chatName, Just msgDir, contactId, Nothing, chatItemId)
|
||||
Just CIFFGroup {chatName, msgDir, groupId, chatItemId} ->
|
||||
(Just CIFFContact_, Just chatName, Just msgDir, Nothing, groupId, chatItemId)
|
||||
|
||||
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
|
||||
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
|
||||
@@ -794,7 +807,7 @@ getLocalChatPreview_ db user (LocalChatPD _ noteFolderId lastItemId_ stats) = do
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal)
|
||||
toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
@@ -826,7 +839,8 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @CTLocal deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -1391,7 +1405,14 @@ 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) :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow
|
||||
type ChatItemForwardedFromRow = (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
|
||||
type ChatItemRow =
|
||||
(Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId)
|
||||
:. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime)
|
||||
:. ChatItemForwardedFromRow
|
||||
:. ChatItemModeRow
|
||||
:. MaybeCIFIleRow
|
||||
|
||||
type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool)
|
||||
|
||||
@@ -1406,7 +1427,7 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
@@ -1438,10 +1459,19 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @CTDirect deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toCIForwardedFrom :: ChatItemForwardedFromRow -> Maybe CIForwardedFrom
|
||||
toCIForwardedFrom (fwdFromTag, fwdFromChatName, fwdFromMsgDir, fwdFromContactId, fwdFromGroupId, fwdFromChatItemId) =
|
||||
case (fwdFromTag, fwdFromChatName, fwdFromMsgDir, fwdFromContactId, fwdFromGroupId, fwdFromChatItemId) of
|
||||
(Just CIFFUnknown_, Nothing, Nothing, Nothing, Nothing, Nothing) -> Just CIFFUnknown
|
||||
(Just CIFFContact_, Just chatName, Just msgDir, contactId, Nothing, chatId) -> Just $ CIFFContact chatName msgDir contactId chatId
|
||||
(Just CIFFGroup_, Just chatName, Just msgDir, Nothing, groupId, chatId) -> Just $ CIFFGroup chatName msgDir groupId chatId
|
||||
_ -> Nothing
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
|
||||
@@ -1454,7 +1484,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 :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
@@ -1491,7 +1521,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
DBCIBlockedByAdmin -> Just (CIBlockedByAdmin deletedTs)
|
||||
_ -> Just (maybe (CIDeleted @CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -1726,7 +1757,10 @@ 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_deleted_ts, 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.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- DirectQuote
|
||||
@@ -1966,7 +2000,10 @@ 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_deleted_ts, 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.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- CIMeta forwardedByMember
|
||||
@@ -2067,7 +2104,10 @@ getLocalChatItem db User {userId} folderId 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_deleted_ts, 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.fwd_from_tag, i.fwd_from_chat_name, i.fwd_from_msg_dir, i.fwd_from_contact_id, i.fwd_from_group_id, i.fwd_from_chat_item_id,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol
|
||||
FROM chat_items i
|
||||
|
||||
@@ -104,6 +104,7 @@ import Simplex.Chat.Migrations.M20240226_users_restrict
|
||||
import Simplex.Chat.Migrations.M20240228_pq
|
||||
import Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id
|
||||
import Simplex.Chat.Migrations.M20240324_custom_data
|
||||
import Simplex.Chat.Migrations.M20240402_item_forwarded
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -207,7 +208,8 @@ schemaMigrations =
|
||||
("20240226_users_restrict", m20240226_users_restrict, Just down_m20240226_users_restrict),
|
||||
("20240228_pq", m20240228_pq, Just down_m20240228_pq),
|
||||
("20240313_drop_agent_ack_cmd_id", m20240313_drop_agent_ack_cmd_id, Just down_m20240313_drop_agent_ack_cmd_id),
|
||||
("20240324_custom_data", m20240324_custom_data, Just down_m20240324_custom_data)
|
||||
("20240324_custom_data", m20240324_custom_data, Just down_m20240324_custom_data),
|
||||
("20240402_item_forwarded", m20240402_item_forwarded, Just down_m20240402_item_forwarded)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -86,7 +86,10 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
|
||||
Right SendLiveMessage {} -> True
|
||||
Right SendFile {} -> True
|
||||
Right SendMessageQuote {} -> True
|
||||
Right ForwardMessage {} -> True
|
||||
Right ForwardLocalMessage {} -> True
|
||||
Right SendGroupMessageQuote {} -> True
|
||||
Right ForwardGroupMessage {} -> True
|
||||
Right SendMessageBroadcast {} -> True
|
||||
_ -> False
|
||||
startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
|
||||
|
||||
@@ -536,60 +536,68 @@ viewChats ts tz = concatMap chatPreview . reverse
|
||||
_ -> []
|
||||
|
||||
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
||||
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember}, content, quotedItem, file} doShow ts tz =
|
||||
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwardedByMember}, content, quotedItem, file} doShow ts tz =
|
||||
withGroupMsgForwarded . withItemDeleted <$> viewCI
|
||||
where
|
||||
viewCI = case chat of
|
||||
DirectChat c -> case chatDir of
|
||||
CIDirectSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
|
||||
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc
|
||||
CISndGroupEvent {} -> showSndItemProhibited to
|
||||
_ -> showSndItem to
|
||||
where
|
||||
to = ttyToContact' c
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
|
||||
CIRcvGroupEvent {} -> showRcvItemProhibited from
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
from = ttyFromContact c
|
||||
where
|
||||
quote = maybe [] (directQuote chatDir) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(directQuote chatDir)
|
||||
quotedItem
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
|
||||
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc
|
||||
CISndGroupInvitation {} -> showSndItemProhibited to
|
||||
_ -> showSndItem to
|
||||
where
|
||||
to = ttyToGroup g
|
||||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
|
||||
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
|
||||
CIRcvGroupInvitation {} -> showRcvItemProhibited from
|
||||
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
|
||||
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
|
||||
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) context meta [plainContent content] False
|
||||
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) context meta [plainContent content] False
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
from = ttyFromGroup g m
|
||||
where
|
||||
quote = maybe [] (groupQuote g) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(groupQuote g)
|
||||
quotedItem
|
||||
LocalChat _ -> case chatDir of
|
||||
CILocalSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to quote mc
|
||||
CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to context mc
|
||||
CISndGroupEvent {} -> showSndItemProhibited to
|
||||
_ -> showSndItem to
|
||||
where
|
||||
to = "* "
|
||||
CILocalRcv -> case content of
|
||||
CIRcvMsgContent mc -> withLocalFile from $ rcvMsg from quote mc
|
||||
CIRcvMsgContent mc -> withLocalFile from $ rcvMsg from context mc
|
||||
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
|
||||
CIRcvGroupEvent {} -> showRcvItemProhibited from
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
from = "* "
|
||||
where
|
||||
quote = []
|
||||
context = maybe [] forwardedFrom itemForwarded
|
||||
ContactRequest {} -> []
|
||||
ContactConnection {} -> []
|
||||
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
|
||||
@@ -604,10 +612,10 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
|
||||
withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file
|
||||
sndMsg = msg viewSentMessage
|
||||
rcvMsg = msg viewReceivedMessage
|
||||
msg view dir quote mc = case (msgContentText mc, file, quote) of
|
||||
msg view dir context mc = case (msgContentText mc, file, context) of
|
||||
("", Just _, []) -> []
|
||||
("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts tz meta
|
||||
_ -> view dir quote mc ts tz meta
|
||||
("", Just CIFile {fileName}, _) -> view dir context (MCText $ T.pack fileName) ts tz meta
|
||||
_ -> view dir context mc ts tz meta
|
||||
showSndItem to = showItem $ sentWithTime_ ts tz [to <> plainContent content] meta
|
||||
showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content] False
|
||||
showSndItemProhibited to = showItem $ sentWithTime_ ts tz [to <> plainContent content <> " " <> prohibited] meta
|
||||
@@ -617,11 +625,12 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
|
||||
prohibited = styled (colored Red) ("[unexpected chat item created, please report to developers]" :: String)
|
||||
|
||||
viewChatItemInfo :: AChatItem -> ChatItemInfo -> TimeZone -> [StyledString]
|
||||
viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTimed, createdAt}}) ChatItemInfo {itemVersions} tz =
|
||||
viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTimed, createdAt}}) ChatItemInfo {itemVersions, forwardedFromChatItem} tz =
|
||||
["sent at: " <> ts itemTs]
|
||||
<> receivedAt
|
||||
<> toBeDeletedAt
|
||||
<> versions
|
||||
<> forwardedFrom'
|
||||
where
|
||||
ts = styleTime . localTs tz
|
||||
receivedAt = case msgDir of
|
||||
@@ -634,7 +643,21 @@ viewChatItemInfo (AChatItem _ msgDir _ ChatItem {meta = CIMeta {itemTs, itemTime
|
||||
if null itemVersions
|
||||
then []
|
||||
else ["message history:"] <> concatMap version itemVersions
|
||||
version ChatItemVersion {msgContent, itemVersionTs} = prependFirst (ts itemVersionTs <> styleTime ": ") $ ttyMsgContent msgContent
|
||||
where
|
||||
version ChatItemVersion {msgContent, itemVersionTs} = prependFirst (ts itemVersionTs <> styleTime ": ") $ ttyMsgContent msgContent
|
||||
forwardedFrom' =
|
||||
case forwardedFromChatItem of
|
||||
Just fwdACI@(AChatItem _ fwdMsgDir fwdChatInfo _) ->
|
||||
[plain $ "forwarded from: " <> maybe "" (<> ", ") fwdDir_ <> fwdItemId]
|
||||
where
|
||||
fwdDir_ = case (fwdMsgDir, fwdChatInfo) of
|
||||
(SMDSnd, DirectChat ct) -> Just $ "you @" <> viewContactName ct
|
||||
(SMDRcv, DirectChat ct) -> Just $ "@" <> viewContactName ct
|
||||
(SMDSnd, GroupChat gInfo) -> Just $ "you #" <> viewGroupName gInfo
|
||||
(SMDRcv, GroupChat gInfo) -> Just $ "#" <> viewGroupName gInfo
|
||||
_ -> Nothing
|
||||
fwdItemId = "chat item id: " <> (T.pack . show $ aChatItemId fwdACI)
|
||||
_ -> []
|
||||
|
||||
localTs :: TimeZone -> UTCTime -> String
|
||||
localTs tz ts = do
|
||||
@@ -666,37 +689,45 @@ viewDeliveryReceipt = \case
|
||||
MRBadMsgHash -> ttyError' "⩗!"
|
||||
|
||||
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
||||
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
|
||||
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
|
||||
DirectChat c -> case chatDir of
|
||||
CIDirectRcv -> case content of
|
||||
CIRcvMsgContent mc
|
||||
| itemLive == Just True && not liveItems -> []
|
||||
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
|
||||
| otherwise -> viewReceivedUpdatedMessage from context mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
from = if itemEdited then ttyFromContactEdited c else ttyFromContact c
|
||||
CIDirectSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to context mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
to = if itemEdited then ttyToContactEdited' c else ttyToContact' c
|
||||
where
|
||||
quote = maybe [] (directQuote chatDir) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(directQuote chatDir)
|
||||
quotedItem
|
||||
GroupChat g -> case chatDir of
|
||||
CIGroupRcv m -> case content of
|
||||
CIRcvMsgContent mc
|
||||
| itemLive == Just True && not liveItems -> []
|
||||
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
|
||||
| otherwise -> viewReceivedUpdatedMessage from context mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
|
||||
CIGroupSnd -> case content of
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
|
||||
CISndMsgContent mc -> hideLive meta $ viewSentMessage to context mc ts tz meta
|
||||
_ -> []
|
||||
where
|
||||
to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
|
||||
where
|
||||
quote = maybe [] (groupQuote g) quotedItem
|
||||
context =
|
||||
maybe
|
||||
(maybe [] forwardedFrom itemForwarded)
|
||||
(groupQuote g)
|
||||
quotedItem
|
||||
_ -> []
|
||||
|
||||
hideLive :: CIMeta c d -> [StyledString] -> [StyledString]
|
||||
@@ -778,6 +809,14 @@ directQuote _ CIQuote {content = qmc, chatDir = quoteDir} =
|
||||
groupQuote :: GroupInfo -> CIQuote 'CTGroup -> [StyledString]
|
||||
groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQuotedMember $ sentByMember g quoteDir
|
||||
|
||||
forwardedFrom :: CIForwardedFrom -> [StyledString]
|
||||
forwardedFrom = \case
|
||||
CIFFUnknown -> ["-> forwarded"]
|
||||
CIFFContact c MDSnd _ _ -> ["<- you @" <> (plain . viewName) c]
|
||||
CIFFContact c MDRcv _ _ -> ["<- @" <> (plain . viewName) c]
|
||||
CIFFGroup g MDSnd _ _ -> ["<- you #" <> (plain . viewName) g]
|
||||
CIFFGroup g MDRcv _ _ -> ["<- #" <> (plain . viewName) g]
|
||||
|
||||
sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember
|
||||
sentByMember GroupInfo {membership} = \case
|
||||
CIQGroupSnd -> Just membership
|
||||
@@ -836,7 +875,9 @@ viewChatCleared :: AChatInfo -> [StyledString]
|
||||
viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of
|
||||
DirectChat ct -> [ttyContact' ct <> ": all messages are removed locally ONLY"]
|
||||
GroupChat gi -> [ttyGroup' gi <> ": all messages are removed locally ONLY"]
|
||||
_ -> []
|
||||
LocalChat _ -> ["notes: all messages are removed"]
|
||||
ContactRequest _ -> []
|
||||
ContactConnection _ -> []
|
||||
|
||||
viewContactsList :: [Contact] -> [StyledString]
|
||||
viewContactsList =
|
||||
@@ -1484,17 +1525,17 @@ viewReceivedUpdatedMessage :: StyledString -> [StyledString] -> MsgContent -> Cu
|
||||
viewReceivedUpdatedMessage = viewReceivedMessage_ True
|
||||
|
||||
viewReceivedMessage_ :: Bool -> StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewReceivedMessage_ updated from quote mc ts tz meta = receivedWithTime_ ts tz from quote meta (ttyMsgContent mc) updated
|
||||
viewReceivedMessage_ updated from context mc ts tz meta = receivedWithTime_ ts tz from context meta (ttyMsgContent mc) updated
|
||||
|
||||
viewReceivedReaction :: StyledString -> [StyledString] -> StyledString -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
|
||||
viewReceivedReaction from styledMsg reactionText ts tz reactionTs =
|
||||
prependFirst (ttyMsgTime ts tz reactionTs <> " " <> from) (styledMsg <> [" " <> reactionText])
|
||||
|
||||
receivedWithTime_ :: CurrentTime -> TimeZone -> StyledString -> [StyledString] -> CIMeta c d -> [StyledString] -> Bool -> [StyledString]
|
||||
receivedWithTime_ ts tz from quote CIMeta {itemId, itemTs, itemEdited, itemDeleted, itemLive} styledMsg updated = do
|
||||
prependFirst (ttyMsgTime ts tz itemTs <> " " <> from) (quote <> prependFirst (indent <> live) styledMsg)
|
||||
receivedWithTime_ ts tz from context CIMeta {itemId, itemTs, itemEdited, itemDeleted, itemLive} styledMsg updated = do
|
||||
prependFirst (ttyMsgTime ts tz itemTs <> " " <> from) (context <> prependFirst (indent <> live) styledMsg)
|
||||
where
|
||||
indent = if null quote then "" else " "
|
||||
indent = if null context then "" else " "
|
||||
live
|
||||
| itemEdited || isJust itemDeleted = ""
|
||||
| otherwise = case itemLive of
|
||||
@@ -1522,9 +1563,9 @@ recent now tz time = do
|
||||
|| (localNow < currentDay12 && localTime >= previousDay18 && localTimeDay < localNowDay)
|
||||
|
||||
viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString]
|
||||
viewSentMessage to quote mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts tz (prependFirst to $ quote <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
|
||||
viewSentMessage to context mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive} = sentWithTime_ ts tz (prependFirst to $ context <> prependFirst (indent <> live) (ttyMsgContent mc)) meta
|
||||
where
|
||||
indent = if null quote then "" else " "
|
||||
indent = if null context then "" else " "
|
||||
live
|
||||
| itemEdited || isJust itemDeleted = ""
|
||||
| otherwise = case itemLive of
|
||||
@@ -1926,6 +1967,7 @@ viewChatError logLevel testView = \case
|
||||
CEFallbackToSMPProhibited fileId -> ["recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited"]
|
||||
CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."]
|
||||
CEInvalidQuote -> ["cannot reply to this message"]
|
||||
CEInvalidForward -> ["cannot forward this message"]
|
||||
CEInvalidChatItemUpdate -> ["cannot update this item"]
|
||||
CEInvalidChatItemDelete -> ["cannot delete this item"]
|
||||
CEHasCurrentCall -> ["call already in progress"]
|
||||
|
||||
Reference in New Issue
Block a user