mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
Merge pull request #5588 from simplex-chat/mentions
This commit is contained in:
Evgeny
GitHub
commit
7f09de18d9
30 changed files with 1320 additions and 525 deletions
|
|
@ -30,6 +30,7 @@ import qualified Data.Text as T
|
|||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Directory.Store
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Markdown (displayNameTextP)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Protocol (MsgContent (..))
|
||||
|
|
@ -222,16 +223,10 @@ directoryCmdP =
|
|||
DCInviteOwnerToGroup_ -> gc DCInviteOwnerToGroup
|
||||
DCExecuteCommand_ -> DCExecuteCommand . T.unpack <$> (A.space *> A.takeText)
|
||||
where
|
||||
gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> displayNameP
|
||||
displayNameP = quoted '\'' <|> takeNameTill (== ' ')
|
||||
takeNameTill p =
|
||||
A.peekChar' >>= \c ->
|
||||
if refChar c then A.takeTill p else fail "invalid first character in display name"
|
||||
quoted c = A.char c *> takeNameTill (== c) <* A.char c
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@'
|
||||
gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> displayNameTextP
|
||||
|
||||
viewName :: Text -> Text
|
||||
viewName n = if any (== ' ') (T.unpack n) then "'" <> n <> "'" else n
|
||||
viewName n = if T.any (== ' ') n then "'" <> n <> "'" else n
|
||||
|
||||
directoryCmdTag :: DirectoryCmd r -> Text
|
||||
directoryCmdTag = \case
|
||||
|
|
|
|||
60
docs/rfcs/2025-01-20-member-mentions.md
Normal file
60
docs/rfcs/2025-01-20-member-mentions.md
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
# Member mentions
|
||||
|
||||
## Problem
|
||||
|
||||
Mention members in the messages.
|
||||
|
||||
There are several UX objectives that mentions must deliver:
|
||||
- to notify the user about the messages that mention the user or to reply to user's messages - groups must have this notification mode (already present in the API),
|
||||
- to allow the user to navigate to unread mentions and replies,
|
||||
- to highlight mentions and allow all users to open mentioned member profile - this is the least important objective.
|
||||
|
||||
## Solution
|
||||
|
||||
Message text should include the reference to the shared member display name:
|
||||
|
||||
```
|
||||
Hello @name
|
||||
```
|
||||
|
||||
or
|
||||
|
||||
```
|
||||
Hello @'member name'
|
||||
```
|
||||
|
||||
This is the same format that people already use and that is currently supported in the API. The name in the message should use the display name at the time of mention, both for backwards compatibility and for better view in compose field, and the message should additionally include the mapping from used display names to shared group member IDs, and the UI would show the current display name (at the time of loading the message to the view).
|
||||
|
||||
For this mapping the message JSON will include the array of mentions, as objects with properties `displayName` and `memberId`. This is to ensure the intent and that the fragments of text are treated as mentions.
|
||||
|
||||
Using an immutable `memberId` would prevent any race conditions and duplicate display names. The receiving client would show a local view name (display name or an alias), and might open a correct member card when mention is tapped.
|
||||
|
||||
As display names are not unique in the group, we should convert them to locally-unique names (per message), by appending _1, _2, as necessary, and the same locally unique names should be used in the mapping to member IDs. These locally unique names must NOT use local user aliases, and must NOT use localDisplayName, as otherwise it may leak information that is known only to the user's client.
|
||||
|
||||
There should be a reasonable limit on the number of mentions per message, e.g. 3. This is to prevent abuse, expensive processing both in the client and in super-peers that would have to forward member profiles if they were not forwarded before. This limit has to be enforced both on sending and receiving ends.
|
||||
|
||||
## UX for sending mentions
|
||||
|
||||
When a member types '@' character in the entry field, the app would show the paginated list of most recently active members, with search. This requires a separate API, and the same API can be used to show a paginated member list - loading the full list is already quite expensive with groups over 1-2k members.
|
||||
|
||||
## UX for navigating to mentions
|
||||
|
||||
The current circles with unread messages should indicate the number of unread mentions (including replies) above and below the view. Tapping the circle should navigate to the next unread mention, and not to the bottom/top of the conversation. Long-pressing the circle should offer the option to navigate to the top/bottom. In the absense of mentions, tapping circles would navigate to top/bottom.
|
||||
|
||||
## Message UI
|
||||
|
||||
Item text will include markdown elements for mentioned members. This will be used when rendering to show member display names or local aliases.
|
||||
|
||||
Chat items data will include the list of members used in the chat item, including view names and member IDs.
|
||||
|
||||
## Forwarding and saving to local items
|
||||
|
||||
When forwarding to another conversation or saving to notes a message with mentions the app should use:
|
||||
- current display names instead of display names used in the message.
|
||||
- remove mentions mapping from the message data.
|
||||
|
||||
## Schema
|
||||
|
||||
Two new columns for chat_items table:
|
||||
- user_mention - 0 or 1 to indicate whether a message is a reply to user's message or mentions user.
|
||||
- member_mentions - the object mapping display names to member IDs, either as JSON, or in a more economical comma-separated list of "ID:name" strings (or "ID:'member name'). This field can be processed to load mention information, with the limit of 3 mentions per message it's sufficient.
|
||||
|
|
@ -29,7 +29,6 @@ export type ChatCommand =
|
|||
| APIRejectContact
|
||||
| APIUpdateProfile
|
||||
| APISetContactAlias
|
||||
| APIParseMarkdown
|
||||
| NewGroup
|
||||
| APIAddMember
|
||||
| APIJoinGroup
|
||||
|
|
@ -128,7 +127,6 @@ type ChatCommandTag =
|
|||
| "apiRejectContact"
|
||||
| "apiUpdateProfile"
|
||||
| "apiSetContactAlias"
|
||||
| "apiParseMarkdown"
|
||||
| "newGroup"
|
||||
| "apiAddMember"
|
||||
| "apiJoinGroup"
|
||||
|
|
@ -355,11 +353,6 @@ export interface APISetContactAlias extends IChatCommand {
|
|||
localAlias: string
|
||||
}
|
||||
|
||||
export interface APIParseMarkdown extends IChatCommand {
|
||||
type: "apiParseMarkdown"
|
||||
text: string
|
||||
}
|
||||
|
||||
export interface NewGroup extends IChatCommand {
|
||||
type: "newGroup"
|
||||
groupProfile: GroupProfile
|
||||
|
|
@ -732,8 +725,6 @@ export function cmdString(cmd: ChatCommand): string {
|
|||
return `/_profile ${cmd.userId} ${JSON.stringify(cmd.profile)}`
|
||||
case "apiSetContactAlias":
|
||||
return `/_set alias @${cmd.contactId} ${cmd.localAlias.trim()}`
|
||||
case "apiParseMarkdown":
|
||||
return `/_parse ${cmd.text}`
|
||||
case "newGroup":
|
||||
return `/_group ${JSON.stringify(cmd.groupProfile)}`
|
||||
case "apiAddMember":
|
||||
|
|
|
|||
|
|
@ -221,6 +221,7 @@ library
|
|||
Simplex.Chat.Store.SQLite.Migrations.M20250105_indexes
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20250115_chat_ttl
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_history
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions
|
||||
other-modules:
|
||||
Paths_simplex_chat
|
||||
hs-source-dirs:
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ import Control.Concurrent.Async
|
|||
import Control.Concurrent.STM
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Controller
|
||||
|
|
@ -69,8 +69,8 @@ sendComposedMessage cc = sendComposedMessage' cc . contactId'
|
|||
|
||||
sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO ()
|
||||
sendComposedMessage' cc ctId quotedItemId msgContent = do
|
||||
let cm = ComposedMessage {fileSource = Nothing, quotedItemId, msgContent}
|
||||
sendChatCmd cc (APISendMessages (ChatRef CTDirect ctId) False Nothing (cm :| [])) >>= \case
|
||||
let cm = ComposedMessage {fileSource = Nothing, quotedItemId, msgContent, mentions = M.empty}
|
||||
sendChatCmd cc (APISendMessages (ChatRef CTDirect ctId) False Nothing [cm]) >>= \case
|
||||
CRNewChatItems {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
|
||||
r -> putStrLn $ "unexpected send message response: " <> show r
|
||||
|
||||
|
|
|
|||
|
|
@ -39,6 +39,7 @@ import Data.Int (Int64)
|
|||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeLatin1)
|
||||
|
|
@ -313,7 +314,7 @@ data ChatCommand
|
|||
| APICreateChatItems {noteFolderId :: NoteFolderId, composedMessages :: NonEmpty ComposedMessage}
|
||||
| APIReportMessage {groupId :: GroupId, chatItemId :: ChatItemId, reportReason :: ReportReason, reportText :: Text}
|
||||
| ReportMessage {groupName :: GroupName, contactName_ :: Maybe ContactName, reportReason :: ReportReason, reportedMessage :: Text}
|
||||
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
|
||||
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, updatedMessage :: UpdatedMessage}
|
||||
| APIDeleteChatItem ChatRef (NonEmpty ChatItemId) CIDeleteMode
|
||||
| APIDeleteMemberChatItem GroupId (NonEmpty ChatItemId)
|
||||
| APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction}
|
||||
|
|
@ -346,7 +347,6 @@ data ChatCommand
|
|||
| APISetConnectionAlias Int64 LocalAlias
|
||||
| APISetUserUIThemes UserId (Maybe UIThemeEntityOverrides)
|
||||
| APISetChatUIThemes ChatRef (Maybe UIThemeEntityOverrides)
|
||||
| APIParseMarkdown Text
|
||||
| APIGetNtfToken
|
||||
| APIRegisterToken DeviceToken NotificationsMode
|
||||
| APIVerifyToken DeviceToken C.CbNonce ByteString
|
||||
|
|
@ -1085,22 +1085,16 @@ data UserProfileUpdateSummary = UserProfileUpdateSummary
|
|||
data ComposedMessage = ComposedMessage
|
||||
{ fileSource :: Maybe CryptoFile,
|
||||
quotedItemId :: Maybe ChatItemId,
|
||||
msgContent :: MsgContent
|
||||
msgContent :: MsgContent,
|
||||
mentions :: Map MemberName GroupMemberId
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
-- This instance is needed for backward compatibility, can be removed in v6.0
|
||||
instance FromJSON ComposedMessage where
|
||||
parseJSON (J.Object v) = do
|
||||
fileSource <-
|
||||
(v .:? "fileSource") >>= \case
|
||||
Nothing -> CF.plain <$$> (v .:? "filePath")
|
||||
f -> pure f
|
||||
quotedItemId <- v .:? "quotedItemId"
|
||||
msgContent <- v .: "msgContent"
|
||||
pure ComposedMessage {fileSource, quotedItemId, msgContent}
|
||||
parseJSON invalid =
|
||||
JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
|
||||
data UpdatedMessage = UpdatedMessage
|
||||
{ msgContent :: MsgContent,
|
||||
mentions :: Map MemberName GroupMemberId
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data ChatTagData = ChatTagData
|
||||
{ emoji :: Maybe Text,
|
||||
|
|
@ -1273,7 +1267,6 @@ data ChatErrorType
|
|||
| CEFileNotApproved {fileId :: FileTransferId, unknownServers :: [XFTPServer]}
|
||||
| CEFallbackToSMPProhibited {fileId :: FileTransferId}
|
||||
| CEInlineFileProhibited {fileId :: FileTransferId}
|
||||
| CEInvalidQuote
|
||||
| CEInvalidForward
|
||||
| CEInvalidChatItemUpdate
|
||||
| CEInvalidChatItemDelete
|
||||
|
|
@ -1635,4 +1628,19 @@ $(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig)
|
|||
|
||||
$(JQ.deriveToJSON defaultJSON ''ComposedMessage)
|
||||
|
||||
instance FromJSON ComposedMessage where
|
||||
parseJSON (J.Object v) = do
|
||||
fileSource <-
|
||||
(v .:? "fileSource") >>= \case
|
||||
Nothing -> CF.plain <$$> (v .:? "filePath")
|
||||
f -> pure f
|
||||
quotedItemId <- v .:? "quotedItemId"
|
||||
msgContent <- v .: "msgContent"
|
||||
mentions <- fromMaybe M.empty <$> v .:? "mentions"
|
||||
pure ComposedMessage {fileSource, quotedItemId, msgContent, mentions}
|
||||
parseJSON invalid =
|
||||
JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UpdatedMessage)
|
||||
|
||||
$(JQ.deriveToJSON defaultJSON ''ChatTagData)
|
||||
|
|
|
|||
|
|
@ -537,12 +537,16 @@ processChatCommand' vr = \case
|
|||
Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTGroup gId) fwdItemId)
|
||||
_ -> pure Nothing
|
||||
APISendMessages (ChatRef cType chatId) live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case cType of
|
||||
CTDirect ->
|
||||
CTDirect -> do
|
||||
mapM_ assertNoMentions cms
|
||||
withContactLock "sendMessage" chatId $
|
||||
sendContactContentMessages user chatId live itemTTL (L.map (,Nothing) cms)
|
||||
sendContactContentMessages user chatId live itemTTL (L.map composedMessageReq cms)
|
||||
CTGroup ->
|
||||
withGroupLock "sendMessage" chatId $
|
||||
sendGroupContentMessages user chatId live itemTTL (L.map (,Nothing) cms)
|
||||
withGroupLock "sendMessage" chatId $ do
|
||||
(gInfo, cmrs) <- withFastStore $ \db -> do
|
||||
g <- getGroupInfo db vr user chatId
|
||||
(g,) <$> mapM (composedMessageReqMentions db user g) cms
|
||||
sendGroupContentMessages user gInfo live itemTTL cmrs
|
||||
CTLocal -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
|
|
@ -567,8 +571,8 @@ processChatCommand' vr = \case
|
|||
withFastStore' $ \db -> reorderChatTags db user $ L.toList tagIds
|
||||
ok user
|
||||
APICreateChatItems folderId cms -> withUser $ \user -> do
|
||||
mapM_ assertAllowedContent' cms
|
||||
createNoteFolderContentItems user folderId (L.map (,Nothing) cms)
|
||||
forM_ cms $ \cm -> assertAllowedContent' cm >> assertNoMentions cm
|
||||
createNoteFolderContentItems user folderId (L.map composedMessageReq cms)
|
||||
APIReportMessage gId reportedItemId reportReason reportText -> withUser $ \user ->
|
||||
withGroupLock "reportMessage" gId $ do
|
||||
(gInfo, ms) <-
|
||||
|
|
@ -577,9 +581,9 @@ processChatCommand' vr = \case
|
|||
(gInfo,) <$> liftIO (getGroupModerators db vr user gInfo)
|
||||
let ms' = filter compatibleModerator ms
|
||||
mc = MCReport reportText reportReason
|
||||
cm = ComposedMessage {fileSource = Nothing, quotedItemId = Just reportedItemId, msgContent = mc}
|
||||
cm = ComposedMessage {fileSource = Nothing, quotedItemId = Just reportedItemId, msgContent = mc, mentions = M.empty}
|
||||
when (null ms') $ throwChatError $ CECommandError "no moderators support receiving reports"
|
||||
sendGroupContentMessages_ user gInfo ms' False Nothing [(cm, Nothing)]
|
||||
sendGroupContentMessages_ user gInfo ms' False Nothing [composedMessageReq cm]
|
||||
where
|
||||
compatibleModerator GroupMember {activeConn, memberChatVRange} =
|
||||
maxVersion (maybe memberChatVRange peerChatVRange activeConn) >= contentReportsVersion
|
||||
|
|
@ -587,8 +591,9 @@ processChatCommand' vr = \case
|
|||
gId <- withFastStore $ \db -> getGroupIdByName db user groupName
|
||||
reportedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId contactName_ reportedMessage
|
||||
processChatCommand $ APIReportMessage gId reportedItemId reportReason ""
|
||||
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> assertAllowedContent mc >> case cType of
|
||||
APIUpdateChatItem (ChatRef cType chatId) itemId live (UpdatedMessage mc mentions) -> withUser $ \user -> assertAllowedContent mc >> case cType of
|
||||
CTDirect -> withContactLock "updateChatItem" chatId $ do
|
||||
unless (null mentions) $ throwChatError $ CECommandError "mentions are not supported in this chat"
|
||||
ct@Contact {contactId} <- withFastStore $ \db -> getContact db vr user chatId
|
||||
assertDirectAllowed user MDSnd ct XMsgUpdate_
|
||||
cci <- withFastStore $ \db -> getDirectCIWithReactions db user ct itemId
|
||||
|
|
@ -599,7 +604,7 @@ processChatCommand' vr = \case
|
|||
let changed = mc /= oldMC
|
||||
if changed || fromMaybe False itemLive
|
||||
then do
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
(SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XMsgUpdate itemSharedMId mc M.empty (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ci' <- withFastStore' $ \db -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
when changed $
|
||||
|
|
@ -614,7 +619,8 @@ processChatCommand' vr = \case
|
|||
CTGroup -> withGroupLock "updateChatItem" chatId $ do
|
||||
Group gInfo@GroupInfo {groupId, membership} ms <- withFastStore $ \db -> getGroup db vr user chatId
|
||||
assertUserGroupRole gInfo GRAuthor
|
||||
if prohibitedSimplexLinks gInfo membership mc
|
||||
let (_, ft_) = msgContentTexts mc
|
||||
if prohibitedSimplexLinks gInfo membership ft_
|
||||
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFSimplexLinks))
|
||||
else do
|
||||
cci <- withFastStore $ \db -> getGroupCIWithReactions db user gInfo itemId
|
||||
|
|
@ -625,19 +631,23 @@ processChatCommand' vr = \case
|
|||
let changed = mc /= oldMC
|
||||
if changed || fromMaybe False itemLive
|
||||
then do
|
||||
SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ciMentions <- withFastStore $ \db -> getCIMentions db user gInfo ft_ mentions
|
||||
let mentions' = M.map (\CIMention {memberId} -> MsgMention {memberId}) ciMentions
|
||||
SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc mentions' (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
|
||||
ci' <- withFastStore' $ \db -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
when changed $
|
||||
addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
|
||||
let edited = itemLive /= Just True
|
||||
updateGroupChatItem db user groupId ci (CISndMsgContent mc) edited live $ Just msgId
|
||||
ci' <- updateGroupChatItem db user groupId ci (CISndMsgContent mc) edited live $ Just msgId
|
||||
updateGroupCIMentions db gInfo ci' ciMentions
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci')
|
||||
else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
|
||||
_ -> throwChatError CEInvalidChatItemUpdate
|
||||
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
|
||||
CTLocal -> do
|
||||
unless (null mentions) $ throwChatError $ CECommandError "mentions are not supported in this chat"
|
||||
(nf@NoteFolder {noteFolderId}, cci) <- withFastStore $ \db -> (,) <$> getNoteFolder db user chatId <*> getLocalChatItem db user chatId itemId
|
||||
case cci of
|
||||
CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent oldMC}
|
||||
|
|
@ -699,7 +709,7 @@ processChatCommand' vr = \case
|
|||
itemsMsgIds :: [CChatItem c] -> [SharedMsgId]
|
||||
itemsMsgIds = mapMaybe (\(CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId}}) -> itemSharedMsgId)
|
||||
APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do
|
||||
(gInfo@GroupInfo {membership}, items) <- getCommandGroupChatItems user gId itemIds
|
||||
(gInfo, items) <- getCommandGroupChatItems user gId itemIds
|
||||
ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
|
||||
assertDeletable gInfo items
|
||||
assertUserGroupRole gInfo GRAdmin -- TODO GRModerator when most users migrate
|
||||
|
|
@ -825,7 +835,7 @@ processChatCommand' vr = \case
|
|||
MCFile t -> t /= ""
|
||||
MCReport {} -> True
|
||||
MCUnknown {} -> True
|
||||
APIForwardChatItems (ChatRef toCType toChatId) (ChatRef fromCType fromChatId) itemIds itemTTL -> withUser $ \user -> case toCType of
|
||||
APIForwardChatItems toChat@(ChatRef toCType toChatId) fromChat@(ChatRef fromCType fromChatId) itemIds itemTTL -> withUser $ \user -> case toCType of
|
||||
CTDirect -> do
|
||||
cmrs <- prepareForward user
|
||||
case L.nonEmpty cmrs of
|
||||
|
|
@ -837,8 +847,9 @@ processChatCommand' vr = \case
|
|||
cmrs <- prepareForward user
|
||||
case L.nonEmpty cmrs of
|
||||
Just cmrs' ->
|
||||
withGroupLock "forwardChatItem, to group" toChatId $
|
||||
sendGroupContentMessages user toChatId False itemTTL cmrs'
|
||||
withGroupLock "forwardChatItem, to group" toChatId $ do
|
||||
gInfo <- withFastStore $ \db -> getGroupInfo db vr user toChatId
|
||||
sendGroupContentMessages user gInfo False itemTTL cmrs'
|
||||
Nothing -> pure $ CRNewChatItems user []
|
||||
CTLocal -> do
|
||||
cmrs <- prepareForward user
|
||||
|
|
@ -849,17 +860,17 @@ processChatCommand' vr = \case
|
|||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
where
|
||||
prepareForward :: User -> CM [ComposeMessageReq]
|
||||
prepareForward :: User -> CM [ComposedMessageReq]
|
||||
prepareForward user = case fromCType of
|
||||
CTDirect -> withContactLock "forwardChatItem, from contact" fromChatId $ do
|
||||
(ct, items) <- getCommandDirectChatItems user fromChatId itemIds
|
||||
catMaybes <$> mapM (\ci -> ciComposeMsgReq ct ci <$$> prepareMsgReq ci) items
|
||||
where
|
||||
ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq
|
||||
ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
|
||||
ciComposeMsgReq ct (CChatItem md ci) (mc', file) =
|
||||
let itemId = chatItemId' ci
|
||||
ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) (toMsgDirection md) (Just fromChatId) (Just itemId))
|
||||
in (ComposedMessage file Nothing mc', ciff)
|
||||
in (composedMessage file mc', ciff, msgContentTexts mc', M.empty)
|
||||
where
|
||||
forwardName :: Contact -> ContactName
|
||||
forwardName Contact {profile = LocalProfile {displayName, localAlias}}
|
||||
|
|
@ -869,11 +880,16 @@ processChatCommand' vr = \case
|
|||
(gInfo, items) <- getCommandGroupChatItems user fromChatId itemIds
|
||||
catMaybes <$> mapM (\ci -> ciComposeMsgReq gInfo ci <$$> prepareMsgReq ci) items
|
||||
where
|
||||
ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq
|
||||
ciComposeMsgReq gInfo (CChatItem md ci) (mc', file) = do
|
||||
ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
|
||||
ciComposeMsgReq gInfo (CChatItem md ci@ChatItem {mentions, formattedText}) (mc, file) = do
|
||||
let itemId = chatItemId' ci
|
||||
ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) (toMsgDirection md) (Just fromChatId) (Just itemId))
|
||||
in (ComposedMessage file Nothing mc', ciff)
|
||||
-- updates text to reflect current mentioned member names
|
||||
(mc', _, mentions') = updatedMentionNames mc formattedText mentions
|
||||
-- only includes mentions when forwarding to the same group
|
||||
ciMentions = if toChat == fromChat then mentions' else M.empty
|
||||
-- no need to have mentions in ComposedMessage, they are in ciMentions
|
||||
in (ComposedMessage file Nothing mc' M.empty, ciff, msgContentTexts mc', ciMentions)
|
||||
where
|
||||
forwardName :: GroupInfo -> ContactName
|
||||
forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName
|
||||
|
|
@ -881,10 +897,10 @@ processChatCommand' vr = \case
|
|||
(_, items) <- getCommandLocalChatItems user fromChatId itemIds
|
||||
catMaybes <$> mapM (\ci -> ciComposeMsgReq ci <$$> prepareMsgReq ci) items
|
||||
where
|
||||
ciComposeMsgReq :: CChatItem 'CTLocal -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq
|
||||
ciComposeMsgReq :: CChatItem 'CTLocal -> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
|
||||
ciComposeMsgReq (CChatItem _ ci) (mc', file) =
|
||||
let ciff = forwardCIFF ci Nothing
|
||||
in (ComposedMessage file Nothing mc', ciff)
|
||||
in (composedMessage file mc', ciff, msgContentTexts mc', M.empty)
|
||||
CTContactRequest -> throwChatError $ CECommandError "not supported"
|
||||
CTContactConnection -> throwChatError $ CECommandError "not supported"
|
||||
where
|
||||
|
|
@ -1288,7 +1304,6 @@ processChatCommand' vr = \case
|
|||
liftIO $ setGroupUIThemes db user g uiThemes
|
||||
ok user
|
||||
_ -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text
|
||||
APIGetNtfToken -> withUser' $ \_ -> crNtfToken <$> withAgent getNtfToken
|
||||
APIRegisterToken token mode -> withUser $ \_ ->
|
||||
CRNtfTokenStatus <$> withAgent (\a -> registerNtfToken a token mode)
|
||||
|
|
@ -1844,7 +1859,7 @@ processChatCommand' vr = \case
|
|||
withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case
|
||||
Right ctId -> do
|
||||
let chatRef = ChatRef CTDirect ctId
|
||||
processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| [])
|
||||
processChatCommand $ APISendMessages chatRef False Nothing [composedMessage Nothing mc]
|
||||
Left _ ->
|
||||
withFastStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case
|
||||
Right [(gInfo, member)] -> do
|
||||
|
|
@ -1856,13 +1871,15 @@ processChatCommand' vr = \case
|
|||
_ ->
|
||||
throwChatError $ CEContactNotFound name Nothing
|
||||
CTGroup -> do
|
||||
gId <- withFastStore $ \db -> getGroupIdByName db user name
|
||||
(gId, mentions) <- withFastStore $ \db -> do
|
||||
gId <- getGroupIdByName db user name
|
||||
(gId,) <$> liftIO (getMessageMentions db user gId msg)
|
||||
let chatRef = ChatRef CTGroup gId
|
||||
processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| [])
|
||||
processChatCommand $ APISendMessages chatRef False Nothing [ComposedMessage Nothing Nothing mc mentions]
|
||||
CTLocal
|
||||
| name == "" -> do
|
||||
folderId <- withFastStore (`getUserNoteFolderId` user)
|
||||
processChatCommand $ APICreateChatItems folderId (ComposedMessage Nothing Nothing mc :| [])
|
||||
processChatCommand $ APICreateChatItems folderId [composedMessage Nothing mc]
|
||||
| otherwise -> throwChatError $ CECommandError "not supported"
|
||||
_ -> throwChatError $ CECommandError "not supported"
|
||||
SendMemberContactMessage gName mName msg -> withUser $ \user -> do
|
||||
|
|
@ -1881,11 +1898,11 @@ processChatCommand' vr = \case
|
|||
cr -> pure cr
|
||||
Just ctId -> do
|
||||
let chatRef = ChatRef CTDirect ctId
|
||||
processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage Nothing Nothing mc :| [])
|
||||
processChatCommand $ APISendMessages chatRef False Nothing [composedMessage Nothing mc]
|
||||
SendLiveMessage chatName msg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
(chatRef, mentions) <- getChatRefAndMentions user chatName msg
|
||||
let mc = MCText msg
|
||||
processChatCommand $ APISendMessages chatRef True Nothing (ComposedMessage Nothing Nothing mc :| [])
|
||||
processChatCommand $ APISendMessages chatRef True Nothing [ComposedMessage Nothing Nothing mc mentions]
|
||||
SendMessageBroadcast msg -> withUser $ \user -> do
|
||||
contacts <- withFastStore' $ \db -> getUserContacts db vr user
|
||||
withChatLock "sendMessageBroadcast" . procCmd $ do
|
||||
|
|
@ -1926,7 +1943,7 @@ processChatCommand' vr = \case
|
|||
contactId <- withFastStore $ \db -> getContactIdByName db user cName
|
||||
quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
|
||||
let mc = MCText msg
|
||||
processChatCommand $ APISendMessages (ChatRef CTDirect contactId) False Nothing (ComposedMessage Nothing (Just quotedItemId) mc :| [])
|
||||
processChatCommand $ APISendMessages (ChatRef CTDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty]
|
||||
DeleteMessage chatName deletedMsg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
|
||||
|
|
@ -1936,14 +1953,14 @@ processChatCommand' vr = \case
|
|||
deletedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user gId (Just mName) deletedMsg
|
||||
processChatCommand $ APIDeleteMemberChatItem gId (deletedItemId :| [])
|
||||
EditMessage chatName editedMsg msg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
(chatRef, mentions) <- getChatRefAndMentions user chatName msg
|
||||
editedItemId <- getSentChatItemIdByText user chatRef editedMsg
|
||||
let mc = MCText msg
|
||||
processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc
|
||||
processChatCommand $ APIUpdateChatItem chatRef editedItemId False $ UpdatedMessage mc mentions
|
||||
UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
(chatRef, mentions) <- getChatRefAndMentions user chatName msg
|
||||
let mc = MCText msg
|
||||
processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc
|
||||
processChatCommand $ APIUpdateChatItem chatRef chatItemId live $ UpdatedMessage mc mentions
|
||||
ReactToMessage add reaction chatName msg -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
chatItemId <- getChatItemIdByText user chatRef msg
|
||||
|
|
@ -2213,10 +2230,13 @@ processChatCommand' vr = \case
|
|||
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
|
||||
processChatCommand $ APIGetGroupLink groupId
|
||||
SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
|
||||
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
|
||||
quotedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg
|
||||
(groupId, quotedItemId, mentions) <-
|
||||
withFastStore $ \db -> do
|
||||
gId <- getGroupIdByName db user gName
|
||||
qiId <- getGroupChatItemIdByText db user gId cName quotedMsg
|
||||
(gId, qiId,) <$> liftIO (getMessageMentions db user gId msg)
|
||||
let mc = MCText msg
|
||||
processChatCommand $ APISendMessages (ChatRef CTGroup groupId) False Nothing (ComposedMessage Nothing (Just quotedItemId) mc :| [])
|
||||
processChatCommand $ APISendMessages (ChatRef CTGroup groupId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions]
|
||||
ClearNoteFolder -> withUser $ \user -> do
|
||||
folderId <- withFastStore (`getUserNoteFolderId` user)
|
||||
processChatCommand $ APIClearChat (ChatRef CTLocal folderId)
|
||||
|
|
@ -2256,8 +2276,8 @@ processChatCommand' vr = \case
|
|||
SendFile chatName f -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
case chatRef of
|
||||
ChatRef CTLocal folderId -> processChatCommand $ APICreateChatItems folderId (ComposedMessage (Just f) Nothing (MCFile "") :| [])
|
||||
_ -> processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage (Just f) Nothing (MCFile "") :| [])
|
||||
ChatRef CTLocal folderId -> processChatCommand $ APICreateChatItems folderId [composedMessage (Just f) (MCFile "")]
|
||||
_ -> processChatCommand $ APISendMessages chatRef False Nothing [composedMessage (Just f) (MCFile "")]
|
||||
SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
filePath <- lift $ toFSFilePath fPath
|
||||
|
|
@ -2265,7 +2285,7 @@ processChatCommand' vr = \case
|
|||
fileSize <- getFileSize filePath
|
||||
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
|
||||
-- TODO include file description for preview
|
||||
processChatCommand $ APISendMessages chatRef False Nothing (ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview) :| [])
|
||||
processChatCommand $ APISendMessages chatRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)]
|
||||
ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
|
||||
ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
|
||||
SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
|
||||
|
|
@ -2486,6 +2506,12 @@ processChatCommand' vr = \case
|
|||
| name == "" -> withFastStore (`getUserNoteFolderId` user)
|
||||
| otherwise -> throwChatError $ CECommandError "not supported"
|
||||
_ -> throwChatError $ CECommandError "not supported"
|
||||
getChatRefAndMentions :: User -> ChatName -> Text -> CM (ChatRef, Map MemberName GroupMemberId)
|
||||
getChatRefAndMentions user cName msg = do
|
||||
chatRef@(ChatRef cType chatId) <- getChatRef user cName
|
||||
(chatRef,) <$> case cType of
|
||||
CTGroup -> withFastStore' $ \db -> getMessageMentions db user chatId msg
|
||||
_ -> pure []
|
||||
#if !defined(dbPostgres)
|
||||
checkChatStopped :: CM ChatResponse -> CM ChatResponse
|
||||
checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
|
||||
|
|
@ -2935,12 +2961,13 @@ processChatCommand' vr = \case
|
|||
cReqHashes :: (ConnReqUriHash, ConnReqUriHash)
|
||||
cReqHashes = bimap hash hash cReqSchemas
|
||||
hash = ConnReqUriHash . C.sha256Hash . strEncode
|
||||
updateCIGroupInvitationStatus :: User -> GroupInfo -> CIGroupInvitationStatus -> CM ()
|
||||
updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do
|
||||
AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db vr user groupId
|
||||
case (cInfo, content) of
|
||||
(DirectChat ct@Contact {contactId}, CIRcvGroupInvitation ciGroupInv@CIGroupInvitation {status} memRole)
|
||||
| status == CIGISPending -> do
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = newStatus} memRole
|
||||
let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation (ciGroupInv {status = newStatus} :: CIGroupInvitation) memRole
|
||||
timed_ <- contactCITimed ct
|
||||
updateDirectChatItemView user ct itemId aciContent False False timed_ Nothing
|
||||
forM_ (timed_ >>= timedDeleteAt') $
|
||||
|
|
@ -2951,8 +2978,12 @@ processChatCommand' vr = \case
|
|||
MCReport {} -> throwChatError $ CECommandError "sending reports via this API is not supported"
|
||||
_ -> pure ()
|
||||
assertAllowedContent' :: ComposedMessage -> CM ()
|
||||
assertAllowedContent' ComposedMessage {msgContent} = assertAllowedContent msgContent
|
||||
sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse
|
||||
assertAllowedContent' ComposedMessage {msgContent} = assertAllowedContent msgContent
|
||||
assertNoMentions :: ComposedMessage -> CM ()
|
||||
assertNoMentions ComposedMessage {mentions}
|
||||
| null mentions = pure ()
|
||||
| otherwise = throwChatError $ CECommandError "mentions are not supported in this chat"
|
||||
sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
|
||||
sendContactContentMessages user contactId live itemTTL cmrs = do
|
||||
assertMultiSendable live cmrs
|
||||
ct@Contact {contactUsed} <- withFastStore $ \db -> getContact db vr user contactId
|
||||
|
|
@ -2963,7 +2994,7 @@ processChatCommand' vr = \case
|
|||
where
|
||||
assertVoiceAllowed :: Contact -> CM ()
|
||||
assertVoiceAllowed ct =
|
||||
when (not (featureAllowed SCFVoice forUser ct) && any (\(ComposedMessage {msgContent}, _) -> isVoice msgContent) cmrs) $
|
||||
when (not (featureAllowed SCFVoice forUser ct) && any (\(ComposedMessage {msgContent}, _, _, _) -> isVoice msgContent) cmrs) $
|
||||
throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFVoice))
|
||||
processComposedMessages :: Contact -> CM ChatResponse
|
||||
processComposedMessages ct = do
|
||||
|
|
@ -2971,7 +3002,7 @@ processChatCommand' vr = \case
|
|||
timed_ <- sndContactCITimed live ct itemTTL
|
||||
(msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_
|
||||
msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers
|
||||
let itemsData = prepareSndItemsData msgs_ cmrs ciFiles_ quotedItems_
|
||||
let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) msgs_
|
||||
when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch"
|
||||
r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live
|
||||
processSendErrs user r
|
||||
|
|
@ -2982,39 +3013,39 @@ processChatCommand' vr = \case
|
|||
where
|
||||
setupSndFileTransfers :: CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
|
||||
setupSndFileTransfers =
|
||||
forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> case file_ of
|
||||
forM cmrs $ \(ComposedMessage {fileSource = file_}, _, _, _) -> case file_ of
|
||||
Just file -> do
|
||||
fileSize <- checkSndFile file
|
||||
(fInv, ciFile) <- xftpSndFileTransfer user file fileSize 1 $ CGContact ct
|
||||
pure (Just fInv, Just ciFile)
|
||||
Nothing -> pure (Nothing, Nothing)
|
||||
prepareMsgs :: NonEmpty (ComposeMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
|
||||
prepareMsgs cmsFileInvs timed_ =
|
||||
forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded), fInv_) ->
|
||||
prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
|
||||
prepareMsgs cmsFileInvs timed_ = withFastStore $ \db ->
|
||||
forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded, _, _), fInv_) -> do
|
||||
case (quotedItemId, itemForwarded) of
|
||||
(Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc M.empty fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, Just _) -> pure (MCForward (ExtMsgContent mc M.empty fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Just qiId, Nothing) -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withFastStore $ \db -> getDirectChatItem db user contactId qiId
|
||||
getDirectChatItem db user contactId qiId
|
||||
(origQmc, qd, sent) <- quoteData qci
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
||||
qmc = quoteContent mc origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just qiId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
(Just _, Just _) -> throwChatError CEInvalidQuote
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc M.empty fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
(Just _, Just _) -> throwError SEInvalidQuote
|
||||
where
|
||||
quoteData :: ChatItem c d -> CM (MsgContent, CIQDirection 'CTDirect, Bool)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
|
||||
quoteData :: ChatItem c d -> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwError SEInvalidQuote
|
||||
quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True)
|
||||
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
|
||||
quoteData _ = throwChatError CEInvalidQuote
|
||||
sendGroupContentMessages :: User -> GroupId -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse
|
||||
sendGroupContentMessages user groupId live itemTTL cmrs = do
|
||||
quoteData _ = throwError SEInvalidQuote
|
||||
sendGroupContentMessages :: User -> GroupInfo -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
|
||||
sendGroupContentMessages user gInfo live itemTTL cmrs = do
|
||||
assertMultiSendable live cmrs
|
||||
Group gInfo ms <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
|
||||
sendGroupContentMessages_ user gInfo ms live itemTTL cmrs
|
||||
sendGroupContentMessages_ :: User -> GroupInfo -> [GroupMember] -> Bool -> Maybe Int -> NonEmpty ComposeMessageReq -> CM ChatResponse
|
||||
sendGroupContentMessages_ :: User -> GroupInfo -> [GroupMember] -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
|
||||
sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} ms live itemTTL cmrs = do
|
||||
assertUserGroupRole gInfo GRAuthor
|
||||
assertGroupContentAllowed
|
||||
|
|
@ -3026,18 +3057,18 @@ processChatCommand' vr = \case
|
|||
Just f -> throwChatError (CECommandError $ "feature not allowed " <> T.unpack (groupFeatureNameText f))
|
||||
Nothing -> pure ()
|
||||
where
|
||||
findProhibited :: [ComposeMessageReq] -> Maybe GroupFeature
|
||||
findProhibited :: [ComposedMessageReq] -> Maybe GroupFeature
|
||||
findProhibited =
|
||||
foldr'
|
||||
(\(ComposedMessage {fileSource, msgContent = mc}, _) acc -> prohibitedGroupContent gInfo membership mc fileSource <|> acc)
|
||||
(\(ComposedMessage {fileSource, msgContent = mc}, _, (_, ft), _) acc -> prohibitedGroupContent gInfo membership mc ft fileSource <|> acc)
|
||||
Nothing
|
||||
processComposedMessages :: CM ChatResponse
|
||||
processComposedMessages = do
|
||||
(fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length $ filter memberCurrent ms)
|
||||
timed_ <- sndGroupCITimed live gInfo itemTTL
|
||||
(msgContainers, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_
|
||||
(msgs_, gsr) <- sendGroupMessages user gInfo ms $ L.map XMsgNew msgContainers
|
||||
let itemsData = prepareSndItemsData (L.toList msgs_) cmrs ciFiles_ quotedItems_
|
||||
(chatMsgEvents, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_
|
||||
(msgs_, gsr) <- sendGroupMessages user gInfo ms chatMsgEvents
|
||||
let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_)
|
||||
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live
|
||||
when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
|
||||
createMemberSndStatuses cis_ msgs_ gsr
|
||||
|
|
@ -3050,16 +3081,17 @@ processChatCommand' vr = \case
|
|||
where
|
||||
setupSndFileTransfers :: Int -> CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
|
||||
setupSndFileTransfers n =
|
||||
forM cmrs $ \(ComposedMessage {fileSource = file_}, _) -> case file_ of
|
||||
forM cmrs $ \(ComposedMessage {fileSource = file_}, _, _, _) -> case file_ of
|
||||
Just file -> do
|
||||
fileSize <- checkSndFile file
|
||||
(fInv, ciFile) <- xftpSndFileTransfer user file fileSize n $ CGGroup gInfo ms
|
||||
pure (Just fInv, Just ciFile)
|
||||
Nothing -> pure (Nothing, Nothing)
|
||||
prepareMsgs :: NonEmpty (ComposeMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTGroup)))
|
||||
prepareMsgs cmsFileInvs timed_ =
|
||||
forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded), fInv_) ->
|
||||
prepareGroupMsg user gInfo mc quotedItemId itemForwarded fInv_ timed_ live
|
||||
prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
|
||||
prepareMsgs cmsFileInvs timed_ = withFastStore $ \db ->
|
||||
forM cmsFileInvs $ \((ComposedMessage {quotedItemId, msgContent = mc}, itemForwarded, _, ciMentions), fInv_) ->
|
||||
let mentions = M.map (\CIMention {memberId} -> MsgMention {memberId}) ciMentions
|
||||
in prepareGroupMsg db user gInfo mc mentions quotedItemId itemForwarded fInv_ timed_ live
|
||||
createMemberSndStatuses ::
|
||||
[Either ChatError (ChatItem 'CTGroup 'MDSnd)] ->
|
||||
NonEmpty (Either ChatError SndMessage) ->
|
||||
|
|
@ -3095,7 +3127,7 @@ processChatCommand' vr = \case
|
|||
Right _ -> GSSInactive
|
||||
Left e -> GSSError $ SndErrOther $ tshow e
|
||||
forM_ ciId_ $ \ciId -> createGroupSndStatus db ciId mId status
|
||||
assertMultiSendable :: Bool -> NonEmpty ComposeMessageReq -> CM ()
|
||||
assertMultiSendable :: Bool -> NonEmpty ComposedMessageReq -> CM ()
|
||||
assertMultiSendable live cmrs
|
||||
| length cmrs == 1 = pure ()
|
||||
| otherwise =
|
||||
|
|
@ -3103,7 +3135,7 @@ processChatCommand' vr = \case
|
|||
-- This is to support case of sending multiple attachments while also quoting another message.
|
||||
-- UI doesn't allow composing with multiple quotes, so api prohibits it as well, and doesn't bother
|
||||
-- batching retrieval of quoted messages (prepareMsgs).
|
||||
when (live || length (L.filter (\(ComposedMessage {quotedItemId}, _) -> isJust quotedItemId) cmrs) > 1) $
|
||||
when (live || length (L.filter (\(ComposedMessage {quotedItemId}, _, _, _) -> isJust quotedItemId) cmrs) > 1) $
|
||||
throwChatError (CECommandError "invalid multi send: live and more than one quote not supported")
|
||||
xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd)
|
||||
xftpSndFileTransfer user file fileSize n contactOrGroup = do
|
||||
|
|
@ -3121,19 +3153,15 @@ processChatCommand' vr = \case
|
|||
saveMemberFD _ = pure ()
|
||||
pure (fInv, ciFile)
|
||||
prepareSndItemsData ::
|
||||
[ComposedMessageReq] ->
|
||||
[Maybe (CIFile 'MDSnd)] ->
|
||||
[Maybe (CIQuote c)] ->
|
||||
[Either ChatError SndMessage] ->
|
||||
NonEmpty ComposeMessageReq ->
|
||||
NonEmpty (Maybe (CIFile 'MDSnd)) ->
|
||||
NonEmpty (Maybe (CIQuote c)) ->
|
||||
[Either ChatError (NewSndChatItemData c)]
|
||||
prepareSndItemsData msgs_ cmrs' ciFiles_ quotedItems_ =
|
||||
[ ( case msg_ of
|
||||
Right msg -> Right $ NewSndChatItemData msg (CISndMsgContent msgContent) f q itemForwarded
|
||||
Left e -> Left e -- step over original error
|
||||
)
|
||||
| (msg_, (ComposedMessage {msgContent}, itemForwarded), f, q) <-
|
||||
zipWith4 (,,,) msgs_ (L.toList cmrs') (L.toList ciFiles_) (L.toList quotedItems_)
|
||||
]
|
||||
prepareSndItemsData =
|
||||
zipWith4 $ \(ComposedMessage {msgContent}, itemForwarded, ts, mm) f q -> \case
|
||||
Right msg -> Right $ NewSndChatItemData msg (CISndMsgContent msgContent) ts mm f q itemForwarded
|
||||
Left e -> Left e -- step over original error
|
||||
processSendErrs :: User -> ([ChatError], [ChatItem c d]) -> CM ()
|
||||
processSendErrs user = \case
|
||||
-- no errors
|
||||
|
|
@ -3158,12 +3186,12 @@ processChatCommand' vr = \case
|
|||
getCommandGroupChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (GroupInfo, [CChatItem 'CTGroup])
|
||||
getCommandGroupChatItems user gId itemIds = do
|
||||
gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
|
||||
(errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds))
|
||||
(errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db gInfo) (L.toList itemIds))
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
pure (gInfo, items)
|
||||
where
|
||||
getGroupCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
|
||||
getGroupCI db itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user gId itemId
|
||||
getGroupCI :: DB.Connection -> GroupInfo -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
|
||||
getGroupCI db gInfo itemId = runExceptT . withExceptT ChatErrorStore $ getGroupCIWithReactions db user gInfo itemId
|
||||
getCommandLocalChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (NoteFolder, [CChatItem 'CTLocal])
|
||||
getCommandLocalChatItems user nfId itemIds = do
|
||||
nf <- withStore $ \db -> getNoteFolder db user nfId
|
||||
|
|
@ -3178,7 +3206,7 @@ processChatCommand' vr = \case
|
|||
forwardMsgContent ChatItem {content = CISndMsgContent fmc} = pure $ Just fmc
|
||||
forwardMsgContent ChatItem {content = CIRcvMsgContent fmc} = pure $ Just fmc
|
||||
forwardMsgContent _ = throwChatError CEInvalidForward
|
||||
createNoteFolderContentItems :: User -> NoteFolderId -> NonEmpty ComposeMessageReq -> CM ChatResponse
|
||||
createNoteFolderContentItems :: User -> NoteFolderId -> NonEmpty ComposedMessageReq -> CM ChatResponse
|
||||
createNoteFolderContentItems user folderId cmrs = do
|
||||
assertNoQuotes
|
||||
nf <- withFastStore $ \db -> getNoteFolder db user folderId
|
||||
|
|
@ -3190,11 +3218,11 @@ processChatCommand' vr = \case
|
|||
where
|
||||
assertNoQuotes :: CM ()
|
||||
assertNoQuotes =
|
||||
when (any (\(ComposedMessage {quotedItemId}, _) -> isJust quotedItemId) cmrs) $
|
||||
when (any (\(ComposedMessage {quotedItemId}, _, _, _) -> isJust quotedItemId) cmrs) $
|
||||
throwChatError (CECommandError "createNoteFolderContentItems: quotes not supported")
|
||||
createLocalFiles :: NoteFolder -> UTCTime -> CM (NonEmpty (Maybe (CIFile 'MDSnd)))
|
||||
createLocalFiles nf createdAt =
|
||||
forM cmrs $ \(ComposedMessage {fileSource = file_}, _) ->
|
||||
forM cmrs $ \(ComposedMessage {fileSource = file_}, _, _, _) ->
|
||||
forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do
|
||||
fsFilePath <- lift $ toFSFilePath filePath
|
||||
fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs
|
||||
|
|
@ -3203,13 +3231,12 @@ processChatCommand' vr = \case
|
|||
fileId <- createLocalFile CIFSSndStored db user nf createdAt cf fileSize chunkSize
|
||||
pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndStored, fileProtocol = FPLocal}
|
||||
prepareLocalItemsData ::
|
||||
NonEmpty ComposeMessageReq ->
|
||||
NonEmpty ComposedMessageReq ->
|
||||
NonEmpty (Maybe (CIFile 'MDSnd)) ->
|
||||
[(CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom)]
|
||||
prepareLocalItemsData cmrs' ciFiles_ =
|
||||
[ (CISndMsgContent mc, f, itemForwarded)
|
||||
| ((ComposedMessage {msgContent = mc}, itemForwarded), f) <- zip (L.toList cmrs') (L.toList ciFiles_)
|
||||
]
|
||||
NonEmpty (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList))
|
||||
prepareLocalItemsData =
|
||||
L.zipWith $ \(ComposedMessage {msgContent = mc}, itemForwarded, ts, _) f ->
|
||||
(CISndMsgContent mc, f, itemForwarded, ts)
|
||||
getConnQueueInfo user Connection {connId, agentConnId = AgentConnId acId} = do
|
||||
msgInfo <- withFastStore' (`getLastRcvMsgInfo` connId)
|
||||
CRQueueInfo user msgInfo <$> withAgent (`getConnectionQueueInfo` acId)
|
||||
|
|
@ -3231,7 +3258,18 @@ updatedServers p' srvs UserOperatorServers {operator, smpServers, xftpServers} =
|
|||
disableSrv srv@UserServer {preset} =
|
||||
AUS SDBStored $ if preset then srv {enabled = False} else srv {deleted = True}
|
||||
|
||||
type ComposeMessageReq = (ComposedMessage, Maybe CIForwardedFrom)
|
||||
type ComposedMessageReq = (ComposedMessage, Maybe CIForwardedFrom, (Text, Maybe MarkdownList), Map MemberName CIMention)
|
||||
|
||||
composedMessage :: Maybe CryptoFile -> MsgContent -> ComposedMessage
|
||||
composedMessage f mc = ComposedMessage {fileSource = f, quotedItemId = Nothing, msgContent = mc, mentions = M.empty}
|
||||
|
||||
composedMessageReq :: ComposedMessage -> ComposedMessageReq
|
||||
composedMessageReq cm@ComposedMessage {msgContent = mc} = (cm, Nothing, msgContentTexts mc, M.empty)
|
||||
|
||||
composedMessageReqMentions :: DB.Connection -> User -> GroupInfo -> ComposedMessage -> ExceptT StoreError IO ComposedMessageReq
|
||||
composedMessageReqMentions db user g cm@ComposedMessage {msgContent = mc, mentions} = do
|
||||
let ts@(_, ft_) = msgContentTexts mc
|
||||
(cm,Nothing,ts,) <$> getCIMentions db user g ft_ mentions
|
||||
|
||||
data ChangedProfileContact = ChangedProfileContact
|
||||
{ ct :: Contact,
|
||||
|
|
@ -3692,7 +3730,7 @@ chatCommandP =
|
|||
"/_create *" *> (APICreateChatItems <$> A.decimal <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)),
|
||||
"/_report #" *> (APIReportMessage <$> A.decimal <* A.space <*> A.decimal <*> (" reason=" *> strP) <*> (A.space *> textP <|> pure "")),
|
||||
"/report #" *> (ReportMessage <$> displayNameP <*> optional (" @" *> displayNameP) <*> _strP <* A.space <*> msgTextP),
|
||||
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
|
||||
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <*> (" json" *> jsonP <|> " text " *> updatedMessagesTextP)),
|
||||
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <*> _strP <*> _strP),
|
||||
"/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <*> _strP),
|
||||
"/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP),
|
||||
|
|
@ -3725,7 +3763,6 @@ chatCommandP =
|
|||
"/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP),
|
||||
"/_set theme user " *> (APISetUserUIThemes <$> A.decimal <*> optional (A.space *> jsonP)),
|
||||
"/_set theme " *> (APISetChatUIThemes <$> chatRefP <*> optional (A.space *> jsonP)),
|
||||
"/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString),
|
||||
"/_ntf get" $> APIGetNtfToken,
|
||||
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
|
||||
"/_ntf verify " *> (APIVerifyToken <$> strP <* A.space <*> strP <* A.space <*> strP),
|
||||
|
|
@ -4003,7 +4040,8 @@ chatCommandP =
|
|||
c -> c
|
||||
composedMessagesTextP = do
|
||||
text <- mcTextP
|
||||
pure $ (ComposedMessage Nothing Nothing text) :| []
|
||||
pure [composedMessage Nothing text]
|
||||
updatedMessagesTextP = (`UpdatedMessage` []) <$> mcTextP
|
||||
liveMessageP = " live=" *> onOffP <|> pure False
|
||||
sendMessageTTLP = " ttl=" *> ((Just <$> A.decimal) <|> ("default" $> Nothing)) <|> pure Nothing
|
||||
receiptSettings = do
|
||||
|
|
@ -4123,7 +4161,7 @@ displayNameP = safeDecodeUtf8 <$> (quoted '\'' <|> takeNameTill (\c -> isSpace c
|
|||
A.peekChar' >>= \c ->
|
||||
if refChar c then A.takeTill p else fail "invalid first character in display name"
|
||||
quoted c = A.char c *> takeNameTill (== c) <* A.char c
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@'
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
|
||||
|
||||
mkValidName :: String -> String
|
||||
mkValidName = reverse . dropWhile isSpace . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
|
||||
|
|
|
|||
|
|
@ -29,6 +29,8 @@ import Crypto.Random (ChaChaDRG)
|
|||
import Data.Bifunctor (first)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Char (isDigit)
|
||||
import Data.Containers.ListUtils (nubOrd)
|
||||
import Data.Either (partitionEithers, rights)
|
||||
import Data.Fixed (div')
|
||||
import Data.Foldable (foldr')
|
||||
|
|
@ -102,6 +104,12 @@ import UnliftIO.STM
|
|||
maxMsgReactions :: Int
|
||||
maxMsgReactions = 3
|
||||
|
||||
maxRcvMentions :: Int
|
||||
maxRcvMentions = 5
|
||||
|
||||
maxSndMentions :: Int
|
||||
maxSndMentions = 3
|
||||
|
||||
withChatLock :: String -> CM a -> CM a
|
||||
withChatLock name action = asks chatLock >>= \l -> withLock l name action
|
||||
|
||||
|
|
@ -181,25 +189,108 @@ toggleNtf user m ntfOn =
|
|||
forM_ (memberConnId m) $ \connId ->
|
||||
withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user))
|
||||
|
||||
prepareGroupMsg :: User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> CM (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of
|
||||
(Nothing, Nothing) -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
(Nothing, Just _) -> pure (MCForward (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
prepareGroupMsg :: DB.Connection -> User -> GroupInfo -> MsgContent -> Map MemberName MsgMention -> Maybe ChatItemId -> Maybe CIForwardedFrom -> Maybe FileInvitation -> Maybe CITimed -> Bool -> ExceptT StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
|
||||
prepareGroupMsg db user g@GroupInfo {membership} mc mentions quotedItemId_ itemForwarded fInv_ timed_ live = case (quotedItemId_, itemForwarded) of
|
||||
(Nothing, Nothing) ->
|
||||
let mc' = MCSimple $ ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live)
|
||||
in pure (XMsgNew mc', Nothing)
|
||||
(Nothing, Just _) ->
|
||||
let mc' = MCForward $ ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live)
|
||||
in pure (XMsgNew mc', Nothing)
|
||||
(Just quotedItemId, Nothing) -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getGroupChatItem db user groupId quotedItemId
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, mentions = quoteMentions, file} <-
|
||||
getGroupCIWithReactions db user g quotedItemId
|
||||
(origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
|
||||
qmc = quoteContent mc origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
(Just _, Just _) -> throwChatError CEInvalidQuote
|
||||
(qmc', ft', _) = updatedMentionNames qmc formattedText quoteMentions
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc', formattedText = ft'}
|
||||
mc' = MCQuote QuotedMsg {msgRef, content = qmc'} (ExtMsgContent mc mentions fInv_ (ttl' <$> timed_) (justTrue live))
|
||||
pure (XMsgNew mc', Just quotedItem)
|
||||
(Just _, Just _) -> throwError SEInvalidQuote
|
||||
where
|
||||
quoteData :: ChatItem c d -> GroupMember -> CM (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
|
||||
quoteData :: ChatItem c d -> GroupMember -> ExceptT StoreError IO (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwError SEInvalidQuote
|
||||
quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
|
||||
quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
|
||||
quoteData _ _ = throwChatError CEInvalidQuote
|
||||
quoteData _ _ = throwError SEInvalidQuote
|
||||
|
||||
updatedMentionNames :: MsgContent -> Maybe MarkdownList -> Map MemberName CIMention -> (MsgContent, Maybe MarkdownList, Map MemberName CIMention)
|
||||
updatedMentionNames mc ft_ mentions = case ft_ of
|
||||
Just ft | not (null ft) && not (null mentions) && not (all sameName $ M.assocs mentions) ->
|
||||
let (mentions', ft') = mapAccumL update M.empty ft
|
||||
text = T.concat $ map markdownText ft'
|
||||
in (mc {text} :: MsgContent, Just ft', mentions')
|
||||
_ -> (mc, ft_, mentions)
|
||||
where
|
||||
sameName (name, CIMention {memberRef}) = case memberRef of
|
||||
Just CIMentionMember {displayName} -> case T.stripPrefix displayName name of
|
||||
Just rest
|
||||
| T.null rest -> True
|
||||
| otherwise -> case T.uncons rest of
|
||||
Just ('_', suffix) -> T.all isDigit suffix
|
||||
_ -> False
|
||||
Nothing -> False
|
||||
Nothing -> True
|
||||
update mentions' ft@(FormattedText f _) = case f of
|
||||
Just (Mention name) -> case M.lookup name mentions of
|
||||
Just mm@CIMention {memberRef} ->
|
||||
let name' = uniqueMentionName 0 $ case memberRef of
|
||||
Just CIMentionMember {displayName} -> displayName
|
||||
Nothing -> name
|
||||
in (M.insert name' mm mentions', FormattedText (Just $ Mention name') ('@' `T.cons` viewName name'))
|
||||
Nothing -> (mentions', ft)
|
||||
_ -> (mentions', ft)
|
||||
where
|
||||
uniqueMentionName :: Int -> Text -> Text
|
||||
uniqueMentionName pfx name =
|
||||
let prefixed = if pfx == 0 then name else (name `T.snoc` '_') <> tshow pfx
|
||||
in if prefixed `M.member` mentions' then uniqueMentionName (pfx + 1) name else prefixed
|
||||
|
||||
getCIMentions :: DB.Connection -> User -> GroupInfo -> Maybe MarkdownList -> Map MemberName GroupMemberId -> ExceptT StoreError IO (Map MemberName CIMention)
|
||||
getCIMentions db user GroupInfo {groupId} ft_ mentions = case ft_ of
|
||||
Just ft | not (null ft) && not (null mentions) -> do
|
||||
let msgMentions = S.fromList $ mentionedNames ft
|
||||
n = M.size mentions
|
||||
-- prevent "invisible" and repeated-with-different-name mentions (when the same member is mentioned via another name)
|
||||
unless (n <= maxSndMentions && all (`S.member` msgMentions) (M.keys mentions) && S.size (S.fromList $ M.elems mentions) == n) $
|
||||
throwError SEInvalidMention
|
||||
mapM (getMentionedGroupMember db user groupId) mentions
|
||||
_ -> pure M.empty
|
||||
|
||||
getRcvCIMentions :: DB.Connection -> User -> GroupInfo -> Maybe MarkdownList -> Map MemberName MsgMention -> IO (Map MemberName CIMention)
|
||||
getRcvCIMentions db user GroupInfo {groupId} ft_ mentions = case ft_ of
|
||||
Just ft | not (null ft) && not (null mentions) ->
|
||||
let mentions' = uniqueMsgMentions maxRcvMentions mentions $ mentionedNames ft
|
||||
in mapM (getMentionedMemberByMemberId db user groupId) mentions'
|
||||
_ -> pure M.empty
|
||||
|
||||
-- prevent "invisible" and repeated-with-different-name mentions
|
||||
uniqueMsgMentions :: Int -> Map MemberName MsgMention -> [ContactName] -> Map MemberName MsgMention
|
||||
uniqueMsgMentions maxMentions mentions = go M.empty S.empty 0
|
||||
where
|
||||
go acc _ _ [] = acc
|
||||
go acc seen n (name : rest)
|
||||
| n >= maxMentions = acc
|
||||
| otherwise = case M.lookup name mentions of
|
||||
Just mm@MsgMention {memberId} | S.notMember memberId seen ->
|
||||
go (M.insert name mm acc) (S.insert memberId seen) (n + 1) rest
|
||||
_ -> go acc seen n rest
|
||||
|
||||
getMessageMentions :: DB.Connection -> User -> GroupId -> Text -> IO (Map MemberName GroupMemberId)
|
||||
getMessageMentions db user gId msg = case parseMaybeMarkdownList msg of
|
||||
Just ft | not (null ft) -> M.fromList . catMaybes <$> mapM get (nubOrd $ mentionedNames ft)
|
||||
_ -> pure M.empty
|
||||
where
|
||||
get name =
|
||||
fmap (name,) . eitherToMaybe
|
||||
<$> runExceptT (getGroupMemberIdByName db user gId name)
|
||||
|
||||
msgContentTexts :: MsgContent -> (Text, Maybe MarkdownList)
|
||||
msgContentTexts mc = let t = msgContentText mc in (t, parseMaybeMarkdownList t)
|
||||
|
||||
ciContentTexts :: CIContent d -> (Text, Maybe MarkdownList)
|
||||
ciContentTexts content = let t = ciContentToText content in (t, parseMaybeMarkdownList t)
|
||||
|
||||
quoteContent :: forall d. MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent
|
||||
quoteContent mc qmc ciFile_
|
||||
|
|
@ -228,17 +319,17 @@ quoteContent mc qmc ciFile_
|
|||
qFileName = maybe qText (T.pack . getFileName) ciFile_
|
||||
qTextOrFile = if T.null qText then qFileName else qText
|
||||
|
||||
prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe f -> Maybe GroupFeature
|
||||
prohibitedGroupContent gInfo m mc file_
|
||||
prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe MarkdownList -> Maybe f -> Maybe GroupFeature
|
||||
prohibitedGroupContent gInfo m mc ft file_
|
||||
| isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) = Just GFVoice
|
||||
| not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles
|
||||
| prohibitedSimplexLinks gInfo m mc = Just GFSimplexLinks
|
||||
| prohibitedSimplexLinks gInfo m ft = Just GFSimplexLinks
|
||||
| otherwise = Nothing
|
||||
|
||||
prohibitedSimplexLinks :: GroupInfo -> GroupMember -> MsgContent -> Bool
|
||||
prohibitedSimplexLinks gInfo m mc =
|
||||
prohibitedSimplexLinks :: GroupInfo -> GroupMember -> Maybe MarkdownList -> Bool
|
||||
prohibitedSimplexLinks gInfo m ft =
|
||||
not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo)
|
||||
&& maybe False (any ftIsSimplexLink) (parseMaybeMarkdownList $ msgContentText mc)
|
||||
&& maybe False (any ftIsSimplexLink) ft
|
||||
where
|
||||
ftIsSimplexLink :: FormattedText -> Bool
|
||||
ftIsSimplexLink FormattedText {format} = maybe False isSimplexLink format
|
||||
|
|
@ -863,9 +954,6 @@ startUpdatedTimedItemThread user chatRef ci ci' =
|
|||
metaBrokerTs :: MsgMeta -> UTCTime
|
||||
metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs
|
||||
|
||||
sameMemberId :: MemberId -> GroupMember -> Bool
|
||||
sameMemberId memId GroupMember {memberId} = memId == memberId
|
||||
|
||||
createContactPQSndItem :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection)
|
||||
createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' =
|
||||
flip catchChatError (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of
|
||||
|
|
@ -1549,15 +1637,19 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me
|
|||
saveSndChatItem :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> CM (ChatItem c 'MDSnd)
|
||||
saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing Nothing False
|
||||
|
||||
-- TODO [mentions] optimize by avoiding unnecesary parsing of control messages
|
||||
saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd)
|
||||
saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live =
|
||||
saveSndChatItems user cd [Right NewSndChatItemData {msg, content, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case
|
||||
saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live = do
|
||||
let itemTexts = ciContentTexts content
|
||||
saveSndChatItems user cd [Right NewSndChatItemData {msg, content, itemTexts, itemMentions = M.empty, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case
|
||||
[Right ci] -> pure ci
|
||||
_ -> throwChatError $ CEInternalError "saveSndChatItem': expected 1 item"
|
||||
|
||||
data NewSndChatItemData c = NewSndChatItemData
|
||||
{ msg :: SndMessage,
|
||||
content :: CIContent 'MDSnd,
|
||||
itemTexts :: (Text, Maybe MarkdownList),
|
||||
itemMentions :: Map MemberName CIMention,
|
||||
ciFile :: Maybe (CIFile 'MDSnd),
|
||||
quotedItem :: Maybe (CIQuote c),
|
||||
itemForwarded :: Maybe CIForwardedFrom
|
||||
|
|
@ -1579,31 +1671,56 @@ saveSndChatItems user cd itemsData itemTimed live = do
|
|||
lift $ withStoreBatch (\db -> map (bindRight $ createItem db createdAt) itemsData)
|
||||
where
|
||||
createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd))
|
||||
createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, ciFile, quotedItem, itemForwarded} = do
|
||||
createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, itemTexts, itemMentions, ciFile, quotedItem, itemForwarded} = do
|
||||
ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt
|
||||
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
|
||||
pure $ Right $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live createdAt Nothing createdAt
|
||||
let ci = mkChatItem_ cd ciId content itemTexts ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live False createdAt Nothing createdAt
|
||||
Right <$> case cd of
|
||||
CDGroupSnd g | not (null itemMentions) -> createGroupCIMentions db g ci itemMentions
|
||||
_ -> pure ci
|
||||
|
||||
saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> CM (ChatItem c 'MDRcv)
|
||||
saveRcvChatItemNoParse :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> CM (ChatItem c 'MDRcv)
|
||||
saveRcvChatItemNoParse user cd msg brokerTs = saveRcvChatItem user cd msg brokerTs . ciContentNoParse
|
||||
|
||||
saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> CM (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content =
|
||||
saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False
|
||||
saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty
|
||||
|
||||
saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do
|
||||
ciContentNoParse :: CIContent 'MDRcv -> (CIContent 'MDRcv, (Text, Maybe MarkdownList))
|
||||
ciContentNoParse content = (content, (ciContentToText content, Nothing))
|
||||
|
||||
saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv)
|
||||
saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
(ciId, quotedItem, itemForwarded) <- withStore' $ \db -> do
|
||||
withStore' $ \db -> do
|
||||
when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt
|
||||
r@(ciId, _, _) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt
|
||||
(mentions' :: Map MemberName CIMention, userMention) <- case cd of
|
||||
CDGroupRcv g@GroupInfo {membership} _ -> do
|
||||
mentions' <- getRcvCIMentions db user g ft_ mentions
|
||||
let userReply = case cmToQuotedMsg chatMsgEvent of
|
||||
Just QuotedMsg {msgRef = MsgRef {memberId = Just mId}} -> sameMemberId mId membership
|
||||
_ -> False
|
||||
userMention' = userReply || any (\CIMention {memberId} -> sameMemberId memberId membership) mentions'
|
||||
in pure (mentions', userMention')
|
||||
CDDirectRcv _ -> pure (M.empty, False)
|
||||
(ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt
|
||||
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
|
||||
pure r
|
||||
pure $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live brokerTs forwardedByMember createdAt
|
||||
let ci = mkChatItem_ cd ciId content (t, ft_) ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live userMention brokerTs forwardedByMember createdAt
|
||||
case cd of
|
||||
CDGroupRcv g _ | not (null mentions') -> createGroupCIMentions db g ci mentions'
|
||||
_ -> pure ci
|
||||
|
||||
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
|
||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemForwarded itemTimed live itemTs forwardedByMember currentTs =
|
||||
let itemText = ciContentToText content
|
||||
itemStatus = ciCreateStatus content
|
||||
meta = mkCIMeta ciId content itemText itemStatus Nothing sharedMsgId itemForwarded Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByMember currentTs currentTs
|
||||
in ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
|
||||
-- TODO [mentions] optimize by avoiding unnecessary parsing
|
||||
mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
|
||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs =
|
||||
let ts = ciContentTexts content
|
||||
in mkChatItem_ cd ciId content ts file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs
|
||||
|
||||
mkChatItem_ :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> (Text, Maybe MarkdownList) -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d
|
||||
mkChatItem_ cd ciId content (itemText, formattedText) file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs =
|
||||
let itemStatus = ciCreateStatus content
|
||||
meta = mkCIMeta ciId content itemText itemStatus Nothing sharedMsgId itemForwarded Nothing False itemTimed (justTrue live) userMention currentTs itemTs forwardedByMember currentTs currentTs
|
||||
in ChatItem {chatDir = toCIDirection cd, meta, content, mentions = M.empty, formattedText, quotedItem, reactions = [], file}
|
||||
|
||||
createAgentConnectionAsync :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> CM (CommandId, ConnId)
|
||||
createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do
|
||||
|
|
@ -1815,26 +1932,26 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do
|
|||
createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem]
|
||||
createACIs db itemTs createdAt cd = map $ \content -> do
|
||||
ciId <- createNewChatItemNoMsg db user cd content itemTs createdAt
|
||||
let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False itemTs Nothing createdAt
|
||||
let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing Nothing False False itemTs Nothing createdAt
|
||||
pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci
|
||||
|
||||
createLocalChatItems ::
|
||||
User ->
|
||||
ChatDirection 'CTLocal 'MDSnd ->
|
||||
[(CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom)] ->
|
||||
NonEmpty (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) ->
|
||||
UTCTime ->
|
||||
CM [ChatItem 'CTLocal 'MDSnd]
|
||||
createLocalChatItems user cd itemsData createdAt = do
|
||||
withStore' $ \db -> updateChatTs db user cd createdAt
|
||||
(errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) itemsData)
|
||||
(errs, items) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (createItem db) $ L.toList itemsData)
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
pure items
|
||||
where
|
||||
createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom) -> IO (ChatItem 'CTLocal 'MDSnd)
|
||||
createItem db (content, ciFile, itemForwarded) = do
|
||||
ciId <- createNewChatItem_ db user cd Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False createdAt Nothing createdAt
|
||||
createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) -> IO (ChatItem 'CTLocal 'MDSnd)
|
||||
createItem db (content, ciFile, itemForwarded, ts) = do
|
||||
ciId <- createNewChatItem_ db user cd Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False createdAt Nothing createdAt
|
||||
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
|
||||
pure $ mkChatItem cd ciId content ciFile Nothing Nothing itemForwarded Nothing False createdAt Nothing createdAt
|
||||
pure $ mkChatItem_ cd ciId content ts ciFile Nothing Nothing itemForwarded Nothing False False createdAt Nothing createdAt
|
||||
|
||||
withUser' :: (User -> CM ChatResponse) -> CM ChatResponse
|
||||
withUser' action =
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@ import Data.Int (Int64)
|
|||
import Data.List (foldl', partition)
|
||||
import Data.List.NonEmpty (NonEmpty (..), (<|))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
|
|
@ -500,7 +501,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
case event of
|
||||
XMsgNew mc -> newContentMessage ct'' mc msg msgMeta
|
||||
XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct'' sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgUpdate sharedMsgId mContent _ ttl live -> messageUpdate ct'' sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId _ -> messageDelete ct'' sharedMsgId msg msgMeta
|
||||
XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct'' sharedMsgId reaction add msg msgMeta
|
||||
-- TODO discontinue XFile
|
||||
|
|
@ -893,16 +894,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
in Just (fInv, fileDescrText)
|
||||
| otherwise = Nothing
|
||||
processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json]
|
||||
processContentItem sender ChatItem {meta, quotedItem} mc fInvDescr_ =
|
||||
processContentItem sender ChatItem {formattedText, meta, quotedItem, mentions} mc fInvDescr_ =
|
||||
if isNothing fInvDescr_ && not (msgContentHasText mc)
|
||||
then pure []
|
||||
else do
|
||||
let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
|
||||
quotedItemId_ = quoteItemId =<< quotedItem
|
||||
fInv_ = fst <$> fInvDescr_
|
||||
(msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ Nothing fInv_ itemTimed False
|
||||
(mc', _, mentions') = updatedMentionNames mc formattedText mentions
|
||||
mentions'' = M.map (\CIMention {memberId} -> MsgMention {memberId}) mentions'
|
||||
(chatMsgEvent, _) <- withStore $ \db -> prepareGroupMsg db user gInfo mc' mentions'' quotedItemId_ Nothing fInv_ itemTimed False
|
||||
let senderVRange = memberChatVRange' sender
|
||||
xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer}
|
||||
xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent}
|
||||
fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
|
||||
(Just fileDescrText, Just msgId) -> do
|
||||
partSize <- asks $ xftpDescrPartSize . config
|
||||
|
|
@ -966,7 +969,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
case event of
|
||||
XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False
|
||||
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg brokerTs ttl live
|
||||
XMsgUpdate sharedMsgId mContent mentions ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent mentions msg brokerTs ttl live
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg brokerTs
|
||||
XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg brokerTs
|
||||
-- TODO discontinue XFile
|
||||
|
|
@ -1539,7 +1542,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM ()
|
||||
newContentMessage ct@Contact {contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
|
||||
let ExtMsgContent content fInv_ _ _ = mcExtMsgContent mc
|
||||
let ExtMsgContent content _ fInv_ _ _ = mcExtMsgContent mc
|
||||
-- Uncomment to test stuck delivery on errors - see test testDirectMessageDelete
|
||||
-- case content of
|
||||
-- MCText "hello 111" ->
|
||||
|
|
@ -1548,18 +1551,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
-- _ -> pure ()
|
||||
if isVoice content && not (featureAllowed SCFVoice forContact ct)
|
||||
then do
|
||||
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
|
||||
void $ newChatItem (ciContentNoParse $ CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
|
||||
else do
|
||||
let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
|
||||
let ExtMsgContent _ _ _ itemTTL live_ = mcExtMsgContent mc
|
||||
timed_ = rcvContactCITimed ct itemTTL
|
||||
live = fromMaybe False live_
|
||||
file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct
|
||||
newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
|
||||
newChatItem (CIRcvMsgContent content, msgContentTexts content) (snd <$> file_) timed_ live
|
||||
autoAcceptFile file_
|
||||
where
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
newChatItem ciContent ciFile_ timed_ live = do
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live
|
||||
newChatItem content ciFile_ timed_ live = do
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content ciFile_ timed_ live M.empty
|
||||
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_
|
||||
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}]
|
||||
|
||||
|
|
@ -1625,7 +1628,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
let timed_ = rcvContactCITimed ct ttl
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs content Nothing timed_ live
|
||||
ts = ciContentTexts content
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live M.empty
|
||||
ci' <- withStore' $ \db -> do
|
||||
createChatItemVersion db (chatItemId' ci) brokerTs mc
|
||||
updateDirectChatItem' db user contactId ci content True live Nothing Nothing
|
||||
|
|
@ -1728,7 +1732,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> CM ()
|
||||
newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
|
||||
| blockedByAdmin m = createBlockedByAdmin
|
||||
| otherwise = case prohibitedGroupContent gInfo m content fInv_ of
|
||||
| otherwise = case prohibitedGroupContent gInfo m content ft_ fInv_ of
|
||||
Just f -> rejected f
|
||||
Nothing ->
|
||||
withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case
|
||||
|
|
@ -1737,13 +1741,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
|
||||
Nothing -> createContentItem
|
||||
where
|
||||
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
|
||||
rejected f = void $ newChatItem (ciContentNoParse $ CIRcvGroupFeatureRejected f) Nothing Nothing False
|
||||
timed' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo itemTTL
|
||||
live' = fromMaybe False live_
|
||||
ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
|
||||
ExtMsgContent content mentions fInv_ itemTTL live_ = mcExtMsgContent mc
|
||||
ts@(_, ft_) = msgContentTexts content
|
||||
createBlockedByAdmin
|
||||
| groupFeatureAllowed SGFFullDelete gInfo = do -- ignores member role when blocked by admin
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvBlocked Nothing timed' False
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvBlocked) Nothing timed' False M.empty
|
||||
ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs
|
||||
groupMsgToView gInfo ci'
|
||||
| otherwise = do
|
||||
|
|
@ -1755,7 +1760,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
| moderatorRole < GRModerator || moderatorRole < memberRole =
|
||||
createContentItem
|
||||
| groupFeatureMemberAllowed SGFFullDelete moderator gInfo = do
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed' False
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvModerated) Nothing timed' False M.empty
|
||||
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
|
||||
groupMsgToView gInfo ci'
|
||||
| otherwise = do
|
||||
|
|
@ -1763,22 +1768,23 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
ci <- createNonLive file_
|
||||
toView =<< markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] False (Just moderator) moderatedAt
|
||||
createNonLive file_ =
|
||||
saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed' False
|
||||
saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content, ts) (snd <$> file_) timed' False mentions
|
||||
createContentItem = do
|
||||
file_ <- processFileInv
|
||||
newChatItem (CIRcvMsgContent content) (snd <$> file_) timed' live'
|
||||
newChatItem (CIRcvMsgContent content, ts) (snd <$> file_) timed' live'
|
||||
when (showMessages $ memberSettings m) $ autoAcceptFile file_
|
||||
processFileInv =
|
||||
processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
|
||||
newChatItem ciContent ciFile_ timed_ live = do
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live
|
||||
let mentions' = if showMessages (memberSettings m) then mentions else []
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live mentions'
|
||||
ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
|
||||
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
|
||||
groupMsgToView gInfo ci' {reactions}
|
||||
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> UTCTime -> Maybe Int -> Maybe Bool -> CM ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} brokerTs ttl_ live_
|
||||
| prohibitedSimplexLinks gInfo m mc =
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> Map MemberName MsgMention -> RcvMessage -> UTCTime -> Maybe Int -> Maybe Bool -> CM ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc mentions msg@RcvMessage {msgId} brokerTs ttl_ live_
|
||||
| prohibitedSimplexLinks gInfo m ft_ =
|
||||
messageWarning $ "x.msg.update ignored: feature not allowed " <> groupFeatureNameText GFSimplexLinks
|
||||
| otherwise = do
|
||||
updateRcvChatItem `catchCINotFound` \_ -> do
|
||||
|
|
@ -1786,7 +1792,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
let timed_ = rcvGroupCITimed gInfo ttl_
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs content Nothing timed_ live
|
||||
mentions' = if showMessages (memberSettings m) then mentions else []
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live mentions'
|
||||
ci' <- withStore' $ \db -> do
|
||||
createChatItemVersion db (chatItemId' ci) brokerTs mc
|
||||
ci' <- updateGroupChatItem db user groupId ci content True live Nothing
|
||||
|
|
@ -1794,6 +1801,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||
where
|
||||
content = CIRcvMsgContent mc
|
||||
ts@(_, ft_) = msgContentTexts mc
|
||||
live = fromMaybe False live_
|
||||
updateRcvChatItem = do
|
||||
cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
|
|
@ -1809,7 +1817,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc)
|
||||
reactions <- getGroupCIReactions db gInfo memberId sharedMsgId
|
||||
let edited = itemLive /= Just True
|
||||
updateGroupChatItem db user groupId ci {reactions} content edited live $ Just msgId
|
||||
ciMentions <- getRcvCIMentions db user gInfo ft_ mentions
|
||||
ci' <- updateGroupChatItem db user groupId ci {reactions} content edited live $ Just msgId
|
||||
updateGroupCIMentions db gInfo ci' ciMentions
|
||||
toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
|
||||
startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
|
||||
else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
|
||||
|
|
@ -1870,7 +1880,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize
|
||||
let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
|
||||
ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
content = ciContentNoParse $ CIRcvMsgContent $ MCFile ""
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty
|
||||
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci]
|
||||
where
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
|
|
@ -1883,7 +1894,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize
|
||||
let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
|
||||
ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
content = ciContentNoParse $ CIRcvMsgContent $ MCFile ""
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty
|
||||
ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
|
||||
groupMsgToView gInfo ci'
|
||||
|
||||
|
|
@ -2063,7 +2075,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct)
|
||||
else do
|
||||
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
|
||||
ci <- saveRcvChatItem user (CDDirectRcv ct) msg brokerTs content
|
||||
ci <- saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs content
|
||||
withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
|
||||
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci]
|
||||
toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole}
|
||||
|
|
@ -2091,7 +2103,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
|
||||
activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted}
|
||||
let ct'' = ct' {activeConn = activeConn'} :: Contact
|
||||
ci <- saveRcvChatItem user (CDDirectRcv ct'') msg brokerTs (CIRcvDirectEvent RDEContactDeleted)
|
||||
ci <- saveRcvChatItemNoParse user (CDDirectRcv ct'') msg brokerTs (CIRcvDirectEvent RDEContactDeleted)
|
||||
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct'') ci]
|
||||
toView $ CRContactDeletedByContact user ct''
|
||||
else do
|
||||
|
|
@ -2300,9 +2312,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
else featureRejected CFCalls
|
||||
where
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0)
|
||||
saveCallItem status = saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0)
|
||||
featureRejected f = do
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs (CIRcvChatFeatureRejected f) Nothing Nothing False
|
||||
let content = ciContentNoParse $ CIRcvChatFeatureRejected f
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty
|
||||
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci]
|
||||
|
||||
-- to party initiating call
|
||||
|
|
@ -2480,7 +2493,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
where
|
||||
memberAnnouncedToView announcedMember@GroupMember {groupMemberId, memberProfile} = do
|
||||
let event = RGEMemberAdded groupMemberId (fromLocalProfile memberProfile)
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent event)
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent event)
|
||||
groupMsgToView gInfo ci
|
||||
toView $ CRJoinedGroupMemberConnecting user gInfo m announcedMember
|
||||
|
||||
|
|
@ -2567,7 +2580,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
| senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions"
|
||||
| otherwise = do
|
||||
withStore' $ \db -> updateGroupMemberRole db user member memRole
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
|
||||
groupMsgToView gInfo ci
|
||||
toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
|
||||
|
||||
|
|
@ -2594,7 +2607,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
bm' <- setMemberBlocked bmId
|
||||
toggleNtf user bm' (not blocked)
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs ciContent
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs ciContent
|
||||
groupMsgToView gInfo ci
|
||||
toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked}
|
||||
Left (SEGroupMemberNotFoundByMemberId _) -> do
|
||||
|
|
@ -2679,7 +2692,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
messageError "x.grp.mem.del with insufficient member permissions"
|
||||
| otherwise = a
|
||||
deleteMemberItem gEvent = do
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
|
||||
groupMsgToView gInfo ci
|
||||
|
||||
xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM ()
|
||||
|
|
@ -2687,7 +2700,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
deleteMemberConnection user m
|
||||
-- member record is not deleted to allow creation of "member left" chat item
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEMemberLeft)
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEMemberLeft)
|
||||
groupMsgToView gInfo ci
|
||||
toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft}
|
||||
|
||||
|
|
@ -2700,7 +2713,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
pure members
|
||||
-- member records are not deleted to keep history
|
||||
deleteMembersConnections user ms
|
||||
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEGroupDeleted)
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent RGEGroupDeleted)
|
||||
groupMsgToView gInfo ci
|
||||
toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m
|
||||
|
||||
|
|
@ -2713,7 +2726,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
toView $ CRGroupUpdated user g g' (Just m)
|
||||
let cd = CDGroupRcv g' m
|
||||
unless (sameGroupProfileInfo p p') $ do
|
||||
ci <- saveRcvChatItem user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p')
|
||||
ci <- saveRcvChatItemNoParse user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p')
|
||||
groupMsgToView g' ci
|
||||
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
|
||||
Just _ -> updateGroupPrefs_ g m $ fromMaybe defaultBusinessGroupPrefs $ groupPreferences p'
|
||||
|
|
@ -2772,7 +2785,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing
|
||||
toView $ CRNewMemberContactReceivedInv user mCt' g m'
|
||||
forM_ mContent_ $ \mc -> do
|
||||
ci <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc)
|
||||
ci <- saveRcvChatItem user (CDDirectRcv mCt') msg brokerTs (CIRcvMsgContent mc, msgContentTexts mc)
|
||||
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat mCt') ci]
|
||||
|
||||
securityCodeChanged :: Contact -> CM ()
|
||||
|
|
@ -2799,7 +2812,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
case event of
|
||||
XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True
|
||||
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent rcvMsg msgTs ttl live
|
||||
XMsgUpdate sharedMsgId mContent mentions ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent mentions rcvMsg msgTs ttl live
|
||||
XMsgDel sharedMsgId memId -> groupMessageDelete gInfo author sharedMsgId memId rcvMsg msgTs
|
||||
XMsgReact sharedMsgId (Just memId) reaction add -> groupMsgReaction gInfo author sharedMsgId memId reaction add rcvMsg msgTs
|
||||
XFileCancel sharedMsgId -> xFileCancelGroup gInfo author sharedMsgId
|
||||
|
|
|
|||
|
|
@ -16,13 +16,13 @@ import qualified Data.Aeson as J
|
|||
import qualified Data.Aeson.TH as JQ
|
||||
import Data.Attoparsec.Text (Parser)
|
||||
import qualified Data.Attoparsec.Text as A
|
||||
import Data.Char (isDigit, isPunctuation)
|
||||
import Data.Char (isDigit, isPunctuation, isSpace)
|
||||
import Data.Either (fromRight)
|
||||
import Data.Functor (($>))
|
||||
import Data.List (foldl', intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
import Data.Maybe (fromMaybe, isNothing, mapMaybe)
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
|
|
@ -50,18 +50,28 @@ data Format
|
|||
| Colored {color :: FormatColor}
|
||||
| Uri
|
||||
| SimplexLink {linkType :: SimplexLinkType, simplexUri :: Text, smpHosts :: NonEmpty Text}
|
||||
| Mention {memberName :: Text}
|
||||
| Email
|
||||
| Phone
|
||||
deriving (Eq, Show)
|
||||
|
||||
mentionedNames :: MarkdownList -> [Text]
|
||||
mentionedNames = mapMaybe (\(FormattedText f _) -> mentionedName =<< f)
|
||||
where
|
||||
mentionedName = \case
|
||||
Mention name -> Just name
|
||||
_ -> Nothing
|
||||
|
||||
data SimplexLinkType = XLContact | XLInvitation | XLGroup
|
||||
deriving (Eq, Show)
|
||||
|
||||
colored :: Color -> Format
|
||||
colored = Colored . FormatColor
|
||||
{-# INLINE colored #-}
|
||||
|
||||
markdown :: Format -> Text -> Markdown
|
||||
markdown = Markdown . Just
|
||||
{-# INLINE markdown #-}
|
||||
|
||||
instance Semigroup Markdown where
|
||||
m <> (Markdown _ "") = m
|
||||
|
|
@ -163,6 +173,7 @@ markdownP = mconcat <$> A.many' fragmentP
|
|||
'`' -> formattedP '`' Snippet
|
||||
'#' -> A.char '#' *> secretP
|
||||
'!' -> coloredP <|> wordP
|
||||
'@' -> mentionP
|
||||
_
|
||||
| isDigit c -> phoneP <|> wordP
|
||||
| otherwise -> wordP
|
||||
|
|
@ -192,6 +203,11 @@ markdownP = mconcat <$> A.many' fragmentP
|
|||
if T.null s || T.last s == ' '
|
||||
then fail "not colored"
|
||||
else pure $ markdown (colored clr) s
|
||||
mentionP = do
|
||||
c <- A.char '@' *> A.peekChar'
|
||||
name <- displayNameTextP
|
||||
let sName = if c == '\'' then '\'' `T.cons` name `T.snoc` '\'' else name
|
||||
pure $ markdown (Mention name) ('@' `T.cons` sName)
|
||||
colorP =
|
||||
A.anyChar >>= \case
|
||||
'r' -> "ed" $> Red <|> pure Red
|
||||
|
|
@ -251,6 +267,48 @@ markdownP = mconcat <$> A.many' fragmentP
|
|||
Just (CRDataGroup _) -> XLGroup
|
||||
Nothing -> XLContact
|
||||
|
||||
markdownText :: FormattedText -> Text
|
||||
markdownText (FormattedText f_ t) = case f_ of
|
||||
Nothing -> t
|
||||
Just f -> case f of
|
||||
Bold -> around '*'
|
||||
Italic -> around '_'
|
||||
StrikeThrough -> around '~'
|
||||
Snippet -> around '`'
|
||||
Secret -> around '#'
|
||||
Colored (FormatColor c) -> color c
|
||||
Uri -> t
|
||||
SimplexLink {} -> t
|
||||
Mention _ -> t
|
||||
Email -> t
|
||||
Phone -> t
|
||||
where
|
||||
around c = c `T.cons` t `T.snoc` c
|
||||
color c = case colorStr c of
|
||||
Just cStr -> cStr <> t `T.snoc` '!'
|
||||
Nothing -> t
|
||||
colorStr = \case
|
||||
Red -> Just "!1 "
|
||||
Green -> Just "!2 "
|
||||
Blue -> Just "!3 "
|
||||
Yellow -> Just "!4 "
|
||||
Cyan -> Just "!5 "
|
||||
Magenta -> Just "!6 "
|
||||
Black -> Nothing
|
||||
White -> Nothing
|
||||
|
||||
displayNameTextP :: Parser Text
|
||||
displayNameTextP = quoted '\'' <|> takeNameTill (== ' ')
|
||||
where
|
||||
takeNameTill p =
|
||||
A.peekChar' >>= \c ->
|
||||
if refChar c then A.takeTill p else fail "invalid first character in display name"
|
||||
quoted c = A.char c *> takeNameTill (== c) <* A.char c
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
|
||||
|
||||
viewName :: Text -> Text
|
||||
viewName s = if T.any isSpace s then "'" <> s <> "'" else s
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "XL") ''SimplexLinkType)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON fstToLower) ''Format)
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@ import Data.Char (isSpace)
|
|||
import Data.Int (Int64)
|
||||
import Data.Kind (Constraint)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -46,6 +47,7 @@ import Simplex.Chat.Options.DB (FromField (..), ToField (..))
|
|||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.Util (textParseJSON)
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..))
|
||||
|
|
@ -150,6 +152,9 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
|
|||
{ chatDir :: CIDirection c d,
|
||||
meta :: CIMeta c d,
|
||||
content :: CIContent d,
|
||||
-- The `mentions` map prevents loading all members from UI.
|
||||
-- The key is a name used in the message text, used to look up CIMention.
|
||||
mentions :: Map MemberName CIMention,
|
||||
formattedText :: Maybe MarkdownList,
|
||||
quotedItem :: Maybe (CIQuote c),
|
||||
reactions :: [CIReactionCount],
|
||||
|
|
@ -157,18 +162,23 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
|
|||
}
|
||||
deriving (Show)
|
||||
|
||||
isMention :: ChatItem c d -> Bool
|
||||
isMention ChatItem {chatDir, quotedItem} = case chatDir of
|
||||
CIDirectRcv -> userItem quotedItem
|
||||
CIGroupRcv _ -> userItem quotedItem
|
||||
_ -> False
|
||||
where
|
||||
userItem = \case
|
||||
Nothing -> False
|
||||
Just CIQuote {chatDir = cd} -> case cd of
|
||||
CIQDirectSnd -> True
|
||||
CIQGroupSnd -> True
|
||||
_ -> False
|
||||
data CIMention = CIMention
|
||||
{ memberId :: MemberId,
|
||||
-- member record can be created later than the mention is received
|
||||
memberRef :: Maybe CIMentionMember
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data CIMentionMember = CIMentionMember
|
||||
{ groupMemberId :: GroupMemberId,
|
||||
displayName :: Text, -- use `displayName` in copy/share actions
|
||||
localAlias :: Maybe Text, -- use `fromMaybe displayName localAlias` in chat view
|
||||
memberRole :: GroupMemberRole -- shown for admins/owners in the message
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
isUserMention :: ChatItem c d -> Bool
|
||||
isUserMention ChatItem {meta = CIMeta {userMention}} = userMention
|
||||
|
||||
data CIDirection (c :: ChatType) (d :: MsgDirection) where
|
||||
CIDirectSnd :: CIDirection 'CTDirect 'MDSnd
|
||||
|
|
@ -310,6 +320,7 @@ deriving instance Show AChat
|
|||
|
||||
data ChatStats = ChatStats
|
||||
{ unreadCount :: Int, -- returned both in /_get chat initial API and in /_get chats API
|
||||
unreadMentions :: Int, -- returned both in /_get chat initial API and in /_get chats API
|
||||
reportsCount :: Int, -- returned both in /_get chat initial API and in /_get chats API
|
||||
minUnreadItemId :: ChatItemId,
|
||||
unreadChat :: Bool
|
||||
|
|
@ -317,7 +328,7 @@ data ChatStats = ChatStats
|
|||
deriving (Show)
|
||||
|
||||
emptyChatStats :: ChatStats
|
||||
emptyChatStats = ChatStats 0 0 0 False
|
||||
emptyChatStats = ChatStats 0 0 0 0 False
|
||||
|
||||
data NavigationInfo = NavigationInfo
|
||||
{ afterUnread :: Int,
|
||||
|
|
@ -364,6 +375,7 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
|||
itemEdited :: Bool,
|
||||
itemTimed :: Maybe CITimed,
|
||||
itemLive :: Maybe Bool,
|
||||
userMention :: Bool, -- True for messages that mention user or reply to user messages
|
||||
deletable :: Bool,
|
||||
editable :: Bool,
|
||||
forwardedByMember :: Maybe GroupMemberId,
|
||||
|
|
@ -372,11 +384,11 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
|||
}
|
||||
deriving (Show)
|
||||
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe Bool -> 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 sentViaProxy itemSharedMsgId itemForwarded itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt =
|
||||
mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe Bool -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
||||
mkCIMeta itemId itemContent itemText itemStatus sentViaProxy itemSharedMsgId itemForwarded itemDeleted itemEdited itemTimed itemLive userMention currentTs itemTs forwardedByMember createdAt updatedAt =
|
||||
let deletable = deletable' itemContent itemDeleted itemTs nominalDay currentTs
|
||||
editable = deletable && isNothing itemForwarded
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, sentViaProxy, itemSharedMsgId, itemForwarded, itemDeleted, itemEdited, itemTimed, itemLive, deletable, editable, forwardedByMember, createdAt, updatedAt}
|
||||
in CIMeta {itemId, itemTs, itemText, itemStatus, sentViaProxy, itemSharedMsgId, itemForwarded, itemDeleted, itemEdited, itemTimed, itemLive, userMention, deletable, editable, forwardedByMember, createdAt, updatedAt}
|
||||
|
||||
deletable' :: forall c d. ChatTypeI c => CIContent d -> Maybe (CIDeleted c) -> UTCTime -> NominalDiffTime -> UTCTime -> Bool
|
||||
deletable' itemContent itemDeleted itemTs allowedInterval currentTs =
|
||||
|
|
@ -401,6 +413,7 @@ dummyMeta itemId ts itemText =
|
|||
itemEdited = False,
|
||||
itemTimed = Nothing,
|
||||
itemLive = Nothing,
|
||||
userMention = False,
|
||||
deletable = False,
|
||||
editable = False,
|
||||
forwardedByMember = Nothing,
|
||||
|
|
@ -1247,14 +1260,14 @@ data ChatItemVersion = ChatItemVersion
|
|||
deriving (Eq, Show)
|
||||
|
||||
mkItemVersion :: ChatItem c d -> Maybe ChatItemVersion
|
||||
mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
|
||||
mkItemVersion ChatItem {content, formattedText, meta} = version <$> ciMsgContent content
|
||||
where
|
||||
CIMeta {itemId, itemTs, createdAt} = meta
|
||||
version mc =
|
||||
ChatItemVersion
|
||||
{ chatItemVersionId = itemId,
|
||||
msgContent = mc,
|
||||
formattedText = parseMaybeMarkdownList $ msgContentText mc,
|
||||
formattedText,
|
||||
itemVersionTs = itemTs,
|
||||
createdAt = createdAt
|
||||
}
|
||||
|
|
@ -1387,6 +1400,10 @@ $(JQ.deriveToJSON defaultJSON ''CIQuote)
|
|||
|
||||
$(JQ.deriveJSON defaultJSON ''CIReactionCount)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''CIMentionMember)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''CIMention)
|
||||
|
||||
instance (ChatTypeI c, MsgDirectionI d) => FromJSON (ChatItem c d) where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''ChatItem)
|
||||
|
||||
|
|
|
|||
|
|
@ -35,6 +35,8 @@ import Data.ByteString.Internal (c2w, w2c)
|
|||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
|
|
@ -310,7 +312,7 @@ data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMess
|
|||
data ChatMsgEvent (e :: MsgEncoding) where
|
||||
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
|
||||
XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
|
||||
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
|
||||
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, mentions :: Map MemberName MsgMention, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
|
||||
XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json
|
||||
XMsgDeleted :: ChatMsgEvent 'Json
|
||||
XMsgReact :: {msgId :: SharedMsgId, memberId :: Maybe MemberId, reaction :: MsgReaction, add :: Bool} -> ChatMsgEvent 'Json
|
||||
|
|
@ -531,13 +533,18 @@ mcExtMsgContent = \case
|
|||
MCComment _ c -> c
|
||||
MCForward c -> c
|
||||
|
||||
isMCForward :: MsgContainer -> Bool
|
||||
isMCForward = \case
|
||||
MCForward _ -> True
|
||||
_ -> False
|
||||
|
||||
data MsgContent
|
||||
= MCText Text
|
||||
= MCText {text :: Text}
|
||||
| MCLink {text :: Text, preview :: LinkPreview}
|
||||
| MCImage {text :: Text, image :: ImageData}
|
||||
| MCVideo {text :: Text, image :: ImageData, duration :: Int}
|
||||
| MCVoice {text :: Text, duration :: Int}
|
||||
| MCFile Text
|
||||
| MCFile {text :: Text}
|
||||
| MCReport {text :: Text, reason :: ReportReason}
|
||||
| MCUnknown {tag :: Text, text :: Text, json :: J.Object}
|
||||
deriving (Eq, Show)
|
||||
|
|
@ -589,9 +596,23 @@ msgContentTag = \case
|
|||
MCReport {} -> MCReport_
|
||||
MCUnknown {tag} -> MCUnknown_ tag
|
||||
|
||||
data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
|
||||
data ExtMsgContent = ExtMsgContent
|
||||
{ content :: MsgContent,
|
||||
-- the key used in mentions is a locally (per message) unique display name of member.
|
||||
-- Suffixes _1, _2 should be appended to make names locally unique.
|
||||
-- It should be done in the UI, as they will be part of the text, and validated in the API.
|
||||
mentions :: Map MemberName MsgMention,
|
||||
file :: Maybe FileInvitation,
|
||||
ttl :: Maybe Int,
|
||||
live :: Maybe Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data MsgMention = MsgMention {memberId :: MemberId}
|
||||
deriving (Eq, Show)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MsgMention)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''QuotedMsg)
|
||||
|
||||
-- this limit reserves space for metadata in forwarded messages
|
||||
|
|
@ -657,10 +678,16 @@ parseMsgContainer v =
|
|||
<|> (MCForward <$> ((v .: "forward" :: JT.Parser J.Object) *> mc))
|
||||
<|> MCSimple <$> mc
|
||||
where
|
||||
mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
|
||||
mc = do
|
||||
content <- v .: "content"
|
||||
file <- v .:? "file"
|
||||
ttl <- v .:? "ttl"
|
||||
live <- v .:? "live"
|
||||
mentions <- fromMaybe M.empty <$> (v .:? "mentions")
|
||||
pure ExtMsgContent {content, mentions, file, ttl, live}
|
||||
|
||||
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
|
||||
extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
|
||||
extMsgContent mc file = ExtMsgContent mc M.empty file Nothing Nothing
|
||||
|
||||
justTrue :: Bool -> Maybe Bool
|
||||
justTrue True = Just True
|
||||
|
|
@ -709,7 +736,12 @@ msgContainerJSON = \case
|
|||
MCSimple mc -> o $ msgContent mc
|
||||
where
|
||||
o = JM.fromList
|
||||
msgContent (ExtMsgContent c file ttl live) = ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) ["content" .= c]
|
||||
msgContent ExtMsgContent {content, mentions, file, ttl, live} =
|
||||
("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("mentions" .=? nonEmptyMap mentions) ["content" .= content]
|
||||
|
||||
nonEmptyMap :: Map k v -> Maybe (Map k v)
|
||||
nonEmptyMap m = if M.null m then Nothing else Just m
|
||||
{-# INLINE nonEmptyMap #-}
|
||||
|
||||
instance ToJSON MsgContent where
|
||||
toJSON = \case
|
||||
|
|
@ -994,7 +1026,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
|
|||
msg = \case
|
||||
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
|
||||
XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr"
|
||||
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live"
|
||||
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> (fromMaybe M.empty <$> opt "mentions") <*> opt "ttl" <*> opt "live"
|
||||
XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId"
|
||||
XMsgDeleted_ -> pure XMsgDeleted
|
||||
XMsgReact_ -> XMsgReact <$> p "msgId" <*> opt "memberId" <*> p "reaction" <*> p "add"
|
||||
|
|
@ -1056,7 +1088,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
|
|||
params = \case
|
||||
XMsgNew container -> msgContainerJSON container
|
||||
XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr]
|
||||
XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
|
||||
XMsgUpdate msgId' content mentions ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("mentions" .=? nonEmptyMap mentions) ["msgId" .= msgId', "content" .= content]
|
||||
XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId']
|
||||
XMsgDeleted -> JM.empty
|
||||
XMsgReact msgId' memberId reaction add -> o $ ("memberId" .=? memberId) ["msgId" .= msgId', "reaction" .= reaction, "add" .= add]
|
||||
|
|
|
|||
|
|
@ -47,6 +47,8 @@ module Simplex.Chat.Store.Groups
|
|||
getActiveMembersByName,
|
||||
getGroupInfoByName,
|
||||
getGroupMember,
|
||||
getMentionedGroupMember,
|
||||
getMentionedMemberByMemberId,
|
||||
getGroupMemberById,
|
||||
getGroupMemberByMemberId,
|
||||
getGroupMembers,
|
||||
|
|
@ -148,7 +150,7 @@ import Data.Ord (Down (..))
|
|||
import Data.Text (Text)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Protocol (groupForwardVersion)
|
||||
import Simplex.Chat.Protocol (MsgMention (..), groupForwardVersion)
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
|
|
@ -798,6 +800,37 @@ getGroupMember db vr user@User {userId} groupId groupMemberId =
|
|||
(groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
|
||||
(userId, groupId, groupMemberId, userId)
|
||||
|
||||
getMentionedGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO CIMention
|
||||
getMentionedGroupMember db User {userId} groupId gmId =
|
||||
ExceptT $ firstRow toMentionedMember (SEGroupMemberNotFound gmId) $
|
||||
DB.query
|
||||
db
|
||||
(mentionedMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
|
||||
(groupId, gmId, userId)
|
||||
|
||||
getMentionedMemberByMemberId :: DB.Connection -> User -> GroupId -> MsgMention -> IO CIMention
|
||||
getMentionedMemberByMemberId db User {userId} groupId MsgMention {memberId} =
|
||||
fmap (fromMaybe mentionedMember) $ maybeFirstRow toMentionedMember $
|
||||
DB.query
|
||||
db
|
||||
(mentionedMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ? AND m.user_id = ?")
|
||||
(groupId, memberId, userId)
|
||||
where
|
||||
mentionedMember = CIMention {memberId, memberRef = Nothing}
|
||||
|
||||
mentionedMemberQuery :: Query
|
||||
mentionedMemberQuery =
|
||||
[sql|
|
||||
SELECT m.group_member_id, m.member_id, m.member_role, p.display_name, p.local_alias
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
|]
|
||||
|
||||
toMentionedMember :: (GroupMemberId, MemberId, GroupMemberRole, Text, Maybe Text) -> CIMention
|
||||
toMentionedMember (groupMemberId, memberId, memberRole, displayName, localAlias) =
|
||||
let memberRef = Just CIMentionMember {groupMemberId, displayName, localAlias, memberRole}
|
||||
in CIMention {memberId, memberRef}
|
||||
|
||||
getGroupMemberById :: DB.Connection -> VersionRangeChat -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
|
||||
getGroupMemberById db vr user@User {userId} groupMemberId =
|
||||
ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
|
||||
|
|
|
|||
|
|
@ -53,6 +53,8 @@ module Simplex.Chat.Store.Messages
|
|||
markDirectChatItemDeleted,
|
||||
updateGroupChatItemStatus,
|
||||
updateGroupChatItem,
|
||||
createGroupCIMentions,
|
||||
updateGroupCIMentions,
|
||||
deleteGroupChatItem,
|
||||
updateGroupChatItemModerated,
|
||||
updateGroupCIBlockedByAdmin,
|
||||
|
|
@ -136,6 +138,8 @@ import Data.Int (Int64)
|
|||
import Data.List (sortBy)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
|
||||
import Data.Ord (Down (..), comparing)
|
||||
import Data.Text (Text)
|
||||
|
|
@ -152,6 +156,7 @@ import Simplex.Chat.Store.Groups
|
|||
import Simplex.Chat.Store.NoteFolders
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserId)
|
||||
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', maybeFirstRow)
|
||||
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
|
||||
|
|
@ -367,7 +372,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
|
|||
|
||||
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
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live False createdAt Nothing createdAt
|
||||
where
|
||||
createdByMsgId = if msgId == 0 then Nothing else Just msgId
|
||||
quoteRow :: NewQuoteRow
|
||||
|
|
@ -381,9 +386,9 @@ 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), 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 itemForwarded timed live itemTs forwardedByMember createdAt
|
||||
createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live userMention itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt
|
||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||
pure (ciId, quotedItem, itemForwarded)
|
||||
where
|
||||
|
|
@ -400,13 +405,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 Nothing False itemTs Nothing
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing Nothing False 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 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
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
|
|
@ -415,20 +420,20 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
|||
user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id,
|
||||
-- meta
|
||||
item_sent, item_ts, item_content, item_content_tag, item_text, item_status, msg_content_tag, shared_msg_id,
|
||||
forwarded_by_group_member_id, include_in_history, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
forwarded_by_group_member_id, include_in_history, created_at, updated_at, item_live, user_mention, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow' :. forwardedFromRow)
|
||||
ciId <- insertedRowId db
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
|
||||
pure ciId
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId, BoolInt) :. (UTCTime, UTCTime, Maybe BoolInt) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, msgContentTag <$> ciMsgContent ciContent, sharedMsgId, forwardedByMember, BI includeInHistory) :. (createdAt, createdAt, BI <$> (justTrue live)) :. ciTimedRow timed
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe MsgContentTag, Maybe SharedMsgId, Maybe GroupMemberId, BoolInt) :. (UTCTime, UTCTime, Maybe BoolInt, BoolInt) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, msgContentTag <$> ciMsgContent ciContent, sharedMsgId, forwardedByMember, BI includeInHistory) :. (createdAt, createdAt, BI <$> (justTrue live), BI userMention) :. ciTimedRow timed
|
||||
quoteRow' = let (a, b, c, d, e) = quoteRow in (a, b, c, BI <$> d, e)
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow = case chatDirection of
|
||||
|
|
@ -565,7 +570,12 @@ data AChatPreviewData = forall c. ChatTypeI c => ACPD (SChatType c) (ChatPreview
|
|||
type ChatStatsRow = (Int, Int, ChatItemId, BoolInt)
|
||||
|
||||
toChatStats :: ChatStatsRow -> ChatStats
|
||||
toChatStats (unreadCount, reportsCount, minUnreadItemId, BI unreadChat) = ChatStats {unreadCount, reportsCount, minUnreadItemId, unreadChat}
|
||||
toChatStats (unreadCount, reportsCount, minUnreadItemId, BI unreadChat) = ChatStats {unreadCount, unreadMentions = 0, reportsCount, minUnreadItemId, unreadChat}
|
||||
|
||||
type GroupStatsRow = (Int, Int, Int, ChatItemId, BoolInt)
|
||||
|
||||
toGroupStats :: GroupStatsRow -> ChatStats
|
||||
toGroupStats (unreadCount, unreadMentions, reportsCount, minUnreadItemId, BI unreadChat) = ChatStats {unreadCount, unreadMentions, reportsCount, minUnreadItemId, unreadChat}
|
||||
|
||||
findDirectChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
|
||||
findDirectChatPreviews_ db User {userId} pagination clq =
|
||||
|
|
@ -669,9 +679,9 @@ findGroupChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQ
|
|||
findGroupChatPreviews_ db User {userId} pagination clq =
|
||||
map toPreview <$> getPreviews
|
||||
where
|
||||
toPreview :: (GroupId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData
|
||||
toPreview :: (GroupId, UTCTime, Maybe ChatItemId) :. GroupStatsRow -> AChatPreviewData
|
||||
toPreview ((groupId, ts, lastItemId_) :. statsRow) =
|
||||
ACPD SCTGroup $ GroupChatPD ts groupId lastItemId_ (toChatStats statsRow)
|
||||
ACPD SCTGroup $ GroupChatPD ts groupId lastItemId_ (toGroupStats statsRow)
|
||||
baseQuery =
|
||||
[sql|
|
||||
SELECT
|
||||
|
|
@ -685,12 +695,13 @@ findGroupChatPreviews_ db User {userId} pagination clq =
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -756,7 +767,7 @@ findGroupChatPreviews_ db User {userId} pagination clq =
|
|||
|]
|
||||
p = baseParams :. (userId, search, search, search, search)
|
||||
queryWithPagination q p
|
||||
queryWithPagination :: ToRow p => Query -> p -> IO [(GroupId, UTCTime, Maybe ChatItemId) :. ChatStatsRow]
|
||||
queryWithPagination :: ToRow p => Query -> p -> IO [(GroupId, UTCTime, Maybe ChatItemId) :. GroupStatsRow]
|
||||
queryWithPagination query params = case pagination of
|
||||
PTLast count -> DB.query db (query <> " ORDER BY g.chat_ts DESC LIMIT ?") (params :. Only count)
|
||||
PTAfter ts count -> DB.query db (query <> " AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?") (params :. (ts, count))
|
||||
|
|
@ -766,7 +777,7 @@ getGroupChatPreview_ :: DB.Connection -> VersionRangeChat -> User -> ChatPreview
|
|||
getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
|
||||
groupInfo <- getGroupInfo db vr user groupId
|
||||
lastItem <- case lastItemId_ of
|
||||
Just lastItemId -> (: []) <$> getGroupChatItem db user groupId lastItemId
|
||||
Just lastItemId -> (: []) <$> getGroupCIWithReactions db user groupInfo lastItemId
|
||||
Nothing -> pure []
|
||||
pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats)
|
||||
|
||||
|
|
@ -855,7 +866,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, sentViaProxy, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sentViaProxy, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive, BI userMention) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
|
|
@ -879,7 +890,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
|
|||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTLocal d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTLocal
|
||||
cItem d chatDir ciStatus content file =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = Nothing, reactions = [], file}
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, mentions = M.empty, formattedText = parseMaybeMarkdownList itemText, quotedItem = Nothing, reactions = [], file}
|
||||
badItem = Left $ SEBadChatItem itemId (Just itemTs)
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTLocal d
|
||||
ciMeta content status =
|
||||
|
|
@ -888,7 +899,7 @@ toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentTex
|
|||
_ -> Just (CIDeleted @'CTLocal deletedTs)
|
||||
itemEdited' = maybe False unBI itemEdited
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) currentTs itemTs Nothing createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
|
|
@ -1021,6 +1032,7 @@ safeToDirectItem currentTs itemId = \case
|
|||
{ chatDir = CIDirectSnd,
|
||||
meta = dummyMeta itemId ts errorText,
|
||||
content = CIInvalidJSON errorText,
|
||||
mentions = M.empty,
|
||||
formattedText = Nothing,
|
||||
quotedItem = Nothing,
|
||||
reactions = [],
|
||||
|
|
@ -1276,6 +1288,7 @@ safeToGroupItem currentTs itemId = \case
|
|||
{ chatDir = CIGroupSnd,
|
||||
meta = dummyMeta itemId ts errorText,
|
||||
content = CIInvalidJSON errorText,
|
||||
mentions = M.empty,
|
||||
formattedText = Nothing,
|
||||
quotedItem = Nothing,
|
||||
reactions = [],
|
||||
|
|
@ -1346,19 +1359,19 @@ getGroupChatInitial_ db user g contentFilter count = do
|
|||
stats <- liftIO $ getStats minUnreadItemId =<< getGroupUnreadCount_ db user g Nothing
|
||||
getGroupChatAround' db user g contentFilter minUnreadItemId count "" stats
|
||||
Nothing -> liftIO $ do
|
||||
stats <- getStats 0 0
|
||||
stats <- getStats 0 (0, 0)
|
||||
(,Just $ NavigationInfo 0 0) <$> getGroupChatLast_ db user g contentFilter count "" stats
|
||||
where
|
||||
getStats minUnreadItemId unreadCount = do
|
||||
getStats minUnreadItemId (unreadCount, unreadMentions) = do
|
||||
reportsCount <- getGroupReportsCount_ db user g False
|
||||
pure ChatStats {unreadCount, reportsCount, minUnreadItemId, unreadChat = False}
|
||||
pure ChatStats {unreadCount, unreadMentions, reportsCount, minUnreadItemId, unreadChat = False}
|
||||
|
||||
getGroupStats_ :: DB.Connection -> User -> GroupInfo -> IO ChatStats
|
||||
getGroupStats_ db user g = do
|
||||
minUnreadItemId <- fromMaybe 0 <$> getGroupMinUnreadId_ db user g Nothing
|
||||
unreadCount <- getGroupUnreadCount_ db user g Nothing
|
||||
(unreadCount, unreadMentions) <- getGroupUnreadCount_ db user g Nothing
|
||||
reportsCount <- getGroupReportsCount_ db user g False
|
||||
pure ChatStats {unreadCount, reportsCount, minUnreadItemId, unreadChat = False}
|
||||
pure ChatStats {unreadCount, unreadMentions, reportsCount, minUnreadItemId, unreadChat = False}
|
||||
|
||||
getGroupMinUnreadId_ :: DB.Connection -> User -> GroupInfo -> Maybe MsgContentTag -> IO (Maybe ChatItemId)
|
||||
getGroupMinUnreadId_ db user g contentFilter =
|
||||
|
|
@ -1368,11 +1381,11 @@ getGroupMinUnreadId_ db user g contentFilter =
|
|||
baseQuery = "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? "
|
||||
orderLimit = " ORDER BY item_ts ASC, chat_item_id ASC LIMIT 1"
|
||||
|
||||
getGroupUnreadCount_ :: DB.Connection -> User -> GroupInfo -> Maybe MsgContentTag -> IO Int
|
||||
getGroupUnreadCount_ :: DB.Connection -> User -> GroupInfo -> Maybe MsgContentTag -> IO (Int, Int)
|
||||
getGroupUnreadCount_ db user g contentFilter =
|
||||
fromOnly . head <$> queryUnreadGroupItems db user g contentFilter baseQuery ""
|
||||
head <$> queryUnreadGroupItems db user g contentFilter baseQuery ""
|
||||
where
|
||||
baseQuery = "SELECT COUNT(1) FROM chat_items WHERE user_id = ? AND group_id = ? "
|
||||
baseQuery = "SELECT COUNT(1), COALESCE(SUM(user_mention), 0) FROM chat_items WHERE user_id = ? AND group_id = ? "
|
||||
|
||||
getGroupReportsCount_ :: DB.Connection -> User -> GroupInfo -> Bool -> IO Int
|
||||
getGroupReportsCount_ db User {userId} GroupInfo {groupId} archived =
|
||||
|
|
@ -1501,6 +1514,7 @@ safeToLocalItem currentTs itemId = \case
|
|||
{ chatDir = CILocalSnd,
|
||||
meta = dummyMeta itemId ts errorText,
|
||||
content = CIInvalidJSON errorText,
|
||||
mentions = M.empty,
|
||||
formattedText = Nothing,
|
||||
quotedItem = Nothing,
|
||||
reactions = [],
|
||||
|
|
@ -1810,7 +1824,7 @@ updateLocalChatItemsRead db User {userId} noteFolderId = do
|
|||
|
||||
type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol)
|
||||
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe BoolInt)
|
||||
type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe BoolInt, BoolInt)
|
||||
|
||||
type ChatItemForwardedFromRow = (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
|
||||
|
|
@ -1834,7 +1848,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, sentViaProxy, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sentViaProxy, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive, BI userMention) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. quoteRow) =
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
|
||||
|
|
@ -1858,7 +1872,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
|||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect
|
||||
cItem d chatDir ciStatus content file =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, reactions = [], file}
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, mentions = M.empty, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, reactions = [], file}
|
||||
badItem = Left $ SEBadChatItem itemId (Just itemTs)
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d
|
||||
ciMeta content status =
|
||||
|
|
@ -1867,7 +1881,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
|||
_ -> Just (CIDeleted @'CTDirect deletedTs)
|
||||
itemEdited' = maybe False unBI itemEdited
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) currentTs itemTs Nothing createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
|
|
@ -1891,7 +1905,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, sentViaProxy, 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
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sentViaProxy, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. forwardedFromRow :. (timedTTL, timedDeleteAt, itemLive, BI userMention) :. (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_
|
||||
|
|
@ -1918,7 +1932,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
|||
_ -> Nothing
|
||||
cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTGroup
|
||||
cItem d chatDir ciStatus content file =
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, reactions = [], file}
|
||||
CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, mentions = M.empty, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, reactions = [], file}
|
||||
badItem = Left $ SEBadChatItem itemId (Just itemTs)
|
||||
ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d
|
||||
ciMeta content status =
|
||||
|
|
@ -1929,7 +1943,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
|||
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
itemEdited' = maybe False unBI itemEdited
|
||||
itemForwarded = toCIForwardedFrom forwardedFromRow
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) currentTs itemTs forwardedByMember createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status (unBI <$> sentViaProxy) sharedMsgId itemForwarded itemDeleted' itemEdited' ciTimed (unBI <$> itemLive) userMention currentTs itemTs forwardedByMember createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
|
|
@ -2202,7 +2216,7 @@ getDirectChatItem db User {userId} contactId itemId = ExceptT $ do
|
|||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, 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,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
|
||||
-- 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
|
||||
|
|
@ -2254,12 +2268,14 @@ getGroupCIWithReactions db user g@GroupInfo {groupId} itemId = do
|
|||
liftIO . groupCIWithReactions db g =<< getGroupChatItem db user groupId itemId
|
||||
|
||||
groupCIWithReactions :: DB.Connection -> GroupInfo -> CChatItem 'CTGroup -> IO (CChatItem 'CTGroup)
|
||||
groupCIWithReactions db g cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of
|
||||
Just sharedMsgId -> do
|
||||
let GroupMember {memberId} = chatItemMember g ci
|
||||
reactions <- getGroupCIReactions db g memberId sharedMsgId
|
||||
pure $ CChatItem md ci {reactions}
|
||||
Nothing -> pure cci
|
||||
groupCIWithReactions db g cci@(CChatItem md ci@ChatItem {meta = CIMeta {itemId, itemSharedMsgId}}) = do
|
||||
mentions <- getGroupCIMentions db itemId
|
||||
case itemSharedMsgId of
|
||||
Just sharedMsgId -> do
|
||||
let GroupMember {memberId} = chatItemMember g ci
|
||||
reactions <- getGroupCIReactions db g memberId sharedMsgId
|
||||
pure $ CChatItem md ci {reactions, mentions}
|
||||
Nothing -> pure $ if null mentions then cci else CChatItem md ci {mentions}
|
||||
|
||||
updateGroupChatItem :: MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
|
||||
updateGroupChatItem db user groupId ci newContent edited live msgId_ = do
|
||||
|
|
@ -2285,6 +2301,25 @@ updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ =
|
|||
((content, itemText, itemStatus, BI itemDeleted', itemDeletedTs', BI itemEdited, BI <$> itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId))
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId updatedAt
|
||||
|
||||
createGroupCIMentions :: forall d. DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> Map MemberName CIMention -> IO (ChatItem 'CTGroup d)
|
||||
createGroupCIMentions db GroupInfo {groupId} ci mentions = do
|
||||
DB.executeMany db "INSERT INTO chat_item_mentions (chat_item_id, group_id, member_id, display_name) VALUES (?, ?, ?, ?)" rows
|
||||
pure (ci :: ChatItem 'CTGroup d) {mentions}
|
||||
where
|
||||
rows = map (\(name, CIMention {memberId}) -> (ciId, groupId, memberId, name)) $ M.assocs mentions
|
||||
ciId = chatItemId' ci
|
||||
|
||||
updateGroupCIMentions :: DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> Map MemberName CIMention -> IO (ChatItem 'CTGroup d)
|
||||
updateGroupCIMentions db g ci@ChatItem {mentions} mentions'
|
||||
| mentions' == mentions = pure ci
|
||||
| otherwise = do
|
||||
unless (null mentions) $ deleteMentions
|
||||
if null mentions'
|
||||
then pure ci
|
||||
else createGroupCIMentions db g ci mentions'
|
||||
where
|
||||
deleteMentions = DB.execute db "DELETE FROM chat_item_mentions WHERE chat_item_id = ?" (Only $ chatItemId' ci)
|
||||
|
||||
deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> IO ()
|
||||
deleteGroupChatItem db User {userId} g@GroupInfo {groupId} ci = do
|
||||
let itemId = chatItemId' ci
|
||||
|
|
@ -2458,7 +2493,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
|||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, 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,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
|
||||
-- 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
|
||||
|
|
@ -2562,7 +2597,7 @@ getLocalChatItem db User {userId} folderId itemId = ExceptT $ do
|
|||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, 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,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
|
||||
-- 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
|
||||
|
|
@ -2760,6 +2795,28 @@ getGroupCIReactions db GroupInfo {groupId} itemMemberId itemSharedMsgId =
|
|||
|]
|
||||
(groupId, itemMemberId, itemSharedMsgId)
|
||||
|
||||
getGroupCIMentions :: DB.Connection -> ChatItemId -> IO (Map MemberName CIMention)
|
||||
getGroupCIMentions db ciId =
|
||||
M.fromList . map mentionedMember
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT r.display_name, r.member_id, m.group_member_id, m.member_role, p.display_name, p.local_alias
|
||||
FROM chat_item_mentions r
|
||||
LEFT JOIN group_members m ON r.group_id = m.group_id AND r.member_id = m.member_id
|
||||
LEFT JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
WHERE r.chat_item_id = ?
|
||||
|]
|
||||
(Only ciId)
|
||||
where
|
||||
mentionedMember :: (ContactName, MemberId, Maybe GroupMemberId, Maybe GroupMemberRole, Maybe Text, Maybe Text) -> (ContactName, CIMention)
|
||||
mentionedMember (name, memberId, gmId_, mRole_, displayName_, localAlias) =
|
||||
let memberRef = case (gmId_, mRole_, displayName_) of
|
||||
(Just groupMemberId, Just memberRole, Just displayName) ->
|
||||
Just CIMentionMember {groupMemberId, displayName, localAlias, memberRole}
|
||||
_ -> Nothing
|
||||
in (name, CIMention {memberId, memberRef})
|
||||
|
||||
getACIReactions :: DB.Connection -> AChatItem -> IO AChatItem
|
||||
getACIReactions db aci@(AChatItem _ md chat ci@ChatItem {meta = CIMeta {itemSharedMsgId}}) = case itemSharedMsgId of
|
||||
Just itemSharedMId -> case chat of
|
||||
|
|
@ -3060,10 +3117,9 @@ getGroupSndStatusCounts db itemId =
|
|||
(Only itemId)
|
||||
|
||||
getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> GroupMember -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
|
||||
getGroupHistoryItems db user@User {userId} GroupInfo {groupId} m count = do
|
||||
getGroupHistoryItems db user@User {userId} g@GroupInfo {groupId} m count = do
|
||||
ciIds <- getLastItemIds_
|
||||
-- use getGroupCIWithReactions to read reactions data
|
||||
reverse <$> mapM (runExceptT . getGroupChatItem db user groupId) ciIds
|
||||
reverse <$> mapM (runExceptT . getGroupCIWithReactions db user g) ciIds
|
||||
where
|
||||
getLastItemIds_ :: IO [ChatItemId]
|
||||
getLastItemIds_ =
|
||||
|
|
|
|||
|
|
@ -426,7 +426,8 @@ CREATE TABLE chat_items(
|
|||
fwd_from_chat_item_id BIGINT REFERENCES chat_items ON DELETE SET NULL,
|
||||
via_proxy SMALLINT,
|
||||
msg_content_tag TEXT,
|
||||
include_in_history SMALLINT NOT NULL DEFAULT 0
|
||||
include_in_history SMALLINT NOT NULL DEFAULT 0,
|
||||
user_mention SMALLINT NOT NULL DEFAULT 0
|
||||
);
|
||||
ALTER TABLE groups
|
||||
ADD CONSTRAINT fk_groups_chat_items
|
||||
|
|
@ -676,6 +677,13 @@ CREATE TABLE chat_tags_chats(
|
|||
group_id BIGINT REFERENCES groups ON DELETE CASCADE,
|
||||
chat_tag_id BIGINT NOT NULL REFERENCES chat_tags ON DELETE CASCADE
|
||||
);
|
||||
CREATE TABLE chat_item_mentions (
|
||||
chat_item_mention_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
|
||||
chat_item_id BIGINT NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
group_id BIGINT NOT NULL REFERENCES groups ON DELETE CASCADE,
|
||||
member_id BYTEA NOT NULL,
|
||||
display_name TEXT NOT NULL
|
||||
);
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
full_name
|
||||
|
|
@ -1025,4 +1033,8 @@ CREATE INDEX idx_group_snd_item_statuses_chat_item_id_group_member_id ON group_s
|
|||
chat_item_id,
|
||||
group_member_id
|
||||
);
|
||||
CREATE INDEX idx_chat_item_mentions_group_id ON chat_item_mentions(group_id);
|
||||
CREATE INDEX idx_chat_item_mentions_chat_item_id ON chat_item_mentions(chat_item_id);
|
||||
CREATE UNIQUE INDEX idx_chat_item_mentions_display_name ON chat_item_mentions(chat_item_id, display_name);
|
||||
CREATE UNIQUE INDEX idx_chat_item_mentions_member_id ON chat_item_mentions(chat_item_id, member_id);
|
||||
|]
|
||||
|
|
|
|||
|
|
@ -125,6 +125,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20241230_reports
|
|||
import Simplex.Chat.Store.SQLite.Migrations.M20250105_indexes
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20250115_chat_ttl
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_history
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
|
|
@ -249,7 +250,8 @@ schemaMigrations =
|
|||
("20241230_reports", m20241230_reports, Just down_m20241230_reports),
|
||||
("20250105_indexes", m20250105_indexes, Just down_m20250105_indexes),
|
||||
("20250115_chat_ttl", m20250115_chat_ttl, Just down_m20250115_chat_ttl),
|
||||
("20250122_chat_items_include_in_history", m20250122_chat_items_include_in_history, Just down_m20250122_chat_items_include_in_history)
|
||||
("20250122_chat_items_include_in_history", m20250122_chat_items_include_in_history, Just down_m20250122_chat_items_include_in_history),
|
||||
("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
|
|
|||
|
|
@ -0,0 +1,41 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20250126_mentions :: Query
|
||||
m20250126_mentions =
|
||||
[sql|
|
||||
ALTER TABLE chat_items ADD COLUMN user_mention INTEGER NOT NULL DEFAULT 0;
|
||||
|
||||
CREATE TABLE chat_item_mentions (
|
||||
chat_item_mention_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
|
||||
member_id BLOB NOT NULL,
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
display_name TEXT NOT NULL
|
||||
);
|
||||
|
||||
CREATE INDEX idx_chat_item_mentions_group_id ON chat_item_mentions(group_id);
|
||||
CREATE INDEX idx_chat_item_mentions_chat_item_id ON chat_item_mentions(chat_item_id);
|
||||
CREATE UNIQUE INDEX idx_chat_item_mentions_display_name ON chat_item_mentions(chat_item_id, display_name);
|
||||
CREATE UNIQUE INDEX idx_chat_item_mentions_member_id ON chat_item_mentions(chat_item_id, member_id);
|
||||
|
||||
CREATE INDEX idx_chat_items_groups_user_mention ON chat_items(user_id, group_id, item_status, user_mention);
|
||||
|]
|
||||
|
||||
down_m20250126_mentions :: Query
|
||||
down_m20250126_mentions =
|
||||
[sql|
|
||||
DROP INDEX idx_chat_items_groups_user_mention;
|
||||
|
||||
DROP INDEX idx_chat_item_mentions_group_id;
|
||||
DROP INDEX idx_chat_item_mentions_chat_item_id;
|
||||
DROP INDEX idx_chat_item_mentions_display_name;
|
||||
DROP INDEX idx_chat_item_mentions_member_id;
|
||||
|
||||
DROP TABLE chat_item_mentions;
|
||||
ALTER TABLE chat_items DROP COLUMN user_mention;
|
||||
|]
|
||||
|
|
@ -157,7 +157,7 @@ Query:
|
|||
WHERE i.user_id = ? AND i.item_status = ? AND (g.enable_ntfs = 1 OR g.enable_ntfs IS NULL)
|
||||
|
||||
Plan:
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_groups (user_id=?)
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=?)
|
||||
SEARCH g USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
|
|
@ -480,7 +480,7 @@ Query:
|
|||
LIMIT ?
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_history (user_id=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=?)
|
||||
USE TEMP B-TREE FOR ORDER BY
|
||||
|
||||
Query:
|
||||
|
|
@ -491,7 +491,7 @@ Query:
|
|||
LIMIT ?
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_history (user_id=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=?)
|
||||
USE TEMP B-TREE FOR ORDER BY
|
||||
|
||||
Query:
|
||||
|
|
@ -714,7 +714,7 @@ Query:
|
|||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, 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,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
|
||||
-- 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
|
||||
|
|
@ -731,7 +731,7 @@ Query:
|
|||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, 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,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
|
||||
-- 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
|
||||
|
|
@ -778,7 +778,7 @@ Query:
|
|||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.via_proxy, 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,
|
||||
i.timed_ttl, i.timed_delete_at, i.item_live, i.user_mention,
|
||||
-- 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
|
||||
|
|
@ -985,7 +985,7 @@ Query:
|
|||
LIMIT 1
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?)
|
||||
USE TEMP B-TREE FOR ORDER BY
|
||||
|
||||
Query:
|
||||
|
|
@ -1005,7 +1005,7 @@ Query:
|
|||
LIMIT ?
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_history (user_id=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=?)
|
||||
USE TEMP B-TREE FOR ORDER BY
|
||||
|
||||
Query:
|
||||
|
|
@ -1151,7 +1151,7 @@ Query:
|
|||
LIMIT 1
|
||||
|
||||
Plan:
|
||||
SEARCH i USING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
|
||||
SEARCH i USING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?)
|
||||
SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH c USING INTEGER PRIMARY KEY (rowid=?)
|
||||
USE TEMP B-TREE FOR ORDER BY
|
||||
|
|
@ -1920,12 +1920,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -1949,7 +1950,7 @@ Query:
|
|||
ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=?)
|
||||
|
|
@ -1971,12 +1972,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -1995,7 +1997,7 @@ Query:
|
|||
ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=?)
|
||||
|
|
@ -2016,12 +2018,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2039,7 +2042,7 @@ Query:
|
|||
AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=? AND chat_ts<?)
|
||||
|
|
@ -2060,12 +2063,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2083,7 +2087,7 @@ Query:
|
|||
AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=? AND chat_ts>?)
|
||||
|
|
@ -2104,12 +2108,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2127,7 +2132,7 @@ Query:
|
|||
ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=?)
|
||||
|
|
@ -2148,12 +2153,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2171,7 +2177,7 @@ Query:
|
|||
AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=? AND chat_ts<?)
|
||||
|
|
@ -2192,12 +2198,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2215,7 +2222,7 @@ Query:
|
|||
AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=? AND chat_ts>?)
|
||||
|
|
@ -2236,12 +2243,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2259,7 +2267,7 @@ Query:
|
|||
ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=?)
|
||||
|
|
@ -2280,12 +2288,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2300,7 +2309,7 @@ Query:
|
|||
WHERE g.user_id = ? AND g.chat_ts < ? ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=? AND chat_ts<?)
|
||||
|
|
@ -2321,12 +2330,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2341,7 +2351,7 @@ Query:
|
|||
WHERE g.user_id = ? AND g.chat_ts > ? ORDER BY g.chat_ts ASC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=? AND chat_ts>?)
|
||||
|
|
@ -2362,12 +2372,13 @@ Query:
|
|||
LIMIT 1
|
||||
) AS chat_item_id,
|
||||
COALESCE(ChatStats.UnreadCount, 0),
|
||||
COALESCE(ChatStats.UnreadMentions, 0),
|
||||
COALESCE(ReportCount.Count, 0),
|
||||
COALESCE(ChatStats.MinUnread, 0),
|
||||
g.unread_chat
|
||||
FROM groups g
|
||||
LEFT JOIN (
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
|
||||
SELECT group_id, COUNT(1) AS UnreadCount, SUM(user_mention) as UnreadMentions, MIN(chat_item_id) AS MinUnread
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id IS NOT NULL AND item_status = ?
|
||||
GROUP BY group_id
|
||||
|
|
@ -2382,7 +2393,7 @@ Query:
|
|||
WHERE g.user_id = ? ORDER BY g.chat_ts DESC LIMIT ?
|
||||
Plan:
|
||||
MATERIALIZE ChatStats
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id>?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id>?)
|
||||
MATERIALIZE ReportCount
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id>?)
|
||||
SEARCH g USING INDEX idx_groups_chat_ts (user_id=?)
|
||||
|
|
@ -2930,7 +2941,7 @@ Query:
|
|||
LIMIT 1
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?)
|
||||
USE TEMP B-TREE FOR ORDER BY
|
||||
|
||||
Query:
|
||||
|
|
@ -3295,6 +3306,18 @@ SEARCH r USING INDEX idx_received_probes_user_id (user_id=?)
|
|||
SEARCH m USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
SEARCH g USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT r.display_name, r.member_id, m.group_member_id, m.member_role, p.display_name, p.local_alias
|
||||
FROM chat_item_mentions r
|
||||
LEFT JOIN group_members m ON r.group_id = m.group_id AND r.member_id = m.member_id
|
||||
LEFT JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
WHERE r.chat_item_id = ?
|
||||
|
||||
Plan:
|
||||
SEARCH r USING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH m USING INDEX sqlite_autoindex_group_members_1 (group_id=? AND member_id=?) LEFT-JOIN
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
|
||||
|
||||
Query:
|
||||
SELECT re_group_member_id
|
||||
FROM group_member_intros
|
||||
|
|
@ -3489,6 +3512,7 @@ Query:
|
|||
|
||||
Plan:
|
||||
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -3503,6 +3527,7 @@ Query:
|
|||
|
||||
Plan:
|
||||
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -3517,6 +3542,7 @@ Query:
|
|||
|
||||
Plan:
|
||||
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -3964,12 +3990,12 @@ Query:
|
|||
user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id,
|
||||
-- meta
|
||||
item_sent, item_ts, item_content, item_content_tag, item_text, item_status, msg_content_tag, shared_msg_id,
|
||||
forwarded_by_group_member_id, include_in_history, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
forwarded_by_group_member_id, include_in_history, created_at, updated_at, item_live, user_mention, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
|
||||
|
|
@ -4065,7 +4091,7 @@ Query:
|
|||
WHERE user_id = ? AND group_id = ? AND item_status = ? AND timed_ttl IS NOT NULL AND timed_delete_at IS NULL
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups (user_id=? AND group_id=? AND item_status=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=? AND item_status=?)
|
||||
|
||||
Query:
|
||||
SELECT group_snd_item_status, COUNT(1)
|
||||
|
|
@ -4156,7 +4182,7 @@ Query:
|
|||
WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups (user_id=? AND group_id=? AND item_status=?)
|
||||
SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=? AND item_status=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items SET item_status = ?, updated_at = ?
|
||||
|
|
@ -4651,7 +4677,7 @@ Query:
|
|||
JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
WHERE i.user_id = ?
|
||||
Plan:
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_groups_history (user_id=?)
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=?)
|
||||
SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
|
||||
|
||||
Query:
|
||||
|
|
@ -4678,7 +4704,7 @@ Query:
|
|||
JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
WHERE i.user_id = ? AND i.group_id = ?
|
||||
Plan:
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?)
|
||||
SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
|
||||
|
||||
Query:
|
||||
|
|
@ -4690,6 +4716,24 @@ Plan:
|
|||
SEARCH i USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
|
||||
SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
|
||||
|
||||
Query:
|
||||
SELECT m.group_member_id, m.member_id, m.member_role, p.display_name, p.local_alias
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?
|
||||
Plan:
|
||||
SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT m.group_member_id, m.member_id, m.member_role, p.display_name, p.local_alias
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
WHERE m.group_id = ? AND m.member_id = ? AND m.user_id = ?
|
||||
Plan:
|
||||
SEARCH m USING INDEX sqlite_autoindex_group_members_1 (group_id=? AND member_id=?)
|
||||
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT remote_ctrl_id, ctrl_device_name, ca_key, ca_cert, ctrl_fingerprint, id_pub, dh_priv_key, prev_dh_priv_key
|
||||
FROM remote_controllers
|
||||
|
|
@ -4957,6 +5001,7 @@ SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_
|
|||
Query: DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -4968,6 +5013,7 @@ SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)
|
|||
Query: DELETE FROM chat_items WHERE user_id = ? AND contact_id = ? AND created_at <= ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=? AND created_at<?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -4978,7 +5024,8 @@ SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)
|
|||
|
||||
Query: DELETE FROM chat_items WHERE user_id = ? AND group_id = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -4990,6 +5037,7 @@ SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)
|
|||
Query: DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -5001,6 +5049,7 @@ SEARCH groups USING COVERING INDEX idx_groups_chat_item_id (chat_item_id=?)
|
|||
Query: DELETE FROM chat_items WHERE user_id = ? AND note_folder_id = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
|
||||
SEARCH group_snd_item_statuses USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id (chat_item_id=?)
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_chat_item_id (chat_item_id=?)
|
||||
|
|
@ -5155,11 +5204,12 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
|
|||
Query: DELETE FROM groups WHERE user_id = ? AND group_id = ?
|
||||
Plan:
|
||||
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH chat_item_mentions USING COVERING INDEX idx_chat_item_mentions_group_id (group_id=?)
|
||||
SEARCH chat_tags_chats USING COVERING INDEX idx_chat_tags_chats_chat_tag_id_group_id (group_id=?)
|
||||
SEARCH chat_item_moderations USING COVERING INDEX idx_chat_item_moderations_group_id (group_id=?)
|
||||
SEARCH chat_item_reactions USING COVERING INDEX idx_chat_item_reactions_group_id (group_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_fwd_from_group_id (fwd_from_group_id=?)
|
||||
SCAN chat_items USING COVERING INDEX idx_chat_items_groups_item_ts
|
||||
SCAN chat_items USING COVERING INDEX idx_chat_items_groups_user_mention
|
||||
SEARCH messages USING COVERING INDEX idx_messages_group_id (group_id=?)
|
||||
SEARCH user_contact_links USING COVERING INDEX idx_user_contact_links_group_id (group_id=?)
|
||||
SEARCH files USING COVERING INDEX idx_files_group_id (group_id=?)
|
||||
|
|
@ -5271,7 +5321,7 @@ SEARCH protocol_servers USING COVERING INDEX idx_smp_servers_user_id (user_id=?)
|
|||
SEARCH settings USING COVERING INDEX idx_settings_user_id (user_id=?)
|
||||
SEARCH commands USING COVERING INDEX idx_commands_user_id (user_id=?)
|
||||
SEARCH calls USING COVERING INDEX idx_calls_user_id (user_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_history (user_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=?)
|
||||
SEARCH contact_requests USING COVERING INDEX sqlite_autoindex_contact_requests_2 (user_id=?)
|
||||
SEARCH user_contact_links USING COVERING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
|
||||
SEARCH connections USING COVERING INDEX idx_connections_group_member (user_id=?)
|
||||
|
|
@ -5293,6 +5343,9 @@ Plan:
|
|||
Query: INSERT INTO app_settings (app_settings) VALUES (?)
|
||||
Plan:
|
||||
|
||||
Query: INSERT INTO chat_item_mentions (chat_item_id, group_id, member_id, display_name) VALUES (?, ?, ?, ?)
|
||||
Plan:
|
||||
|
||||
Query: INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)
|
||||
Plan:
|
||||
|
||||
|
|
@ -5407,10 +5460,6 @@ Query: SELECT COUNT(1) FROM chat_item_versions WHERE chat_item_id = ?
|
|||
Plan:
|
||||
SEARCH chat_item_versions USING COVERING INDEX idx_chat_item_versions_chat_item_id (chat_item_id=?)
|
||||
|
||||
Query: SELECT COUNT(1) FROM chat_items WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups (user_id=? AND group_id=? AND item_status=?)
|
||||
|
||||
Query: SELECT COUNT(1) FROM chat_items WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = 0
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id=? AND msg_content_tag=? AND item_deleted=? AND item_sent=?)
|
||||
|
|
@ -5423,6 +5472,10 @@ Query: SELECT COUNT(1) FROM groups WHERE user_id = ? AND chat_item_ttl > 0
|
|||
Plan:
|
||||
SEARCH groups USING INDEX idx_groups_chat_ts (user_id=?)
|
||||
|
||||
Query: SELECT COUNT(1), COALESCE(SUM(user_mention), 0) FROM chat_items WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=? AND item_status=?)
|
||||
|
||||
Query: SELECT accepted_at FROM operator_usage_conditions WHERE server_operator_id = ? AND conditions_commit = ?
|
||||
Plan:
|
||||
SEARCH operator_usage_conditions USING INDEX idx_operator_usage_conditions_conditions_commit (conditions_commit=? AND server_operator_id=?)
|
||||
|
|
|
|||
|
|
@ -407,7 +407,8 @@ CREATE TABLE chat_items(
|
|||
fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL,
|
||||
via_proxy INTEGER,
|
||||
msg_content_tag TEXT,
|
||||
include_in_history INTEGER NOT NULL DEFAULT 0
|
||||
include_in_history INTEGER NOT NULL DEFAULT 0,
|
||||
user_mention INTEGER NOT NULL DEFAULT 0
|
||||
);
|
||||
CREATE TABLE sqlite_sequence(name,seq);
|
||||
CREATE TABLE chat_item_messages(
|
||||
|
|
@ -642,6 +643,13 @@ CREATE TABLE chat_tags_chats(
|
|||
group_id INTEGER REFERENCES groups ON DELETE CASCADE,
|
||||
chat_tag_id INTEGER NOT NULL REFERENCES chat_tags ON DELETE CASCADE
|
||||
);
|
||||
CREATE TABLE chat_item_mentions(
|
||||
chat_item_mention_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
|
||||
member_id BLOB NOT NULL,
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
display_name TEXT NOT NULL
|
||||
);
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
full_name
|
||||
|
|
@ -991,3 +999,21 @@ CREATE INDEX idx_group_snd_item_statuses_chat_item_id_group_member_id ON group_s
|
|||
chat_item_id,
|
||||
group_member_id
|
||||
);
|
||||
CREATE INDEX idx_chat_item_mentions_group_id ON chat_item_mentions(group_id);
|
||||
CREATE INDEX idx_chat_item_mentions_chat_item_id ON chat_item_mentions(
|
||||
chat_item_id
|
||||
);
|
||||
CREATE UNIQUE INDEX idx_chat_item_mentions_display_name ON chat_item_mentions(
|
||||
chat_item_id,
|
||||
display_name
|
||||
);
|
||||
CREATE UNIQUE INDEX idx_chat_item_mentions_member_id ON chat_item_mentions(
|
||||
chat_item_id,
|
||||
member_id
|
||||
);
|
||||
CREATE INDEX idx_chat_items_groups_user_mention ON chat_items(
|
||||
user_id,
|
||||
group_id,
|
||||
item_status,
|
||||
user_mention
|
||||
);
|
||||
|
|
|
|||
|
|
@ -140,6 +140,8 @@ data StoreError
|
|||
| SEProhibitedDeleteUser {userId :: UserId, contactId :: ContactId}
|
||||
| SEOperatorNotFound {serverOperatorId :: Int64}
|
||||
| SEUsageConditionsNotFound
|
||||
| SEInvalidQuote
|
||||
| SEInvalidMention
|
||||
deriving (Show, Exception)
|
||||
|
||||
$(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
|
|||
responseNotification ct cc r
|
||||
where
|
||||
markChatItemRead u (AChatItem _ _ chat ci@ChatItem {chatDir, meta = CIMeta {itemStatus}}) =
|
||||
case (chatDirNtf u chat chatDir (isMention ci), itemStatus) of
|
||||
case (chatDirNtf u chat chatDir (isUserMention ci), itemStatus) of
|
||||
(True, CISRcvNew) -> do
|
||||
let itemId = chatItemId' ci
|
||||
chatRef = chatInfoToRef chat
|
||||
|
|
@ -178,7 +178,7 @@ responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO ()
|
|||
responseNotification t@ChatTerminal {sendNotification} cc = \case
|
||||
-- At the moment of writing received items are created one at a time
|
||||
CRNewChatItems u ((AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) : _) ->
|
||||
when (chatDirNtf u cInfo chatDir $ isMention ci) $ do
|
||||
when (chatDirNtf u cInfo chatDir $ isUserMention ci) $ do
|
||||
whenCurrUser cc u $ setActiveChat t cInfo
|
||||
case (cInfo, chatDir) of
|
||||
(DirectChat ct, _) -> sendNtf (viewContactName ct <> "> ", text)
|
||||
|
|
@ -187,7 +187,7 @@ responseNotification t@ChatTerminal {sendNotification} cc = \case
|
|||
where
|
||||
text = msgText mc formattedText
|
||||
CRChatItemUpdated u (AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent _}) ->
|
||||
whenCurrUser cc u $ when (chatDirNtf u cInfo chatDir $ isMention ci) $ setActiveChat t cInfo
|
||||
whenCurrUser cc u $ when (chatDirNtf u cInfo chatDir $ isUserMention ci) $ setActiveChat t cInfo
|
||||
CRContactConnected u ct _ -> when (contactNtf u ct False) $ do
|
||||
whenCurrUser cc u $ setActiveContact t ct
|
||||
sendNtf (viewContactName ct <> "> ", "connected")
|
||||
|
|
|
|||
|
|
@ -366,6 +366,8 @@ type UserName = Text
|
|||
|
||||
type ContactName = Text
|
||||
|
||||
type MemberName = Text
|
||||
|
||||
type GroupName = Text
|
||||
|
||||
optionalFullName :: ContactName -> Text -> Text
|
||||
|
|
@ -800,6 +802,9 @@ memberConn GroupMember {activeConn} = activeConn
|
|||
memberConnId :: GroupMember -> Maybe ConnId
|
||||
memberConnId GroupMember {activeConn} = aConnId <$> activeConn
|
||||
|
||||
sameMemberId :: MemberId -> GroupMember -> Bool
|
||||
sameMemberId memId GroupMember {memberId} = memId == memberId
|
||||
|
||||
memberChatVRange' :: GroupMember -> VersionRangeChat
|
||||
memberChatVRange' GroupMember {activeConn, memberChatVRange} = case activeConn of
|
||||
Just Connection {peerChatVRange} -> peerChatVRange
|
||||
|
|
@ -839,7 +844,7 @@ data NewGroupMember = NewGroupMember
|
|||
}
|
||||
|
||||
newtype MemberId = MemberId {unMemberId :: ByteString}
|
||||
deriving (Eq, Show)
|
||||
deriving (Eq, Ord, Show)
|
||||
deriving newtype (FromField)
|
||||
|
||||
instance ToField MemberId where toField (MemberId m) = toField $ Binary m
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ import qualified Data.Aeson as J
|
|||
import qualified Data.Aeson.TH as JQ
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Char (isSpace, toUpper)
|
||||
import Data.Char (toUpper)
|
||||
import Data.Function (on)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
|
||||
|
|
@ -499,7 +499,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
contactList :: [ContactRef] -> String
|
||||
contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
|
||||
unmuted :: User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]
|
||||
unmuted u chat ci@ChatItem {chatDir} = unmuted' u chat chatDir $ isMention ci
|
||||
unmuted u chat ci@ChatItem {chatDir} = unmuted' u chat chatDir $ isUserMention ci
|
||||
unmutedReaction :: User -> ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString]
|
||||
unmutedReaction u chat CIReaction {chatDir} = unmuted' u chat chatDir False
|
||||
unmuted' :: User -> ChatInfo c -> CIDirection c d -> Bool -> [StyledString] -> [StyledString]
|
||||
|
|
@ -588,7 +588,7 @@ 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 {itemForwarded, forwardedByMember}, content, quotedItem, file} doShow ts tz =
|
||||
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwardedByMember, userMention}, content, quotedItem, file} doShow ts tz =
|
||||
withGroupMsgForwarded . withItemDeleted <$> viewCI
|
||||
where
|
||||
viewCI = case chat of
|
||||
|
|
@ -627,7 +627,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa
|
|||
CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g m) context meta [plainContent content] False
|
||||
_ -> showRcvItem from
|
||||
where
|
||||
from = ttyFromGroup g m
|
||||
from = ttyFromGroupAttention g m userMention
|
||||
where
|
||||
context =
|
||||
maybe
|
||||
|
|
@ -2178,7 +2178,6 @@ viewChatError isCmd logLevel testView = \case
|
|||
CEFileNotApproved fileId unknownSrvs -> ["file " <> sShow fileId <> " aborted, unknwon XFTP servers:"] <> map (plain . show) unknownSrvs
|
||||
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 message(s)"]
|
||||
CEInvalidChatItemUpdate -> ["cannot update this item"]
|
||||
CEInvalidChatItemDelete -> ["cannot delete this item"]
|
||||
|
|
@ -2373,7 +2372,10 @@ ttyFullGroup GroupInfo {localDisplayName = g, groupProfile = GroupProfile {fullN
|
|||
ttyGroup g <> optFullName g fullName
|
||||
|
||||
ttyFromGroup :: GroupInfo -> GroupMember -> StyledString
|
||||
ttyFromGroup g m = membershipIncognito g <> ttyFrom (fromGroup_ g m)
|
||||
ttyFromGroup g m = ttyFromGroupAttention g m False
|
||||
|
||||
ttyFromGroupAttention :: GroupInfo -> GroupMember -> Bool -> StyledString
|
||||
ttyFromGroupAttention g m attention = membershipIncognito g <> ttyFrom (fromGroupAttention_ g m attention)
|
||||
|
||||
ttyFromGroupEdited :: GroupInfo -> GroupMember -> StyledString
|
||||
ttyFromGroupEdited g m = membershipIncognito g <> ttyFrom (fromGroup_ g m <> "[edited] ")
|
||||
|
|
@ -2383,7 +2385,12 @@ ttyFromGroupDeleted g m deletedText_ =
|
|||
membershipIncognito g <> ttyFrom (fromGroup_ g m <> maybe "" (\t -> "[" <> t <> "] ") deletedText_)
|
||||
|
||||
fromGroup_ :: GroupInfo -> GroupMember -> Text
|
||||
fromGroup_ g m = "#" <> viewGroupName g <> " " <> viewMemberName m <> "> "
|
||||
fromGroup_ g m = fromGroupAttention_ g m False
|
||||
|
||||
fromGroupAttention_ :: GroupInfo -> GroupMember -> Bool -> Text
|
||||
fromGroupAttention_ g m attention =
|
||||
let attn = if attention then "!" else ""
|
||||
in "#" <> viewGroupName g <> " " <> viewMemberName m <> attn <> "> "
|
||||
|
||||
ttyFrom :: Text -> StyledString
|
||||
ttyFrom = styled $ colored Yellow
|
||||
|
|
@ -2397,9 +2404,6 @@ ttyToGroup g = membershipIncognito g <> ttyTo ("#" <> viewGroupName g <> " ")
|
|||
ttyToGroupEdited :: GroupInfo -> StyledString
|
||||
ttyToGroupEdited g = membershipIncognito g <> ttyTo ("#" <> viewGroupName g <> " [edited] ")
|
||||
|
||||
viewName :: Text -> Text
|
||||
viewName s = if T.any isSpace s then "'" <> s <> "'" else s
|
||||
|
||||
ttyFilePath :: FilePath -> StyledString
|
||||
ttyFilePath = plain
|
||||
|
||||
|
|
|
|||
|
|
@ -1620,7 +1620,7 @@ testMuteGroup =
|
|||
cath <## " hello too!"
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <# "#team cath> > bob hello <muted>"
|
||||
bob <# "#team cath!> > bob hello <muted>"
|
||||
bob <## " hello too! <muted>",
|
||||
do
|
||||
alice <# "#team cath> > bob hello"
|
||||
|
|
@ -1633,7 +1633,7 @@ testMuteGroup =
|
|||
alice <## " hey bob!"
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <# "#team alice> > bob hello"
|
||||
bob <# "#team alice!> > bob hello"
|
||||
bob <## " hey bob!",
|
||||
do
|
||||
cath <# "#team alice> > bob hello"
|
||||
|
|
@ -1647,7 +1647,7 @@ testMuteGroup =
|
|||
bob <# "#team alice> > cath hello too! <muted>"
|
||||
bob <## " hey cath! <muted>",
|
||||
do
|
||||
cath <# "#team alice> > cath hello too!"
|
||||
cath <# "#team alice!> > cath hello too!"
|
||||
cath <## " hey cath!"
|
||||
]
|
||||
bob ##> "/gs"
|
||||
|
|
|
|||
|
|
@ -372,9 +372,9 @@ testGroupSendImageWithTextAndQuote =
|
|||
alice <## "use /fc 1 to cancel sending"
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <# "#team alice> > bob hi team"
|
||||
bob <# "#team alice!> > bob hi team"
|
||||
bob <## " hey bob"
|
||||
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||
bob <# "#team alice!> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
||||
do
|
||||
cath <# "#team alice> > bob hi team"
|
||||
|
|
|
|||
|
|
@ -15,14 +15,18 @@ import ChatTests.Utils
|
|||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
import Control.Monad (forM_, void, when)
|
||||
import Data.Bifunctor (second)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.List (intercalate, isInfixOf)
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Controller (ChatConfig (..))
|
||||
import Simplex.Chat.Messages (ChatItemId)
|
||||
import Simplex.Chat.Library.Internal (uniqueMsgMentions, updatedMentionNames)
|
||||
import Simplex.Chat.Markdown (parseMaybeMarkdownList)
|
||||
import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId)
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Protocol (supportedChatVRange)
|
||||
import Simplex.Chat.Types (VersionRangeChat)
|
||||
import Simplex.Chat.Protocol (MsgMention (..), MsgContent (..), msgContentText, supportedChatVRange)
|
||||
import Simplex.Chat.Types (MemberId (..), VersionRangeChat)
|
||||
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite
|
||||
import Simplex.Messaging.Agent.RetryInterval
|
||||
|
|
@ -186,6 +190,12 @@ chatGroupTests = do
|
|||
it "mark member inactive on reaching quota" testGroupMemberInactive
|
||||
describe "group member reports" $ do
|
||||
it "should send report to group owner, admins and moderators, but not other users" testGroupMemberReports
|
||||
describe "group member mentions" $ do
|
||||
it "should send and edit messages with member mentions" testMemberMention
|
||||
it "should forward and quote message updating mentioned member name" testForwardQuoteMention
|
||||
it "should send updated mentions in history" testGroupHistoryWithMentions
|
||||
describe "uniqueMsgMentions" testUniqueMsgMentions
|
||||
describe "updatedMentionNames" testUpdatedMentionNames
|
||||
where
|
||||
_0 = supportedChatVRange -- don't create direct connections
|
||||
_1 = groupCreateDirectVRange
|
||||
|
|
@ -1044,7 +1054,7 @@ testGroupMessageQuotedReply =
|
|||
bob <## " hello, all good, you?"
|
||||
concurrently_
|
||||
( do
|
||||
alice <# "#team bob> > alice hello! how are you?"
|
||||
alice <# "#team bob!> > alice hello! how are you?"
|
||||
alice <## " hello, all good, you?"
|
||||
)
|
||||
( do
|
||||
|
|
@ -1079,7 +1089,7 @@ testGroupMessageQuotedReply =
|
|||
alice <## " hi there!"
|
||||
)
|
||||
( do
|
||||
bob <# "#team cath> > bob hello, all good, you?"
|
||||
bob <# "#team cath!> > bob hello, all good, you?"
|
||||
bob <## " hi there!"
|
||||
)
|
||||
cath #$> ("/_get chat #1 count=1", chat', [((1, "hi there!"), Just (0, "hello, all good, you?"))])
|
||||
|
|
@ -1090,7 +1100,7 @@ testGroupMessageQuotedReply =
|
|||
alice <## " go on"
|
||||
concurrently_
|
||||
( do
|
||||
bob <# "#team alice> > bob will tell more"
|
||||
bob <# "#team alice!> > bob will tell more"
|
||||
bob <## " go on"
|
||||
)
|
||||
( do
|
||||
|
|
@ -1131,7 +1141,7 @@ testGroupMessageUpdate =
|
|||
bob <## " hi alice"
|
||||
concurrently_
|
||||
( do
|
||||
alice <# "#team bob> > alice hey 👋"
|
||||
alice <# "#team bob!> > alice hey 👋"
|
||||
alice <## " hi alice"
|
||||
)
|
||||
( do
|
||||
|
|
@ -1158,7 +1168,7 @@ testGroupMessageUpdate =
|
|||
cath <## " greetings!"
|
||||
concurrently_
|
||||
( do
|
||||
alice <# "#team cath> > alice greetings 🤝"
|
||||
alice <# "#team cath!> > alice greetings 🤝"
|
||||
alice <## " greetings!"
|
||||
)
|
||||
( do
|
||||
|
|
@ -1272,7 +1282,7 @@ testGroupMessageDelete =
|
|||
bob <## " hi alic"
|
||||
concurrently_
|
||||
( do
|
||||
alice <# "#team bob> > alice hello!"
|
||||
alice <# "#team bob!> > alice hello!"
|
||||
alice <## " hi alic"
|
||||
)
|
||||
( do
|
||||
|
|
@ -5423,7 +5433,7 @@ testGroupHistoryQuotes =
|
|||
alice `send` "> #team @bob (BOB) 2"
|
||||
alice <# "#team > bob BOB"
|
||||
alice <## " 2"
|
||||
bob <# "#team alice> > bob BOB"
|
||||
bob <# "#team alice!> > bob BOB"
|
||||
bob <## " 2"
|
||||
|
||||
threadDelay 1000000
|
||||
|
|
@ -5431,7 +5441,7 @@ testGroupHistoryQuotes =
|
|||
bob `send` "> #team @alice (ALICE) 3"
|
||||
bob <# "#team > alice ALICE"
|
||||
bob <## " 3"
|
||||
alice <# "#team bob> > alice ALICE"
|
||||
alice <# "#team bob!> > alice ALICE"
|
||||
alice <## " 3"
|
||||
|
||||
threadDelay 1000000
|
||||
|
|
@ -6651,3 +6661,182 @@ testGroupMemberReports =
|
|||
alice #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by you]")])
|
||||
bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by alice]")])
|
||||
dan #$> ("/_get chat #1 content=report count=100", chat, [(1, "report content [marked deleted by alice]")])
|
||||
|
||||
testMemberMention :: HasCallStack => TestParams -> IO ()
|
||||
testMemberMention =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
alice #> "#team hello!"
|
||||
concurrentlyN_
|
||||
[ bob <# "#team alice> hello!",
|
||||
cath <# "#team alice> hello!"
|
||||
]
|
||||
bob #> "#team hello @alice"
|
||||
concurrentlyN_
|
||||
[ alice <# "#team bob!> hello @alice",
|
||||
cath <# "#team bob> hello @alice"
|
||||
]
|
||||
alice #> "#team hello @bob @bob @cath"
|
||||
concurrentlyN_
|
||||
[ bob <# "#team alice!> hello @bob @bob @cath",
|
||||
cath <# "#team alice!> hello @bob @bob @cath"
|
||||
]
|
||||
cath #> "#team hello @Alice" -- not a mention
|
||||
concurrentlyN_
|
||||
[ alice <# "#team cath> hello @Alice",
|
||||
bob <# "#team cath> hello @Alice"
|
||||
]
|
||||
cath ##> "! #team hello @alice @bob"
|
||||
cath <# "#team [edited] hello @alice @bob"
|
||||
concurrentlyN_
|
||||
[ alice <# "#team cath> [edited] hello @alice @bob",
|
||||
bob <# "#team cath> [edited] hello @alice @bob"
|
||||
]
|
||||
|
||||
testForwardQuoteMention :: HasCallStack => TestParams -> IO ()
|
||||
testForwardQuoteMention =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
bob #> "#team hello @alice @cath"
|
||||
concurrentlyN_
|
||||
[ alice <# "#team bob!> hello @alice @cath",
|
||||
cath <# "#team bob!> hello @alice @cath"
|
||||
]
|
||||
-- quote mentions
|
||||
alice `send` "> #team @bob (hello) hi there!"
|
||||
alice <# "#team > bob hello @alice @cath"
|
||||
alice <## " hi there!"
|
||||
concurrently_
|
||||
( do
|
||||
bob <# "#team alice!> > bob hello @alice @cath"
|
||||
bob <## " hi there!"
|
||||
)
|
||||
( do
|
||||
cath <# "#team alice> > bob hello @alice @cath"
|
||||
cath <## " hi there!"
|
||||
)
|
||||
-- forward mentions to the same group
|
||||
alice `send` "#team <- #team hello"
|
||||
alice <# "#team <- #team"
|
||||
alice <## " hello @alice @cath"
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <# "#team alice> -> forwarded"
|
||||
bob <## " hello @alice @cath",
|
||||
do
|
||||
cath <# "#team alice!> -> forwarded"
|
||||
cath <## " hello @alice @cath"
|
||||
]
|
||||
-- forward mentions
|
||||
alice `send` "@bob <- #team hello"
|
||||
alice <# "@bob <- #team"
|
||||
alice <## " hello @alice @cath"
|
||||
bob <# "alice> -> forwarded"
|
||||
bob <## " hello @alice @cath"
|
||||
-- member renamed to duplicate name
|
||||
cath ##> "/p alice_1"
|
||||
cath <## "user profile is changed to alice_1 (your 1 contacts are notified)"
|
||||
alice <## "contact cath changed to alice_1"
|
||||
alice <## "use @alice_1 <message> to send messages"
|
||||
-- mention changed in quoted mentions
|
||||
alice `send` "> #team @bob (hello) hi there!"
|
||||
alice <# "#team > bob hello @alice @alice_1"
|
||||
alice <## " hi there!"
|
||||
concurrently_
|
||||
( do
|
||||
bob <# "#team alice!> > bob hello @alice @alice_1"
|
||||
bob <## " hi there!"
|
||||
)
|
||||
( do
|
||||
cath <# "#team alice> > bob hello @alice @alice_1"
|
||||
cath <## " hi there!"
|
||||
)
|
||||
-- mention changed in forwarded message
|
||||
alice `send` "@bob <- #team hello"
|
||||
alice <# "@bob <- #team"
|
||||
alice <## " hello @alice @alice_1"
|
||||
bob <# "alice> -> forwarded"
|
||||
bob <## " hello @alice @alice_1"
|
||||
|
||||
testGroupHistoryWithMentions :: HasCallStack => TestParams -> IO ()
|
||||
testGroupHistoryWithMentions =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team hello @bob"
|
||||
bob <# "#team alice!> hello @bob"
|
||||
|
||||
bob ##> "/p robert"
|
||||
bob <## "user profile is changed to robert (your 1 contacts are notified)"
|
||||
alice <## "contact bob changed to robert"
|
||||
alice <## "use @robert <message> to send messages"
|
||||
|
||||
alice ##> "/create link #team"
|
||||
gLink <- getGroupLink alice "team" GRMember True
|
||||
|
||||
cath ##> ("/c " <> gLink)
|
||||
cath <## "connection request sent!"
|
||||
alice <## "cath (Catherine): accepting request to join group #team..."
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: joining the group...",
|
||||
"#team: you joined the group",
|
||||
WithTime "#team alice> hello @robert [>>]",
|
||||
"#team: member robert is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
testUniqueMsgMentions :: SpecWith TestParams
|
||||
testUniqueMsgMentions = do
|
||||
it "1 correct mention" $ \_ ->
|
||||
uniqueMsgMentions 2 (mm [("alice", "abcd")]) ["alice"]
|
||||
`shouldBe` (mm [("alice", "abcd")])
|
||||
it "2 correct mentions" $ \_ ->
|
||||
uniqueMsgMentions 2 (mm [("alice", "abcd"), ("bob", "efgh")]) ["alice", "bob"]
|
||||
`shouldBe` (mm [("alice", "abcd"), ("bob", "efgh")])
|
||||
it "2 correct mentions with repetition" $ \_ ->
|
||||
uniqueMsgMentions 2 (mm [("alice", "abcd"), ("bob", "efgh")]) ["alice", "alice", "alice", "bob", "bob", "bob"]
|
||||
`shouldBe` (mm [("alice", "abcd"), ("bob", "efgh")])
|
||||
it "too many mentions - drop extras" $ \_ ->
|
||||
uniqueMsgMentions 3 (mm [("a", "abcd"), ("b", "efgh"), ("c", "1234"), ("d", "5678")]) ["a", "a", "a", "b", "b", "c", "d"]
|
||||
`shouldBe` (mm [("a", "abcd"), ("b", "efgh"), ("c", "1234")])
|
||||
it "repeated-with-different name - drop extras" $ \_ ->
|
||||
uniqueMsgMentions 2 (mm [("alice", "abcd"), ("alice2", "abcd"), ("bob", "efgh"), ("bob2", "efgh")]) ["alice", "alice2", "bob", "bob2"]
|
||||
`shouldBe` (mm [("alice", "abcd"), ("bob", "efgh")])
|
||||
where
|
||||
mm = M.fromList . map (second $ MsgMention . MemberId)
|
||||
|
||||
testUpdatedMentionNames :: SpecWith TestParams
|
||||
testUpdatedMentionNames = do
|
||||
it "keep mentions" $ \_ -> do
|
||||
test (mm [("alice", Just "alice"), ("bob", Nothing)]) "hello @alice @bob"
|
||||
`shouldBe` "hello @alice @bob"
|
||||
test (mm [("alice_1", Just "alice"), ("alice", Just "alice")]) "hello @alice @alice_1"
|
||||
`shouldBe` "hello @alice @alice_1"
|
||||
it "keep non-mentions" $ \_ -> do
|
||||
test (mm []) "hello @alice @bob"
|
||||
`shouldBe` "hello @alice @bob"
|
||||
test (mm [("alice", Just "alice")]) "hello @alice @bob"
|
||||
`shouldBe` "hello @alice @bob"
|
||||
it "replace changed names" $ \_ -> do
|
||||
test (mm [("alice", Just "Alice Jones"), ("bob", Just "robert")]) "hello @alice @bob"
|
||||
`shouldBe` "hello @'Alice Jones' @robert"
|
||||
test (mm [("alice", Just "alice"), ("cath", Just "alice")]) "hello @alice @cath"
|
||||
`shouldBe` "hello @alice @alice_1"
|
||||
where
|
||||
test mentions t =
|
||||
let (mc', _, _) = updatedMentionNames (MCText t) (parseMaybeMarkdownList t) mentions
|
||||
in msgContentText mc'
|
||||
mm = M.fromList . map (second mentionedMember)
|
||||
mentionedMember name_ = CIMention {memberId = MemberId "abcd", memberRef = memberInfo <$> name_}
|
||||
where
|
||||
memberInfo name = CIMentionMember {groupMemberId = 1, displayName = name, localAlias = Nothing, memberRole = GRMember}
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ module MarkdownTests where
|
|||
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Markdown
|
||||
import System.Console.ANSI.Types
|
||||
import Test.Hspec
|
||||
|
|
@ -19,81 +20,102 @@ markdownTests = do
|
|||
textWithUri
|
||||
textWithEmail
|
||||
textWithPhone
|
||||
textWithMentions
|
||||
multilineMarkdownList
|
||||
|
||||
infixr 1 ==>, <==, <==>, ==>>, <<==, <<==>>
|
||||
|
||||
(==>) :: Text -> Markdown -> Expectation
|
||||
s ==> m = parseMarkdown s `shouldBe` m
|
||||
|
||||
(<==) :: Text -> Markdown -> Expectation
|
||||
s <== m = s <<== markdownToList m
|
||||
|
||||
(<==>) :: Text -> Markdown -> Expectation
|
||||
s <==> m = (s ==> m) >> (s <== m)
|
||||
|
||||
(==>>) :: Text -> MarkdownList -> Expectation
|
||||
s ==>> ft = parseMaybeMarkdownList s `shouldBe` Just ft
|
||||
|
||||
(<<==) :: Text -> MarkdownList -> Expectation
|
||||
s <<== ft = T.concat (map markdownText ft) `shouldBe` s
|
||||
|
||||
(<<==>>) :: Text -> MarkdownList -> Expectation
|
||||
s <<==>> ft = (s ==>> ft) >> (s <<== ft)
|
||||
|
||||
textFormat :: Spec
|
||||
textFormat = describe "text format (bold)" do
|
||||
it "correct markdown" do
|
||||
parseMarkdown "this is *bold formatted* text"
|
||||
`shouldBe` "this is " <> markdown Bold "bold formatted" <> " text"
|
||||
parseMarkdown "*bold formatted* text"
|
||||
`shouldBe` markdown Bold "bold formatted" <> " text"
|
||||
parseMarkdown "this is *bold*"
|
||||
`shouldBe` "this is " <> markdown Bold "bold"
|
||||
parseMarkdown " *bold* text"
|
||||
`shouldBe` " " <> markdown Bold "bold" <> " text"
|
||||
parseMarkdown " *bold* text"
|
||||
`shouldBe` " " <> markdown Bold "bold" <> " text"
|
||||
parseMarkdown "this is *bold* "
|
||||
`shouldBe` "this is " <> markdown Bold "bold" <> " "
|
||||
parseMarkdown "this is *bold* "
|
||||
`shouldBe` "this is " <> markdown Bold "bold" <> " "
|
||||
"this is *bold formatted* text"
|
||||
<==> "this is " <> markdown Bold "bold formatted" <> " text"
|
||||
"*bold formatted* text"
|
||||
<==> markdown Bold "bold formatted" <> " text"
|
||||
"this is *bold*"
|
||||
<==> "this is " <> markdown Bold "bold"
|
||||
" *bold* text"
|
||||
<==> " " <> markdown Bold "bold" <> " text"
|
||||
" *bold* text"
|
||||
<==> " " <> markdown Bold "bold" <> " text"
|
||||
"this is *bold* "
|
||||
<==> "this is " <> markdown Bold "bold" <> " "
|
||||
"this is *bold* "
|
||||
<==> "this is " <> markdown Bold "bold" <> " "
|
||||
it "ignored as markdown" do
|
||||
parseMarkdown "this is * unformatted * text"
|
||||
`shouldBe` "this is * unformatted * text"
|
||||
parseMarkdown "this is *unformatted * text"
|
||||
`shouldBe` "this is *unformatted * text"
|
||||
parseMarkdown "this is * unformatted* text"
|
||||
`shouldBe` "this is * unformatted* text"
|
||||
parseMarkdown "this is **unformatted** text"
|
||||
`shouldBe` "this is **unformatted** text"
|
||||
parseMarkdown "this is*unformatted* text"
|
||||
`shouldBe` "this is*unformatted* text"
|
||||
parseMarkdown "this is *unformatted text"
|
||||
`shouldBe` "this is *unformatted text"
|
||||
"this is * unformatted * text"
|
||||
<==> "this is * unformatted * text"
|
||||
"this is *unformatted * text"
|
||||
<==> "this is *unformatted * text"
|
||||
"this is * unformatted* text"
|
||||
<==> "this is * unformatted* text"
|
||||
"this is **unformatted** text"
|
||||
<==> "this is **unformatted** text"
|
||||
"this is*unformatted* text"
|
||||
<==> "this is*unformatted* text"
|
||||
"this is *unformatted text"
|
||||
<==> "this is *unformatted text"
|
||||
it "ignored internal markdown" do
|
||||
parseMarkdown "this is *long _bold_ (not italic)* text"
|
||||
`shouldBe` "this is " <> markdown Bold "long _bold_ (not italic)" <> " text"
|
||||
parseMarkdown "snippet: `this is *bold text*`"
|
||||
`shouldBe` "snippet: " <> markdown Snippet "this is *bold text*"
|
||||
"this is *long _bold_ (not italic)* text"
|
||||
<==> "this is " <> markdown Bold "long _bold_ (not italic)" <> " text"
|
||||
"snippet: `this is *bold text*`"
|
||||
<==> "snippet: " <> markdown Snippet "this is *bold text*"
|
||||
|
||||
secretText :: Spec
|
||||
secretText = describe "secret text" do
|
||||
it "correct markdown" do
|
||||
parseMarkdown "this is #black_secret# text"
|
||||
`shouldBe` "this is " <> markdown Secret "black_secret" <> " text"
|
||||
parseMarkdown "##black_secret### text"
|
||||
`shouldBe` markdown Secret "#black_secret##" <> " text"
|
||||
parseMarkdown "this is #black secret# text"
|
||||
`shouldBe` "this is " <> markdown Secret "black secret" <> " text"
|
||||
parseMarkdown "##black secret### text"
|
||||
`shouldBe` markdown Secret "#black secret##" <> " text"
|
||||
parseMarkdown "this is #secret#"
|
||||
`shouldBe` "this is " <> markdown Secret "secret"
|
||||
parseMarkdown " #secret# text"
|
||||
`shouldBe` " " <> markdown Secret "secret" <> " text"
|
||||
parseMarkdown " #secret# text"
|
||||
`shouldBe` " " <> markdown Secret "secret" <> " text"
|
||||
parseMarkdown "this is #secret# "
|
||||
`shouldBe` "this is " <> markdown Secret "secret" <> " "
|
||||
parseMarkdown "this is #secret# "
|
||||
`shouldBe` "this is " <> markdown Secret "secret" <> " "
|
||||
"this is #black_secret# text"
|
||||
<==> "this is " <> markdown Secret "black_secret" <> " text"
|
||||
"##black_secret### text"
|
||||
<==> markdown Secret "#black_secret##" <> " text"
|
||||
"this is #black secret# text"
|
||||
<==> "this is " <> markdown Secret "black secret" <> " text"
|
||||
"##black secret### text"
|
||||
<==> markdown Secret "#black secret##" <> " text"
|
||||
"this is #secret#"
|
||||
<==> "this is " <> markdown Secret "secret"
|
||||
" #secret# text"
|
||||
<==> " " <> markdown Secret "secret" <> " text"
|
||||
" #secret# text"
|
||||
<==> " " <> markdown Secret "secret" <> " text"
|
||||
"this is #secret# "
|
||||
<==> "this is " <> markdown Secret "secret" <> " "
|
||||
"this is #secret# "
|
||||
<==> "this is " <> markdown Secret "secret" <> " "
|
||||
it "ignored as markdown" do
|
||||
parseMarkdown "this is # unformatted # text"
|
||||
`shouldBe` "this is # unformatted # text"
|
||||
parseMarkdown "this is #unformatted # text"
|
||||
`shouldBe` "this is #unformatted # text"
|
||||
parseMarkdown "this is # unformatted# text"
|
||||
`shouldBe` "this is # unformatted# text"
|
||||
parseMarkdown "this is ## unformatted ## text"
|
||||
`shouldBe` "this is ## unformatted ## text"
|
||||
parseMarkdown "this is#unformatted# text"
|
||||
`shouldBe` "this is#unformatted# text"
|
||||
parseMarkdown "this is #unformatted text"
|
||||
`shouldBe` "this is #unformatted text"
|
||||
"this is # unformatted # text"
|
||||
<==> "this is # unformatted # text"
|
||||
"this is #unformatted # text"
|
||||
<==> "this is #unformatted # text"
|
||||
"this is # unformatted# text"
|
||||
<==> "this is # unformatted# text"
|
||||
"this is ## unformatted ## text"
|
||||
<==> "this is ## unformatted ## text"
|
||||
"this is#unformatted# text"
|
||||
<==> "this is#unformatted# text"
|
||||
"this is #unformatted text"
|
||||
<==> "this is #unformatted text"
|
||||
it "ignored internal markdown" do
|
||||
parseMarkdown "snippet: `this is #secret_text#`"
|
||||
`shouldBe` "snippet: " <> markdown Snippet "this is #secret_text#"
|
||||
"snippet: `this is #secret_text#`"
|
||||
<==> "snippet: " <> markdown Snippet "this is #secret_text#"
|
||||
|
||||
red :: Text -> Markdown
|
||||
red = markdown (colored Red)
|
||||
|
|
@ -101,38 +123,38 @@ red = markdown (colored Red)
|
|||
textColor :: Spec
|
||||
textColor = describe "text color (red)" do
|
||||
it "correct markdown" do
|
||||
parseMarkdown "this is !1 red color! text"
|
||||
`shouldBe` "this is " <> red "red color" <> " text"
|
||||
parseMarkdown "!1 red! text"
|
||||
`shouldBe` red "red" <> " text"
|
||||
parseMarkdown "this is !1 red!"
|
||||
`shouldBe` "this is " <> red "red"
|
||||
parseMarkdown " !1 red! text"
|
||||
`shouldBe` " " <> red "red" <> " text"
|
||||
parseMarkdown " !1 red! text"
|
||||
`shouldBe` " " <> red "red" <> " text"
|
||||
parseMarkdown "this is !1 red! "
|
||||
`shouldBe` "this is " <> red "red" <> " "
|
||||
parseMarkdown "this is !1 red! "
|
||||
`shouldBe` "this is " <> red "red" <> " "
|
||||
"this is !1 red color! text"
|
||||
<==> "this is " <> red "red color" <> " text"
|
||||
"!1 red! text"
|
||||
<==> red "red" <> " text"
|
||||
"this is !1 red!"
|
||||
<==> "this is " <> red "red"
|
||||
" !1 red! text"
|
||||
<==> " " <> red "red" <> " text"
|
||||
" !1 red! text"
|
||||
<==> " " <> red "red" <> " text"
|
||||
"this is !1 red! "
|
||||
<==> "this is " <> red "red" <> " "
|
||||
"this is !1 red! "
|
||||
<==> "this is " <> red "red" <> " "
|
||||
it "ignored as markdown" do
|
||||
parseMarkdown "this is !1 unformatted ! text"
|
||||
`shouldBe` "this is !1 unformatted ! text"
|
||||
parseMarkdown "this is !1 unformatted ! text"
|
||||
`shouldBe` "this is !1 unformatted ! text"
|
||||
parseMarkdown "this is !1 unformatted! text"
|
||||
`shouldBe` "this is !1 unformatted! text"
|
||||
-- parseMarkdown "this is !!1 unformatted!! text"
|
||||
-- `shouldBe` "this is " <> "!!1" <> "unformatted!! text"
|
||||
parseMarkdown "this is!1 unformatted! text"
|
||||
`shouldBe` "this is!1 unformatted! text"
|
||||
parseMarkdown "this is !1 unformatted text"
|
||||
`shouldBe` "this is !1 unformatted text"
|
||||
"this is !1 unformatted ! text"
|
||||
<==> "this is !1 unformatted ! text"
|
||||
"this is !1 unformatted ! text"
|
||||
<==> "this is !1 unformatted ! text"
|
||||
"this is !1 unformatted! text"
|
||||
<==> "this is !1 unformatted! text"
|
||||
-- "this is !!1 unformatted!! text"
|
||||
-- <==> "this is " <> "!!1" <> "unformatted!! text"
|
||||
"this is!1 unformatted! text"
|
||||
<==> "this is!1 unformatted! text"
|
||||
"this is !1 unformatted text"
|
||||
<==> "this is !1 unformatted text"
|
||||
it "ignored internal markdown" do
|
||||
parseMarkdown "this is !1 long *red* (not bold)! text"
|
||||
`shouldBe` "this is " <> red "long *red* (not bold)" <> " text"
|
||||
parseMarkdown "snippet: `this is !1 red text!`"
|
||||
`shouldBe` "snippet: " <> markdown Snippet "this is !1 red text!"
|
||||
"this is !1 long *red* (not bold)! text"
|
||||
<==> "this is " <> red "long *red* (not bold)" <> " text"
|
||||
"snippet: `this is !1 red text!`"
|
||||
<==> "snippet: " <> markdown Snippet "this is !1 red text!"
|
||||
|
||||
uri :: Text -> Markdown
|
||||
uri = Markdown $ Just Uri
|
||||
|
|
@ -143,29 +165,31 @@ simplexLink linkType simplexUri smpHosts = Markdown $ Just SimplexLink {linkType
|
|||
textWithUri :: Spec
|
||||
textWithUri = describe "text with Uri" do
|
||||
it "correct markdown" do
|
||||
parseMarkdown "https://simplex.chat" `shouldBe` uri "https://simplex.chat"
|
||||
parseMarkdown "https://simplex.chat." `shouldBe` uri "https://simplex.chat" <> "."
|
||||
parseMarkdown "https://simplex.chat, hello" `shouldBe` uri "https://simplex.chat" <> ", hello"
|
||||
parseMarkdown "http://simplex.chat" `shouldBe` uri "http://simplex.chat"
|
||||
parseMarkdown "this is https://simplex.chat" `shouldBe` "this is " <> uri "https://simplex.chat"
|
||||
parseMarkdown "https://simplex.chat site" `shouldBe` uri "https://simplex.chat" <> " site"
|
||||
parseMarkdown "SimpleX on GitHub: https://github.com/simplex-chat/" `shouldBe` "SimpleX on GitHub: " <> uri "https://github.com/simplex-chat/"
|
||||
parseMarkdown "SimpleX on GitHub: https://github.com/simplex-chat." `shouldBe` "SimpleX on GitHub: " <> uri "https://github.com/simplex-chat" <> "."
|
||||
parseMarkdown "https://github.com/simplex-chat/ - SimpleX on GitHub" `shouldBe` uri "https://github.com/simplex-chat/" <> " - SimpleX on GitHub"
|
||||
-- parseMarkdown "SimpleX on GitHub (https://github.com/simplex-chat/)" `shouldBe` "SimpleX on GitHub (" <> uri "https://github.com/simplex-chat/" <> ")"
|
||||
parseMarkdown "https://en.m.wikipedia.org/wiki/Servo_(software)" `shouldBe` uri "https://en.m.wikipedia.org/wiki/Servo_(software)"
|
||||
"https://simplex.chat" <==> uri "https://simplex.chat"
|
||||
"https://simplex.chat." <==> uri "https://simplex.chat" <> "."
|
||||
"https://simplex.chat, hello" <==> uri "https://simplex.chat" <> ", hello"
|
||||
"http://simplex.chat" <==> uri "http://simplex.chat"
|
||||
"this is https://simplex.chat" <==> "this is " <> uri "https://simplex.chat"
|
||||
"https://simplex.chat site" <==> uri "https://simplex.chat" <> " site"
|
||||
"SimpleX on GitHub: https://github.com/simplex-chat/" <==> "SimpleX on GitHub: " <> uri "https://github.com/simplex-chat/"
|
||||
"SimpleX on GitHub: https://github.com/simplex-chat." <==> "SimpleX on GitHub: " <> uri "https://github.com/simplex-chat" <> "."
|
||||
"https://github.com/simplex-chat/ - SimpleX on GitHub" <==> uri "https://github.com/simplex-chat/" <> " - SimpleX on GitHub"
|
||||
-- "SimpleX on GitHub (https://github.com/simplex-chat/)" <==> "SimpleX on GitHub (" <> uri "https://github.com/simplex-chat/" <> ")"
|
||||
"https://en.m.wikipedia.org/wiki/Servo_(software)" <==> uri "https://en.m.wikipedia.org/wiki/Servo_(software)"
|
||||
it "ignored as markdown" do
|
||||
parseMarkdown "_https://simplex.chat" `shouldBe` "_https://simplex.chat"
|
||||
parseMarkdown "this is _https://simplex.chat" `shouldBe` "this is _https://simplex.chat"
|
||||
"_https://simplex.chat" <==> "_https://simplex.chat"
|
||||
"this is _https://simplex.chat" <==> "this is _https://simplex.chat"
|
||||
it "SimpleX links" do
|
||||
let inv = "/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
|
||||
parseMarkdown ("https://simplex.chat" <> inv) `shouldBe` simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("https://simplex.chat" <> inv)
|
||||
parseMarkdown ("simplex:" <> inv) `shouldBe` simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("simplex:" <> inv)
|
||||
parseMarkdown ("https://example.com" <> inv) `shouldBe` simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("https://example.com" <> inv)
|
||||
("https://simplex.chat" <> inv) <==> simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("https://simplex.chat" <> inv)
|
||||
("simplex:" <> inv) <==> simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("simplex:" <> inv)
|
||||
("https://example.com" <> inv) <==> simplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"] ("https://example.com" <> inv)
|
||||
let ct = "/contact#/?v=2&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D"
|
||||
parseMarkdown ("https://simplex.chat" <> ct) `shouldBe` simplexLink XLContact ("simplex:" <> ct) ["smp.simplex.im"] ("https://simplex.chat" <> ct)
|
||||
("https://simplex.chat" <> ct) <==> simplexLink XLContact ("simplex:" <> ct) ["smp.simplex.im"] ("https://simplex.chat" <> ct)
|
||||
("simplex:" <> ct) <==> simplexLink XLContact ("simplex:" <> ct) ["smp.simplex.im"] ("simplex:" <> ct)
|
||||
let gr = "/contact#/?v=2&smp=smp%3A%2F%2Fu2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU%3D%40smp4.simplex.im%2FWHV0YU1sYlU7NqiEHkHDB6gxO1ofTync%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAWbebOqVYuBXaiqHcXYjEHCpYi6VzDlu6CVaijDTmsQU%253D%26srv%3Do5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion&data=%7B%22type%22%3A%22group%22%2C%22groupLinkId%22%3A%22mL-7Divb94GGmGmRBef5Dg%3D%3D%22%7D"
|
||||
parseMarkdown ("https://simplex.chat" <> gr) `shouldBe` simplexLink XLGroup ("simplex:" <> gr) ["smp4.simplex.im", "o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"] ("https://simplex.chat" <> gr)
|
||||
("https://simplex.chat" <> gr) <==> simplexLink XLGroup ("simplex:" <> gr) ["smp4.simplex.im", "o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"] ("https://simplex.chat" <> gr)
|
||||
("simplex:" <> gr) <==> simplexLink XLGroup ("simplex:" <> gr) ["smp4.simplex.im", "o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"] ("simplex:" <> gr)
|
||||
|
||||
email :: Text -> Markdown
|
||||
email = Markdown $ Just Email
|
||||
|
|
@ -173,15 +197,17 @@ email = Markdown $ Just Email
|
|||
textWithEmail :: Spec
|
||||
textWithEmail = describe "text with Email" do
|
||||
it "correct markdown" do
|
||||
parseMarkdown "chat@simplex.chat" `shouldBe` email "chat@simplex.chat"
|
||||
parseMarkdown "test chat@simplex.chat" `shouldBe` "test " <> email "chat@simplex.chat"
|
||||
parseMarkdown "test chat+123@simplex.chat" `shouldBe` "test " <> email "chat+123@simplex.chat"
|
||||
parseMarkdown "test chat.chat+123@simplex.chat" `shouldBe` "test " <> email "chat.chat+123@simplex.chat"
|
||||
parseMarkdown "chat@simplex.chat test" `shouldBe` email "chat@simplex.chat" <> " test"
|
||||
parseMarkdown "test1 chat@simplex.chat test2" `shouldBe` "test1 " <> email "chat@simplex.chat" <> " test2"
|
||||
"chat@simplex.chat" <==> email "chat@simplex.chat"
|
||||
"test chat@simplex.chat" <==> "test " <> email "chat@simplex.chat"
|
||||
"test chat+123@simplex.chat" <==> "test " <> email "chat+123@simplex.chat"
|
||||
"test chat.chat+123@simplex.chat" <==> "test " <> email "chat.chat+123@simplex.chat"
|
||||
"chat@simplex.chat test" <==> email "chat@simplex.chat" <> " test"
|
||||
"test1 chat@simplex.chat test2" <==> "test1 " <> email "chat@simplex.chat" <> " test2"
|
||||
it "ignored as markdown" do
|
||||
parseMarkdown "chat @simplex.chat" `shouldBe` "chat @simplex.chat"
|
||||
parseMarkdown "this is chat @simplex.chat" `shouldBe` "this is chat @simplex.chat"
|
||||
"chat @simplex.chat" <==> "chat " <> mention "simplex.chat" "@simplex.chat"
|
||||
"this is chat @simplex.chat" <==> "this is chat " <> mention "simplex.chat" "@simplex.chat"
|
||||
"this is chat@ simplex.chat" <==> "this is chat@ simplex.chat"
|
||||
"this is chat @ simplex.chat" <==> "this is chat @ simplex.chat"
|
||||
|
||||
phone :: Text -> Markdown
|
||||
phone = Markdown $ Just Phone
|
||||
|
|
@ -189,20 +215,35 @@ phone = Markdown $ Just Phone
|
|||
textWithPhone :: Spec
|
||||
textWithPhone = describe "text with Phone" do
|
||||
it "correct markdown" do
|
||||
parseMarkdown "07777777777" `shouldBe` phone "07777777777"
|
||||
parseMarkdown "test 07777777777" `shouldBe` "test " <> phone "07777777777"
|
||||
parseMarkdown "07777777777 test" `shouldBe` phone "07777777777" <> " test"
|
||||
parseMarkdown "test1 07777777777 test2" `shouldBe` "test1 " <> phone "07777777777" <> " test2"
|
||||
parseMarkdown "test 07777 777 777 test" `shouldBe` "test " <> phone "07777 777 777" <> " test"
|
||||
parseMarkdown "test +447777777777 test" `shouldBe` "test " <> phone "+447777777777" <> " test"
|
||||
parseMarkdown "test +44 (0) 7777 777 777 test" `shouldBe` "test " <> phone "+44 (0) 7777 777 777" <> " test"
|
||||
parseMarkdown "test +44-7777-777-777 test" `shouldBe` "test " <> phone "+44-7777-777-777" <> " test"
|
||||
parseMarkdown "test +44 (0) 7777.777.777 https://simplex.chat test"
|
||||
`shouldBe` "test " <> phone "+44 (0) 7777.777.777" <> " " <> uri "https://simplex.chat" <> " test"
|
||||
"07777777777" <==> phone "07777777777"
|
||||
"test 07777777777" <==> "test " <> phone "07777777777"
|
||||
"07777777777 test" <==> phone "07777777777" <> " test"
|
||||
"test1 07777777777 test2" <==> "test1 " <> phone "07777777777" <> " test2"
|
||||
"test 07777 777 777 test" <==> "test " <> phone "07777 777 777" <> " test"
|
||||
"test +447777777777 test" <==> "test " <> phone "+447777777777" <> " test"
|
||||
"test +44 (0) 7777 777 777 test" <==> "test " <> phone "+44 (0) 7777 777 777" <> " test"
|
||||
"test +44-7777-777-777 test" <==> "test " <> phone "+44-7777-777-777" <> " test"
|
||||
"test +44 (0) 7777.777.777 https://simplex.chat test"
|
||||
<==> "test " <> phone "+44 (0) 7777.777.777" <> " " <> uri "https://simplex.chat" <> " test"
|
||||
it "ignored as markdown (too short)" $
|
||||
parseMarkdown "test 077777 test" `shouldBe` "test 077777 test"
|
||||
"test 077777 test" <==> "test 077777 test"
|
||||
it "ignored as markdown (double spaces)" $
|
||||
parseMarkdown "test 07777 777 777 test" `shouldBe` "test 07777 777 777 test"
|
||||
"test 07777 777 777 test" <==> "test 07777 777 777 test"
|
||||
|
||||
mention :: Text -> Text -> Markdown
|
||||
mention = Markdown . Just . Mention
|
||||
|
||||
textWithMentions :: Spec
|
||||
textWithMentions = describe "text with mentions" do
|
||||
it "correct markdown" do
|
||||
"@alice" <==> mention "alice" "@alice"
|
||||
"hello @alice" <==> "hello " <> mention "alice" "@alice"
|
||||
"hello @alice !" <==> "hello " <> mention "alice" "@alice" <> " !"
|
||||
"@'alice jones'" <==> mention "alice jones" "@'alice jones'"
|
||||
"hello @'alice jones'!" <==> "hello " <> mention "alice jones" "@'alice jones'" <> "!"
|
||||
it "ignored as markdown" $ do
|
||||
"hello @'alice jones!" <==> "hello @'alice jones!"
|
||||
"hello @ alice!" <==> "hello @ alice!"
|
||||
|
||||
uri' :: Text -> FormattedText
|
||||
uri' = FormattedText $ Just Uri
|
||||
|
|
@ -210,15 +251,15 @@ uri' = FormattedText $ Just Uri
|
|||
multilineMarkdownList :: Spec
|
||||
multilineMarkdownList = describe "multiline markdown" do
|
||||
it "correct markdown" do
|
||||
parseMaybeMarkdownList "http://simplex.chat\nhttp://app.simplex.chat" `shouldBe` Just [uri' "http://simplex.chat", "\n", uri' "http://app.simplex.chat"]
|
||||
"http://simplex.chat\nhttp://app.simplex.chat" <<==>> [uri' "http://simplex.chat", "\n", uri' "http://app.simplex.chat"]
|
||||
it "combines the same formats" do
|
||||
parseMaybeMarkdownList "http://simplex.chat\ntext 1\ntext 2\nhttp://app.simplex.chat" `shouldBe` Just [uri' "http://simplex.chat", "\ntext 1\ntext 2\n", uri' "http://app.simplex.chat"]
|
||||
"http://simplex.chat\ntext 1\ntext 2\nhttp://app.simplex.chat" <<==>> [uri' "http://simplex.chat", "\ntext 1\ntext 2\n", uri' "http://app.simplex.chat"]
|
||||
it "no markdown" do
|
||||
parseMaybeMarkdownList "not a\nmarkdown" `shouldBe` Nothing
|
||||
let inv = "/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
|
||||
it "multiline with simplex link" do
|
||||
parseMaybeMarkdownList ("https://simplex.chat" <> inv <> "\ntext")
|
||||
`shouldBe` Just
|
||||
("https://simplex.chat" <> inv <> "\ntext")
|
||||
<<==>>
|
||||
[ FormattedText (Just $ SimplexLink XLInvitation ("simplex:" <> inv) ["smp.simplex.im"]) ("https://simplex.chat" <> inv),
|
||||
"\ntext"
|
||||
]
|
||||
|
|
|
|||
|
|
@ -116,10 +116,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))
|
||||
it "x.msg.new simple text - timed message TTL" $
|
||||
"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"ttl\":3600}}"
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing))
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") [] Nothing (Just 3600) Nothing))
|
||||
it "x.msg.new simple text - live message" $
|
||||
"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"live\":true}}"
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") [] Nothing Nothing (Just True)))
|
||||
it "x.msg.new simple link" $
|
||||
"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA", content = Nothing}) Nothing))
|
||||
|
|
@ -146,22 +146,22 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
##==## ChatMessage
|
||||
chatInitialVRange
|
||||
(Just $ SharedMsgId "\1\2\3\4")
|
||||
(XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing (Just 3600) Nothing)))
|
||||
(XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") [] Nothing (Just 3600) Nothing)))
|
||||
it "x.msg.new quote - live message" $
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"live\":true}}"
|
||||
##==## ChatMessage
|
||||
chatInitialVRange
|
||||
(Just $ SharedMsgId "\1\2\3\4")
|
||||
(XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing Nothing (Just True))))
|
||||
(XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") [] Nothing Nothing (Just True))))
|
||||
it "x.msg.new forward" $
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}"
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") Nothing))
|
||||
it "x.msg.new forward - timed message TTL" $
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"ttl\":3600}}"
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing (Just 3600) Nothing))
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") [] Nothing (Just 3600) Nothing))
|
||||
it "x.msg.new forward - live message" $
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"live\":true}}"
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") [] Nothing Nothing (Just True)))
|
||||
it "x.msg.new simple text with file" $
|
||||
"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
|
||||
|
|
@ -193,7 +193,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
|
||||
it "x.msg.update" $
|
||||
"{\"v\":\"1\",\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
#==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing
|
||||
#==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") [] Nothing Nothing
|
||||
it "x.msg.del" $
|
||||
"{\"v\":\"1\",\"event\":\"x.msg.del\",\"params\":{\"msgId\":\"AQIDBA==\"}}"
|
||||
#==# XMsgDel (SharedMsgId "\1\2\3\4") Nothing
|
||||
|
|
|
|||
|
|
@ -158,8 +158,8 @@ saveQueryPlans = it "verify and overwrite query plans" $ \TestParams {chatQueryS
|
|||
agentQueryStats
|
||||
(createAgentStore (DBOpts testAgentDB "" False True TQOff) MCError)
|
||||
(const $ pure ())
|
||||
chatSavedPlans' `shouldBe` chatSavedPlans
|
||||
agentSavedPlans' `shouldBe` agentSavedPlans
|
||||
chatSavedPlans' == chatSavedPlans `shouldBe` True
|
||||
agentSavedPlans' == agentSavedPlans `shouldBe` True
|
||||
removeFile testDB
|
||||
removeFile testAgentDB
|
||||
where
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ testMkValidName = do
|
|||
mkValidName "J . . Doe" `shouldBe` "J . Doe"
|
||||
mkValidName "@alice" `shouldBe` "alice"
|
||||
mkValidName "#alice" `shouldBe` "alice"
|
||||
mkValidName "'alice" `shouldBe` "alice"
|
||||
mkValidName " alice" `shouldBe` "alice"
|
||||
mkValidName "alice " `shouldBe` "alice"
|
||||
mkValidName "John Doe" `shouldBe` "John Doe"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue