From 181323ce13b069253412ff68bbe32621c6dcc525 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 11 Sep 2023 09:08:50 +0100
Subject: [PATCH 01/17] ios: update team ID in Apple .well-known site
associations
---
website/src/.well-known/apple-app-site-association/index.json | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/website/src/.well-known/apple-app-site-association/index.json b/website/src/.well-known/apple-app-site-association/index.json
index 956e006f25..3cd3fdd043 100644
--- a/website/src/.well-known/apple-app-site-association/index.json
+++ b/website/src/.well-known/apple-app-site-association/index.json
@@ -3,7 +3,7 @@
"details": [
{
"appIDs": [
- "5NN7GUYB6.chat.simplex.app"
+ "5NN7GUYB6T.chat.simplex.app"
],
"components": [
{
From 5fddf64adb51f86fe8a8fb26e0cb8970dc8b7847 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Mon, 11 Sep 2023 18:38:57 +0400
Subject: [PATCH 02/17] core: direct messages in group (#2994)
---
simplex-chat.cabal | 1 +
src/Simplex/Chat.hs | 585 +++++++++++-------
src/Simplex/Chat/Bot.hs | 2 +-
src/Simplex/Chat/Controller.hs | 51 +-
src/Simplex/Chat/Messages.hs | 79 ++-
.../M20230904_item_direct_group_member_id.hs | 24 +
src/Simplex/Chat/Migrations/chat_schema.sql | 7 +-
src/Simplex/Chat/Protocol.hs | 39 +-
src/Simplex/Chat/Store/Messages.hs | 154 +++--
src/Simplex/Chat/Store/Migrations.hs | 4 +-
src/Simplex/Chat/Terminal/Input.hs | 18 +-
src/Simplex/Chat/Terminal/Output.hs | 2 +-
src/Simplex/Chat/Types.hs | 4 +-
src/Simplex/Chat/View.hs | 123 ++--
tests/ChatClient.hs | 2 +-
tests/ChatTests/Groups.hs | 577 ++++++++++++++++-
tests/ChatTests/Utils.hs | 23 +-
tests/ProtocolTests.hs | 31 +-
18 files changed, 1298 insertions(+), 428 deletions(-)
create mode 100644 src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index ebd3d1d646..35e01e7bca 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -111,6 +111,7 @@ library
Simplex.Chat.Migrations.M20230827_file_encryption
Simplex.Chat.Migrations.M20230829_connections_chat_vrange
Simplex.Chat.Migrations.M20230903_connections_to_subscribe
+ Simplex.Chat.Migrations.M20230904_item_direct_group_member_id
Simplex.Chat.Mobile
Simplex.Chat.Mobile.File
Simplex.Chat.Mobile.Shared
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 49c5fc94ed..9522d22180 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -540,8 +540,8 @@ processChatCommand = \case
memStatuses -> pure $ Just $ map (uncurry MemberDeliveryStatus) memStatuses
_ -> pure Nothing
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses}
- APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
- CTDirect -> do
+ APISendMessage sendRef live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case sendRef of
+ SRDirect chatId -> do
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
assertDirectAllowed user MDSnd ct XMsgNew_
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
@@ -567,7 +567,7 @@ processChatCommand = \case
(fileSize, fileMode) <- checkSndFile mc file 1
case fileMode of
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
- SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ CGContact ct
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ SDDirect ct
where
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
@@ -590,36 +590,38 @@ processChatCommand = \case
pure (fileInvitation, ciFile, ft)
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
prepareMsg fInv_ timed_ = case quotedItemId_ of
- Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
+ Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) Nothing), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getDirectChatItem db user chatId quotedItemId
(origQmc, qd, sent) <- quoteData qci
- let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
+ let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing, msgScope = Nothing}
qmc = quoteContent 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)
+ pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) Nothing), Just quotedItem)
where
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True)
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
quoteData _ = throwChatError CEInvalidQuote
- CTGroup -> do
- g@(Group gInfo _) <- withStore $ \db -> getGroup db user chatId
- assertUserGroupRole gInfo GRAuthor
- send g
+ SRGroup chatId directMemberId -> do
+ gInfo <- withStore $ \db -> getGroupInfo db user chatId
+ directMember <- forM directMemberId $ \dmId -> withStore $ \db -> getGroupMember db user chatId dmId
+ assertGroupSendAllowed gInfo directMember
+ send gInfo directMember
where
- send g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms)
+ send gInfo@GroupInfo {groupId, membership, localDisplayName = gName} directMember
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
| otherwise = do
- (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
+ ms <- getReceivingMembers user gInfo directMember
+ (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo ms (length ms)
timed_ <- sndGroupCITimed live gInfo itemTTL
- (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
+ (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership directMember
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
- ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
+ ci <- saveSndChatItem' user (CDGroupSnd gInfo directMember) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
withStore' $ \db ->
forM_ sentToMembers $ \GroupMember {groupMemberId} ->
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
@@ -628,12 +630,12 @@ processChatCommand = \case
setActive $ ActiveG gName
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
- setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
- setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
+ setupSndFileTransfer :: GroupInfo -> [GroupMember] -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
+ setupSndFileTransfer gInfo ms n = forM file_ $ \file -> do
(fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n
case fileMode of
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
- SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup g
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ SDGroup gInfo ms
where
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
@@ -657,25 +659,44 @@ processChatCommand = \case
void . withStore' $ \db -> createSndGroupInlineFT db m conn ft
sendMemberFileInline m conn ft sharedMsgId
processMember _ = pure ()
- prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
- prepareMsg fInv_ timed_ membership = case quotedItemId_ of
- Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
+ prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> Maybe GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
+ prepareMsg fInv_ timed_ membership directMember = case quotedItemId_ of
+ Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) (Just msgScope)), Nothing)
Just quotedItemId -> do
- CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
+ CChatItem _ qci@ChatItem {chatDir = quoteChatDir, meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
- (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
- let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
+ let qMsgScope = directMemberToMsgScope $ ciDirDirectMember quoteChatDir
+ (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership qMsgScope
+ let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId, msgScope = Just qMsgScope}
qmc = quoteContent 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)
+ quotedItem = CIQuote {chatDir = qd, itemId = Just $ chatItemId' qci, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
+ pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) (Just msgScope)), Just quotedItem)
where
- quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
- quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
- 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
- CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
- CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
+ msgScope = directMemberToMsgScope directMember
+ quoteData :: ChatItem c d -> GroupMember -> MessageScope -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
+ quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ _ =
+ throwChatError CEInvalidQuote
+ quoteData ChatItem {chatDir = qChatDir@(CIGroupSnd _), content = CISndMsgContent qmc} membership' qMsgScope =
+ checkDirDirectMember qChatDir $ pure (qmc, CIQGroupSnd qMsgScope, True, membership')
+ quoteData ChatItem {chatDir = qChatDir@(CIGroupRcv m _), content = CIRcvMsgContent qmc} _ qMsgScope =
+ checkDirDirectMember qChatDir $ pure (qmc, CIQGroupRcv (Just m) qMsgScope, False, m)
+ quoteData _ _ _ =
+ throwChatError CEInvalidQuote
+ -- can quote:
+ -- - group message to group (Nothing, Nothing)
+ -- - group message to direct member (Nothing, Just)
+ -- - direct message to the same direct member (Just, Just, same Id)
+ -- can't quote:
+ -- - direct message to group (Just, Nothing)
+ -- - direct message to another direct member (Just, Just, different Id)
+ checkDirDirectMember :: CIDirection 'CTGroup d -> m a -> m a
+ checkDirDirectMember quoteChatDir a = case (ciDirDirectMember quoteChatDir, directMember) of
+ (Nothing, Nothing) -> a
+ (Nothing, Just _) -> a
+ (Just _, Nothing) -> throwChatError CEInvalidQuote
+ (Just GroupMember {groupMemberId = dirDirectMemId}, Just GroupMember {groupMemberId = directMemId})
+ | directMemId == dirDirectMemId -> a
+ | otherwise -> throwChatError CEInvalidQuote
where
quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
quoteContent qmc ciFile_
@@ -700,8 +721,8 @@ processChatCommand = \case
qText = msgContentText qmc
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
qTextOrFile = if T.null qText then qFileName else qText
- xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
- xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
+ xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> SendDirection -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
+ xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n sendDirection = do
let fileName = takeFileName filePath
fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
fInv = xftpFileInvitation fileName fileSize fileDescr
@@ -710,19 +731,20 @@ processChatCommand = \case
aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) srcFile (roundedFDCount n)
-- TODO CRSndFileStart event for XFTP
chSize <- asks $ fileChunkSize . config
+ let contactOrGroup = sendDirToContactOrGroup sendDirection
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv (AgentSndFileId aFileId) chSize
let fileSource = Just $ CryptoFile filePath cfArgs
ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP}
- case contactOrGroup of
- CGContact Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr
- CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CRChatError (Just user))
- where
- -- we are not sending files to pending members, same as with inline files
- saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
- when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $
- withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr
- saveMemberFD _ = pure ()
+ case sendDirection of
+ SDDirect Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr
+ SDGroup _ ms -> forM_ ms $ \m -> saveMemberFD ft fileDescr m `catchChatError` (toView . CRChatError (Just user))
pure (fInv, ciFile, ft)
+ where
+ -- we are not sending files to pending members, same as with inline files
+ saveMemberFD ft fileDescr m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
+ when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $
+ withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr
+ saveMemberFD _ _ _ = pure ()
unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c)
unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c)
unzipMaybe3 _ = (Nothing, Nothing, Nothing)
@@ -750,28 +772,28 @@ processChatCommand = \case
_ -> throwChatError CEInvalidChatItemUpdate
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
CTGroup -> do
- Group gInfo@GroupInfo {groupId, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
- assertUserGroupRole gInfo GRAuthor
- cci <- withStore $ \db -> getGroupChatItem db user chatId itemId
- case cci of
- CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do
- case (ciContent, itemSharedMsgId, editable) of
- (CISndMsgContent oldMC, Just itemSharedMId, True) -> do
- 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))
- ci' <- withStore' $ \db -> do
- currentTs <- liftIO getCurrentTime
- when changed $
- addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
- updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
- startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
- setActive $ ActiveG gName
- 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
+ aci <- withStore $ \db -> getAChatItem db user (ChatRef CTGroup chatId) itemId
+ case aci of
+ AChatItem _ _ (GroupChat gInfo) ci@ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, editable = True}, content = CISndMsgContent oldMC} -> do
+ let GroupInfo {groupId, localDisplayName = gName} = gInfo
+ ChatItem {meta = CIMeta {itemTimed, itemLive}} = ci
+ changed = mc /= oldMC
+ if changed || fromMaybe False itemLive
+ then do
+ (ms, directMember') <- getReceivingMembers' user gInfo directMember
+ assertGroupSendAllowed gInfo directMember'
+ let msg = XMsgUpdate sharedMsgId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)
+ (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms msg
+ ci' <- withStore' $ \db -> do
+ currentTs <- liftIO getCurrentTime
+ when changed $
+ addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
+ updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
+ startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
+ setActive $ ActiveG gName
+ pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci')
+ else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
+ _ -> throwChatError CEInvalidChatItemUpdate
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of
@@ -788,22 +810,25 @@ processChatCommand = \case
else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime
(CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
CTGroup -> do
- Group gInfo ms <- withStore $ \db -> getGroup db user chatId
- ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}}) <- withStore $ \db -> getGroupChatItem db user chatId itemId
- case (mode, msgDir, itemSharedMsgId, editable) of
- (CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime
- (CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do
- assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
- (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
- delGroupChatItem user gInfo ci msgId Nothing
- (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
+ aci <- withStore $ \db -> getAChatItem db user (ChatRef CTGroup chatId) itemId
+ case (mode, aci) of
+ (CIDMInternal, AChatItem _ md (GroupChat gInfo) ci) -> do
+ let cci = CChatItem md ci
+ deleteGroupCI user gInfo cci True False Nothing =<< liftIO getCurrentTime
+ (CIDMBroadcast, AChatItem _ _ (GroupChat gInfo) ci@ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, editable = True}}) -> do
+ assertUserMembershipStatus gInfo -- can delete messages sent earlier in any role
+ (ms, _) <- getReceivingMembers' user gInfo directMember
+ (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel sharedMsgId Nothing
+ let cci = CChatItem SMDSnd ci
+ delGroupChatItem user gInfo cci msgId Nothing
+ _ -> throwChatError CEInvalidChatItemDelete
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do
Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db user gId
ci@(CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user gId itemId
case (chatDir, itemSharedMsgId) of
- (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do
+ (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId} MSGroup, Just itemSharedMId) -> do
when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete
assertUserGroupRole gInfo $ max GRAdmin memberRole
(SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId
@@ -829,13 +854,15 @@ processChatCommand = \case
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
CTGroup ->
- withStore (\db -> (,) <$> getGroup db user chatId <*> getGroupChatItem db user chatId itemId) >>= \case
- (Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
+ withStore (\db -> getAChatItem db user (ChatRef CTGroup chatId) itemId) >>= \case
+ (AChatItem _ md (GroupChat g@GroupInfo {membership}) ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (groupFeatureAllowed SGFReactions g) $
throwChatError $ CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)
unless (ciReactionAllowed ci) $
throwChatError $ CECommandError "reaction not allowed - chat item has no content"
let GroupMember {memberId = itemMemberId} = chatItemMember g ci
+ directMember = ciDirDirectMember chatDir
+ (ms, _) <- getReceivingMembers' user g directMember
rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True
checkReactionAllowed rs
(SndMessage {msgId}, _) <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add)
@@ -844,7 +871,7 @@ processChatCommand = \case
setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt
liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId
let ci' = CChatItem md ci {reactions}
- r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction
+ r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction (CIGroupSnd directMember) ci' createdAt reaction
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
@@ -1208,7 +1235,7 @@ processChatCommand = \case
case memberConnId m of
Just connId -> do
cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId force
- createInternalChatItem user (CDGroupSnd g) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing
+ createInternalChatItem user (CDGroupSnd g Nothing) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing
pure $ CRGroupMemberRatchetSyncStarted user g m cStats
_ -> throwChatError CEGroupMemberNotActive
APIGetContactCode contactId -> withUser $ \user -> do
@@ -1368,8 +1395,8 @@ processChatCommand = \case
RejectContact cName -> withUser $ \User {userId} -> do
connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
processChatCommand $ APIRejectContact connReqId
- SendMessage chatName msg -> sendTextMessage chatName msg False
- SendLiveMessage chatName msg -> sendTextMessage chatName msg True
+ SendMessage sendName msg -> sendTextMessage sendName msg False
+ SendLiveMessage sendName msg -> sendTextMessage sendName msg True
SendMessageBroadcast msg -> withUser $ \user -> do
contacts <- withStore' (`getUserContacts` user)
let cts = filter (\ct -> isReady ct && directOrUsed ct) contacts
@@ -1389,7 +1416,7 @@ processChatCommand = \case
contactId <- withStore $ \db -> getContactIdByName db user cName
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
let mc = MCText msg
- processChatCommand . APISendMessage (ChatRef CTDirect contactId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
+ processChatCommand . APISendMessage (SRDirect contactId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
DeleteMessage chatName deletedMsg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
@@ -1403,10 +1430,10 @@ processChatCommand = \case
editedItemId <- getSentChatItemIdByText user chatRef editedMsg
let mc = MCText msg
processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc
- UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do
- chatRef <- getChatRef user chatName
+ UpdateLiveMessage sendName chatItemId live msg -> withUser $ \user -> do
+ sendRef <- getSendRef user sendName
let mc = MCText msg
- processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc
+ processChatCommand $ APIUpdateChatItem (sendToChatRef sendRef) chatItemId live mc
ReactToMessage add reaction chatName msg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
chatItemId <- getChatItemIdByText user chatRef msg
@@ -1491,7 +1518,7 @@ processChatCommand = \case
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
_ -> do
(msg, _) <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole
- ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
+ ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndGroupEvent gEvent)
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
APIRemoveMember groupId memberId -> withUser $ \user -> do
@@ -1507,7 +1534,7 @@ processChatCommand = \case
withStore' $ \db -> deleteGroupMember db user m
_ -> do
(msg, _) <- sendGroupMessage user gInfo members $ XGrpMemDel mId
- ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
+ ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
deleteMemberConnection user m
-- undeleted "member connected" chat item will prevent deletion of member record
@@ -1517,7 +1544,7 @@ processChatCommand = \case
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
withChatLock "leaveGroup" . procCmd $ do
(msg, _) <- sendGroupMessage user gInfo members XGrpLeave
- ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
+ ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndGroupEvent SGEUserLeft)
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
-- TODO delete direct connections that were unused
deleteGroupLinkIfExists user gInfo
@@ -1600,11 +1627,13 @@ processChatCommand = \case
ShowGroupLink gName -> withUser $ \user -> do
groupId <- withStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APIGetGroupLink groupId
- SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
+ SendGroupMessageQuote gName cName directMemberName quotedMsg msg -> withUser $ \user -> do
groupId <- withStore $ \db -> getGroupIdByName db user gName
+ directMemberId <- forM directMemberName $ \dmn -> withStore $ \db -> getGroupMemberIdByName db user groupId dmn
quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg
- let mc = MCText msg
- processChatCommand . APISendMessage (ChatRef CTGroup groupId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
+ let sendRef = SRGroup groupId directMemberId
+ mc = MCText msg
+ processChatCommand . APISendMessage sendRef False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
LastChats count_ -> withUser' $ \user -> do
chats <- withStore' $ \db -> getChatPreviews db user False
pure $ CRChats $ maybe id take count_ chats
@@ -1637,19 +1666,19 @@ processChatCommand = \case
processChatCommand $ APIGetChatItemInfo chatRef itemId
ShowLiveItems on -> withUser $ \_ ->
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
- SendFile chatName f -> withUser $ \user -> do
- chatRef <- getChatRef user chatName
- processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCFile "")
- SendImage chatName f -> withUser $ \user -> do
- chatRef <- getChatRef user chatName
+ SendFile sendName f -> withUser $ \user -> do
+ sendRef <- getSendRef user sendName
+ processChatCommand . APISendMessage sendRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCFile "")
+ SendImage sendName f -> withUser $ \user -> do
+ sendRef <- getSendRef user sendName
filePath <- toFSFilePath f
unless (any (`isSuffixOf` map toLower f) imageExtensions) $ throwChatError CEFileImageType {filePath}
fileSize <- getFileSize filePath
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
-- TODO include file description for preview
- processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCImage "" fixedImagePreview)
- ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
- ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
+ processChatCommand . APISendMessage sendRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCImage "" fixedImagePreview)
+ ForwardFile sendName fileId -> forwardFile sendName fileId SendFile
+ ForwardImage sendName fileId -> forwardFile sendName fileId SendImage
SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
ReceiveFile fileId encrypted rcvInline_ filePath_ -> withUser $ \_ ->
withChatLock "receiveFile" . procCmd $ do
@@ -1673,7 +1702,7 @@ processChatCommand = \case
(_, RcvFileTransfer {xftpRcvFile = f}) <- withStore (`getRcvFileTransferById` fileId)
unless (isJust f) $ throwChatError $ CEFileInternal "locally encrypted files can't be received via SMP"
liftIO $ Just <$> CF.randomArgs
- CancelFile fileId -> withUser $ \user@User {userId} ->
+ CancelFile fileId -> withUser $ \user ->
withChatLock "cancelFile" . procCmd $
withStore (\db -> getFileTransfer db user fileId) >>= \case
FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts
@@ -1683,20 +1712,22 @@ processChatCommand = \case
| otherwise -> do
fileAgentConnIds <- cancelSndFile user ftm fts True
deleteAgentConnectionsAsync user fileAgentConnIds
- sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
- withStore (\db -> getChatRefByFileId db user fileId) >>= \case
- ChatRef CTDirect contactId -> do
- contact <- withStore $ \db -> getContact db user contactId
- void . sendDirectContactMessage contact $ XFileCancel sharedMsgId
- ChatRef CTGroup groupId -> do
- Group gInfo ms <- withStore $ \db -> getGroup db user groupId
- void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId
- _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
- ci <- withStore $ \db -> getChatItemByFileId db user fileId
- pure $ CRSndFileCancelled user ci ftm fts
+ sendXFileCancel
+ ci' <- withStore $ \db -> getChatItemByFileId db user fileId
+ pure $ CRSndFileCancelled user ci' ftm fts
where
fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} =
s == FSCancelled || (s == FSComplete && isNothing xftpSndFile)
+ sendXFileCancel :: m ()
+ sendXFileCancel = do
+ ci <- withStore $ \db -> getChatItemByFileId db user fileId
+ case ci of
+ (AChatItem _ _ (DirectChat ct) ChatItem {chatDir = CIDirectSnd, meta = CIMeta {itemSharedMsgId = Just sharedMsgId}}) ->
+ void $ sendDirectContactMessage ct (XFileCancel sharedMsgId)
+ (AChatItem _ _ (GroupChat gInfo) ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId}}) -> do
+ (ms, _) <- getReceivingMembers' user gInfo directMember
+ void $ sendGroupMessage user gInfo ms (XFileCancel sharedMsgId)
+ _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
FTRcv ftr@RcvFileTransfer {cancelled, fileStatus, xftpRcvFile}
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
| rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete"
@@ -1811,6 +1842,15 @@ processChatCommand = \case
CTDirect -> withStore $ \db -> getContactIdByName db user name
CTGroup -> withStore $ \db -> getGroupIdByName db user name
_ -> throwChatError $ CECommandError "not supported"
+ getSendRef :: User -> SendName -> m SendRef
+ getSendRef user sendName = case sendName of
+ SNDirect name -> SRDirect <$> withStore (\db -> getContactIdByName db user name)
+ SNGroup name directMemberName -> do
+ (gId, dmId) <- withStore $ \db -> do
+ gId <- getGroupIdByName db user name
+ dmId <- forM directMemberName $ \dmn -> getGroupMemberIdByName db user gId dmn
+ pure (gId, dmId)
+ pure $ SRGroup gId dmId
checkChatStopped :: m ChatResponse -> m ChatResponse
checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
setStoreChanged :: m ()
@@ -1943,15 +1983,29 @@ processChatCommand = \case
assertUserGroupRole g GROwner
g' <- withStore $ \db -> updateGroupProfile db user g p'
(msg, _) <- sendGroupMessage user g' ms (XGrpInfo p')
- let cd = CDGroupSnd g'
+ let cd = CDGroupSnd g' Nothing
unless (sameGroupProfileInfo p p') $ do
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p')
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat g') ci)
createGroupFeatureChangedItems user cd CISndGroupFeature g g'
pure $ CRGroupUpdated user g g' Nothing
+ assertGroupSendAllowed :: GroupInfo -> Maybe GroupMember -> m ()
+ assertGroupSendAllowed
+ gInfo@GroupInfo {membership = GroupMember {memberRole = userRole}}
+ (Just GroupMember {memberRole = directMemberRole, activeConn = Just Connection {peerChatVRange}}) = do
+ unless (isCompatibleRange peerChatVRange groupPrivateMessagesVRange) $ throwChatError CEPeerChatVRangeIncompatible
+ if
+ | userRole >= GRAdmin || directMemberRole >= GRAdmin -> assertUserMembershipStatus gInfo
+ | not (groupFeatureAllowed SGFDirectMessages gInfo) -> throwChatError $ CECommandError "direct messages not allowed"
+ | otherwise -> assertUserGroupRole gInfo GRAuthor
+ assertGroupSendAllowed _ (Just GroupMember {activeConn = Nothing}) = throwChatError CEGroupMemberNotActive
+ assertGroupSendAllowed gInfo Nothing = assertUserGroupRole gInfo GRAuthor
assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m ()
assertUserGroupRole g@GroupInfo {membership} requiredRole = do
when (memberRole (membership :: GroupMember) < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole
+ assertUserMembershipStatus g
+ assertUserMembershipStatus :: GroupInfo -> m ()
+ assertUserMembershipStatus g@GroupInfo {membership} = do
when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
@@ -1996,14 +2050,14 @@ processChatCommand = \case
withServerProtocol p action = case userProtocol p of
Just Dict -> action
_ -> throwChatError $ CEServerProtocol $ AProtocolType p
- forwardFile :: ChatName -> FileTransferId -> (ChatName -> FilePath -> ChatCommand) -> m ChatResponse
- forwardFile chatName fileId sendCommand = withUser $ \user -> do
+ forwardFile :: SendName -> FileTransferId -> (SendName -> FilePath -> ChatCommand) -> m ChatResponse
+ forwardFile sendName fileId sendCommand = withUser $ \user -> do
withStore (\db -> getFileTransfer db user fileId) >>= \case
FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> forward filePath
FTSnd {fileTransferMeta = FileTransferMeta {filePath}} -> forward filePath
_ -> throwChatError CEFileNotReceived {fileId}
where
- forward = processChatCommand . sendCommand chatName
+ forward = processChatCommand . sendCommand sendName
getGroupAndMemberId :: User -> GroupName -> ContactName -> m (GroupId, GroupMemberId)
getGroupAndMemberId user gName groupMemberName =
withStore $ \db -> do
@@ -2019,10 +2073,10 @@ processChatCommand = \case
ci <- saveSndChatItem user (CDDirectSnd ct) msg content
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
setActive $ ActiveG localDisplayName
- sendTextMessage chatName msg live = withUser $ \user -> do
- chatRef <- getChatRef user chatName
+ sendTextMessage sendName msg live = withUser $ \user -> do
+ sendRef <- getSendRef user sendName
let mc = MCText msg
- processChatCommand . APISendMessage chatRef live Nothing $ ComposedMessage Nothing Nothing mc
+ processChatCommand . APISendMessage sendRef live Nothing $ ComposedMessage Nothing Nothing mc
sndContactCITimed :: Bool -> Contact -> Maybe Int -> m (Maybe CITimed)
sndContactCITimed live = sndCITimed_ live . contactTimedTTL
sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> m (Maybe CITimed)
@@ -2094,6 +2148,26 @@ processChatCommand = \case
_ -> throwChatError $ CECommandError "not supported"
processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings
+getReceivingMembers :: ChatMonad m => User -> GroupInfo -> Maybe GroupMember -> m [GroupMember]
+getReceivingMembers user gInfo directMember = do
+ ms <- case directMember of
+ Nothing -> withStore' $ \db -> getGroupMembers db user gInfo
+ Just dm -> pure [dm]
+ pure $ filter memberCurrent ms
+
+-- use in contexts where directMember is retrieved via chat item direction:
+-- when reading chat item member is loaded w/t connection
+getReceivingMembers' :: ChatMonad m => User -> GroupInfo -> Maybe GroupMember -> m ([GroupMember], Maybe GroupMember)
+getReceivingMembers' user gInfo@GroupInfo {groupId} directMember = do
+ (ms, dm) <- case directMember of
+ Nothing -> do
+ ms <- withStore' $ \db -> getGroupMembers db user gInfo
+ pure (ms, Nothing)
+ Just GroupMember {groupMemberId} -> do
+ dm <- withStore $ \db -> getGroupMember db user groupId groupMemberId
+ pure ([dm], Just dm)
+ pure (filter memberCurrent ms, dm)
+
assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m ()
assertDirectAllowed user dir ct event =
unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $
@@ -2312,7 +2386,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
)
receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> RcvFileDescr -> Maybe CryptoFileArgs -> m ()
-receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} cfArgs =
+receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} cfArgs = do
when fileDescrComplete $ do
rd <- parseFileDescription fileDescrText
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs
@@ -2749,45 +2823,46 @@ processAgentMsgSndFile _corrId aFileId msg =
toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal
SFDONE sndDescr rfds -> do
withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr)
- ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <-
- withStore $ \db -> getChatItemByFileId db user fileId
- case (msgId_, itemDeleted) of
- (Just sharedMsgId, Nothing) -> do
+ ci <- withStore $ \db -> getChatItemByFileId db user fileId
+ case (rfds, sfts, ci) of
+ (rfd : extraRFDs, [sft], AChatItem _ _ (DirectChat ct) ChatItem {chatDir = CIDirectSnd, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, itemDeleted = Nothing}}) -> do
+ checkStart ci
+ withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
+ msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+ withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
+ withAgent (`xftpDeleteSndFileInternal` aFileId)
+ (_, _, AChatItem _ _ (GroupChat gInfo) ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, itemDeleted = Nothing}}) -> do
+ checkStart ci
+ (ms, _) <- getReceivingMembers' user gInfo directMember
+ let rfdsMemberFTs = zip rfds $ memberFTs ms
+ extraRFDs = drop (length rfdsMemberFTs) rfds
+ withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
+ forM_ rfdsMemberFTs $ \mt -> sendToMember gInfo mt `catchChatError` (toView . CRChatError (Just user))
+ ci' <- withStore $ \db -> do
+ liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
+ getChatItemByFileId db user fileId
+ withAgent (`xftpDeleteSndFileInternal` aFileId)
+ toView $ CRSndFileCompleteXFTP user ci' ft
+ where
+ memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
+ memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
+ where
+ mConns' = mapMaybe useMember ms
+ sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
+ useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
+ | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
+ | otherwise = Nothing
+ useMember _ = Nothing
+ sendToMember :: GroupInfo -> (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
+ sendToMember GroupInfo {groupId} (rfd, (conn, sft)) =
+ void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
+ _ -> throwChatError $ CEInternalError "invalid XFTP file transfer"
+ where
+ checkStart :: AChatItem -> m ()
+ checkStart ci = do
when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
-- TODO either update database status or move to SFPROG
toView $ CRSndFileProgressXFTP user ci ft 1 1
- case (rfds, sfts, d, cInfo) of
- (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do
- withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
- msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
- withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
- withAgent (`xftpDeleteSndFileInternal` aFileId)
- (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
- ms <- withStore' $ \db -> getGroupMembers db user g
- let rfdsMemberFTs = zip rfds $ memberFTs ms
- extraRFDs = drop (length rfdsMemberFTs) rfds
- withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
- forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchChatError` (toView . CRChatError (Just user))
- ci' <- withStore $ \db -> do
- liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
- getChatItemByFileId db user fileId
- withAgent (`xftpDeleteSndFileInternal` aFileId)
- toView $ CRSndFileCompleteXFTP user ci' ft
- where
- memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
- memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
- where
- mConns' = mapMaybe useMember ms
- sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
- useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
- | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
- | otherwise = Nothing
- useMember _ = Nothing
- sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
- sendToMember (rfd, (conn, sft)) =
- void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
- _ -> pure ()
- _ -> pure () -- TODO error?
SFERR e
| temporaryAgentError e ->
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
@@ -3123,7 +3198,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile groupLinkId
(_msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv
-- we could link chat item with sent group invitation message (_msg)
- createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
CONF confId _ connInfo -> do
@@ -3212,10 +3287,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let m' = m {activeConn = Just conn'} :: GroupMember
updateChatLock "groupMessage" event
case event of
- XMsgNew mc -> canSend m' $ newGroupContentMessage gInfo m' mc msg msgMeta
- XMsgFileDescr sharedMsgId fileDescr -> canSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr msgMeta
+ XMsgNew mc -> newGroupContentMessage gInfo m' mc msg msgMeta
+ XMsgFileDescr sharedMsgId fileDescr -> groupMessageFileDescription gInfo m' sharedMsgId fileDescr msgMeta
XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m' sharedMsgId msgMeta
- XMsgUpdate sharedMsgId mContent ttl live -> canSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg msgMeta ttl live
+ XMsgUpdate sharedMsgId mContent ttl live -> groupMessageUpdate gInfo m' sharedMsgId mContent msg msgMeta ttl live
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg msgMeta
XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg msgMeta
-- TODO discontinue XFile
@@ -3239,10 +3314,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
fromMaybe (sendRcptsSmallGroups user) sendRcpts
&& hasDeliveryReceipt (toCMEventTag event)
&& currentMemCount <= smallGroupsRcptsMemLimit
- where
- canSend mem a
- | memberRole (mem :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages"
- | otherwise = a
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId conn msgMeta $
groupMsgReceived gInfo m conn msgMeta msgRcpt
@@ -3253,8 +3324,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
SWITCH qd phase cStats -> do
toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
- QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
- QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
+ QDRcv -> createInternalChatItem user (CDGroupSnd gInfo Nothing) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
+ QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
RSYNC rss cryptoErr_ cStats ->
case (rss, connectionCode, cryptoErr_) of
(RSRequired, _, Just cryptoErr) -> processErr cryptoErr
@@ -3264,7 +3335,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let m' = m {activeConn = Just (conn {connectionCode = Nothing} :: Connection)} :: GroupMember
ratchetSyncEventItem m'
toView $ CRGroupMemberVerificationReset user gInfo m'
- createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent RCEVerificationCodeReset) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m' MSGroup) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
_ -> ratchetSyncEventItem m
where
processErr cryptoErr = do
@@ -3278,10 +3349,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
_ -> do
toView $ CRGroupMemberRatchetSync user gInfo m (RatchetSyncProgress rss cStats)
- createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvDecryptionError mde n) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvDecryptionError mde n) Nothing
ratchetSyncEventItem m' = do
toView $ CRGroupMemberRatchetSync user gInfo m' (RatchetSyncProgress rss cStats)
- createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent $ RCERatchetSync rss) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m' MSGroup) (CIRcvConnEvent $ RCERatchetSync rss) Nothing
OK ->
-- [async agent commands] continuation on receiving OK
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} ->
@@ -3578,11 +3649,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
memberConnectedChatItem :: GroupInfo -> GroupMember -> m ()
memberConnectedChatItem gInfo m =
-- ts should be broker ts but we don't have it for CON
- createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEMemberConnected) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvGroupEvent RGEMemberConnected) Nothing
groupDescriptionChatItem :: GroupInfo -> GroupMember -> Text -> m ()
groupDescriptionChatItem gInfo m descr =
- createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvMsgContent $ MCText descr) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvMsgContent $ MCText descr) Nothing
notifyMemberConnected :: GroupInfo -> GroupMember -> Maybe Contact -> m ()
notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} ct_ = do
@@ -3620,7 +3691,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
newContentMessage ct@Contact {localDisplayName = c, contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
- 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" ->
@@ -3632,7 +3703,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
setActive $ ActiveC c
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
@@ -3660,9 +3731,16 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processFDMessage fileId fileDescr
groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
- groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr _msgMeta = do
- fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
- processFDMessage fileId fileDescr
+ groupMessageFileDescription gInfo@GroupInfo {groupId} GroupMember {groupMemberId, memberId} sharedMsgId fileDescr _msgMeta = do
+ cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
+ case cci of
+ CChatItem SMDRcv ChatItem {chatDir = CIGroupRcv m' msgScope, file = Just CIFile {fileId}} ->
+ if sameMemberId memberId m'
+ then do
+ assertMemberSendAllowed gInfo m' msgScope directMsgProhibitedErr
+ processFDMessage fileId fileDescr
+ else messageError "x.msg.file.descr: message of another member"
+ _ -> messageError "x.msg.file.descr: group member attempted invalid file send"
processFDMessage :: FileTransferId -> FileDescr -> m ()
processFDMessage fileId fileDescr = do
@@ -3783,13 +3861,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
where
updateChatItemReaction = do
cr_ <- withStore $ \db -> do
- CChatItem md ci <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId
- if ciReactionAllowed ci
+ CChatItem md ci@ChatItem {chatDir} <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId
+ if directMemberCIUpdateAllowed ci m && ciReactionAllowed ci
then liftIO $ do
setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs
reactions <- getGroupCIReactions db g itemMemberId sharedMsgId
let ci' = CChatItem md ci {reactions}
- r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m) ci' brokerTs reaction
+ msgScope = directMemberToMsgScope $ ciDirDirectMember chatDir
+ r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m msgScope) ci' brokerTs reaction
pure $ Just $ CRChatItemReaction user add r
else pure Nothing
mapM_ toView cr_
@@ -3797,6 +3876,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
reactionAllowed :: Bool -> MsgReaction -> [MsgReaction] -> Bool
reactionAllowed add reaction rs = (reaction `elem` rs) /= add && not (add && length rs >= maxMsgReactions)
+ directMemberCIUpdateAllowed :: ChatItem 'CTGroup d -> GroupMember -> Bool
+ directMemberCIUpdateAllowed ChatItem {chatDir} GroupMember {groupMemberId} =
+ case ciDirDirectMember chatDir of
+ Just GroupMember {groupMemberId = directMemberId} -> groupMemberId == directMemberId
+ Nothing -> True
+
catchCINotFound :: m a -> (SharedMsgId -> m a) -> m a
catchCINotFound f handle =
f `catchChatError` \case
@@ -3804,32 +3889,41 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
e -> throwError e
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
- newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta
- | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
- | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
- | otherwise = do
- -- TODO integrity message check
- -- check if message moderation event was received ahead of message
- let timed_ = rcvGroupCITimed gInfo itemTTL
- live = fromMaybe False live_
- withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
- Just ciModeration -> do
- applyModeration timed_ live ciModeration
- withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
- Nothing -> createItem timed_ live
+ newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
+ assertMemberSendAllowed gInfo m msgScope $ rejected GFDirectMessages >> directMsgProhibitedErr
+ processMessage
where
+ processMessage
+ | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
+ | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
+ | otherwise = do
+ -- TODO integrity message check
+ -- check if message moderation event was received ahead of message
+ let timed_ = rcvGroupCITimed gInfo itemTTL
+ live = fromMaybe False live_
+ case msgScope_ of
+ Nothing -> processGroupScopeMsg timed_ live
+ Just MSGroup -> processGroupScopeMsg timed_ live
+ Just MSDirect -> createItem timed_ live
+ processGroupScopeMsg timed_ live =
+ withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
+ Just ciModeration -> do
+ applyModeration timed_ live ciModeration
+ withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
+ Nothing -> createItem timed_ live
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
- ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
+ ExtMsgContent content fInv_ itemTTL live_ msgScope_ = mcExtMsgContent mc
+ msgScope = fromMaybe MSGroup msgScope_
applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
| moderatorRole < GRAdmin || moderatorRole < memberRole =
createItem timed_ live
| groupFeatureAllowed SGFFullDelete gInfo = do
- ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m MSGroup) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo (CChatItem SMDRcv ci) moderator moderatedAt
toView $ CRNewChatItem user ci'
| otherwise = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
- ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m MSGroup) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False
cr <- markGroupCIDeleted user gInfo (CChatItem SMDRcv ci) createdByMsgId False (Just moderator) moderatedAt
toView cr
createItem timed_ live = do
@@ -3841,24 +3935,39 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
setActive $ ActiveG g
newChatItem ciContent ciFile_ timed_ live = do
- ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m msgScope) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
groupMsgToView gInfo m ci {reactions} msgMeta
pure ci
+ assertMemberSendAllowed :: GroupInfo -> GroupMember -> MessageScope -> m () -> m ()
+ assertMemberSendAllowed
+ gInfo@GroupInfo {membership = GroupMember {memberRole = userRole}}
+ m@GroupMember {memberRole}
+ MSDirect
+ directMessagesProhibitedAction
+ | userRole >= GRAdmin || memberRole >= GRAdmin = assertMemberStatus m
+ | not (groupFeatureAllowed SGFDirectMessages gInfo) = directMessagesProhibitedAction
+ | otherwise = assertMemberGroupRole m GRAuthor
+ assertMemberSendAllowed _ m MSGroup _ =
+ assertMemberGroupRole m GRAuthor
+
+ directMsgProhibitedErr :: m ()
+ directMsgProhibitedErr = throwChatError $ CECommandError "direct messages not allowed"
+
+ assertMemberGroupRole :: GroupMember -> GroupMemberRole -> m ()
+ assertMemberGroupRole member requiredRole = do
+ when (memberRole (member :: GroupMember) < requiredRole) $ messageError "member is not allowed to send messages (member role)"
+ assertMemberStatus member
+
+ assertMemberStatus :: GroupMember -> m ()
+ assertMemberStatus member =
+ when (memberRemoved member) $ messageError "member is not allowed to send messages (member removed)"
+
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m ()
- groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ =
- updateRcvChatItem `catchCINotFound` \_ -> do
- -- This patches initial sharedMsgId into chat item when locally deleted chat item
- -- 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) msgMeta content Nothing timed_ live
- ci' <- withStore' $ \db -> do
- createChatItemVersion db (chatItemId' ci) brokerTs mc
- updateGroupChatItem db user groupId ci content live Nothing
- toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
- setActive $ ActiveG g
+ groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} GroupMember {groupMemberId, memberId} sharedMsgId mc RcvMessage {msgId} msgMeta _ttl_ live_ =
+ updateRcvChatItem `catchCINotFound` \_ ->
+ withStore' (`deleteMessage` msgId)
where
MsgMeta {broker = (_, brokerTs)} = msgMeta
content = CIRcvMsgContent mc
@@ -3866,9 +3975,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
updateRcvChatItem = do
cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
case cci of
- CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
+ CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m' msgScope, meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
if sameMemberId memberId m'
then do
+ assertMemberSendAllowed gInfo m' msgScope directMsgProhibitedErr
let changed = mc /= oldMC
if changed || fromMaybe False itemLive
then do
@@ -3888,10 +3998,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let msgMemberId = fromMaybe memberId sndMemberId_
withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case
Right ci@(CChatItem _ ChatItem {chatDir}) -> case chatDir of
- CIGroupRcv mem
+ CIGroupRcv mem msgScope
| sameMemberId memberId mem && msgMemberId == memberId -> delete ci Nothing >>= toView
- | otherwise -> deleteMsg mem ci
- CIGroupSnd -> deleteMsg membership ci
+ | msgScope == MSGroup -> deleteMsg mem ci
+ | otherwise -> messageError "x.msg.del: private message of another member"
+ CIGroupSnd directMember
+ | isNothing directMember -> deleteMsg membership ci
+ | otherwise -> messageError "x.msg.del: private message sent by user"
Left e
| msgMemberId == memberId -> messageError $ "x.msg.del: message not found, " <> tshow e
| senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e
@@ -3934,7 +4047,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
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_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m MSGroup) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
groupMsgToView gInfo m ci msgMeta
let g = groupName' gInfo
whenGroupNtfs user gInfo $ do
@@ -4043,11 +4156,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m ()
xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {groupMemberId, memberId} sharedMsgId msgMeta = do
- checkIntegrityCreateItem (CDGroupRcv g mem) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv g mem MSGroup) msgMeta
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
case (msgDir, chatDir) of
- (SMDRcv, CIGroupRcv m) -> do
+ (SMDRcv, CIGroupRcv m _) -> do
if sameMemberId memberId m
then do
ft <- withStore (\db -> getRcvFileTransfer db user fileId)
@@ -4060,7 +4173,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> MsgMeta -> m ()
xFileAcptInvGroup g@GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName msgMeta = do
- checkIntegrityCreateItem (CDGroupRcv g m) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv g m MSGroup) msgMeta
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
(AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db user fileId
assertSMPAcceptNotProhibited ci
@@ -4091,7 +4204,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupMsgToView :: GroupInfo -> GroupMember -> ChatItem 'CTGroup 'MDRcv -> MsgMeta -> m ()
groupMsgToView gInfo m ci msgMeta = do
- checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv gInfo m MSGroup) msgMeta
toView $ CRNewChatItem user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m ()
@@ -4167,7 +4280,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
forM_ allGroupFeatures $ \(AGF f) -> do
let p = getGroupPreference f fullGroupPreferences
(_, param) = groupFeatureState p
- createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
+ createInternalChatItem user (CDGroupRcv g m MSGroup) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe =
@@ -4330,7 +4443,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
then messageError "x.grp.mem.new error: member already exists"
else do
newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
- ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
groupMsgToView gInfo m ci msgMeta
toView $ CRJoinedGroupMemberConnecting user gInfo m newMember
@@ -4414,7 +4527,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| 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 msgMeta (CIRcvGroupEvent gEvent)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent gEvent)
groupMsgToView gInfo m ci msgMeta
toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
@@ -4449,7 +4562,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
messageError "x.grp.mem.del with insufficient member permissions"
| otherwise = a
deleteMemberItem gEvent = do
- ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent gEvent)
groupMsgToView gInfo m ci msgMeta
sameMemberId :: MemberId -> GroupMember -> Bool
@@ -4460,7 +4573,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
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 msgMeta (CIRcvGroupEvent RGEMemberLeft)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent RGEMemberLeft)
groupMsgToView gInfo m ci msgMeta
toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft}
@@ -4473,7 +4586,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
pure members
-- member records are not deleted to keep history
deleteMembersConnections user ms
- ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted)
groupMsgToView gInfo m ci msgMeta
toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m
@@ -4483,7 +4596,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| otherwise = unless (p == p') $ do
g' <- withStore $ \db -> updateGroupProfile db user g p'
toView $ CRGroupUpdated user g g' (Just m)
- let cd = CDGroupRcv g' m
+ let cd = CDGroupRcv g' m MSGroup
unless (sameGroupProfileInfo p p') $ do
ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p')
groupMsgToView g' m ci msgMeta
@@ -4498,7 +4611,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do
- checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv gInfo m MSGroup) msgMeta
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
updateGroupItemStatus gInfo m conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
@@ -5211,7 +5324,7 @@ chatCommandP =
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
"/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
- "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
+ "/_send " *> (APISendMessage <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
"/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal),
@@ -5335,8 +5448,7 @@ chatCommandP =
"/set link role #" *> (GroupLinkMemberRole <$> displayName <*> memberRole),
"/delete link #" *> (DeleteGroupLink <$> displayName),
"/show link #" *> (ShowGroupLink <$> displayName),
- (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP),
- (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
+ (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <*> optional (" >@" *> displayName) <*> optional (" @" *> displayName) <* A.space <*> quotedMsg <*> msgTextP),
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
@@ -5344,8 +5456,8 @@ chatCommandP =
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
("/connect" <|> "/c") *> (AddContact <$> incognitoP),
- SendMessage <$> chatNameP <* A.space <*> msgTextP,
- "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")),
+ SendMessage <$> sendNameP <* A.space <*> msgTextP,
+ "/live " *> (SendLiveMessage <$> sendNameP <*> (A.space *> msgTextP <|> pure "")),
(">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv),
(">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd),
("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> textP),
@@ -5360,10 +5472,10 @@ chatCommandP =
"/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)),
"/show " *> (ShowChatItem . Just <$> A.decimal),
"/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP),
- ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath),
- ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
- ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
- ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
+ ("/file " <|> "/f ") *> (SendFile <$> sendNameP' <* A.space <*> filePath),
+ ("/image " <|> "/img ") *> (SendImage <$> sendNameP' <* A.space <*> filePath),
+ ("/fforward " <|> "/ff ") *> (ForwardFile <$> sendNameP' <* A.space <*> A.decimal),
+ ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> sendNameP' <* A.space <*> A.decimal),
("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> (" encrypt=" *> onOffP <|> pure False) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
"/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> (" encrypt=" *> onOffP <|> pure False)),
@@ -5474,6 +5586,13 @@ chatCommandP =
chatNameP = ChatName <$> chatTypeP <*> displayName
chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName
chatRefP = ChatRef <$> chatTypeP <*> A.decimal
+ sendNameP =
+ (A.char '@' $> SNDirect <*> displayName)
+ <|> (A.char '#' $> SNGroup <*> displayName <*> optional (" @" *> displayName))
+ sendNameP' = sendNameP <|> (SNDirect <$> displayName)
+ sendRefP =
+ (A.char '@' $> SRDirect <*> A.decimal)
+ <|> (A.char '#' $> SRGroup <*> A.decimal <*> optional (" @" *> A.decimal))
msgCountP = A.space *> A.decimal <|> pure 10
ciTTLDecimal = ("none" $> Nothing) <|> (Just <$> A.decimal)
ciTTL =
diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs
index df9c66ceee..50bddbb190 100644
--- a/src/Simplex/Chat/Bot.hs
+++ b/src/Simplex/Chat/Bot.hs
@@ -67,7 +67,7 @@ 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 (APISendMessage (ChatRef CTDirect ctId) False Nothing cm) >>= \case
+ sendChatCmd cc (APISendMessage (SRDirect ctId) False Nothing cm) >>= \case
CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
r -> putStrLn $ "unexpected send message response: " <> show r
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index af9aa964cf..26e4f43565 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -34,6 +34,7 @@ import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.String
import Data.Text (Text)
+import qualified Data.Text as T
import Data.Time (NominalDiffTime)
import Data.Time.Clock (UTCTime)
import Data.Version (showVersion)
@@ -241,7 +242,7 @@ data ChatCommand
| APIGetChat ChatRef ChatPagination (Maybe String)
| APIGetChatItems ChatPagination (Maybe String)
| APIGetChatItemInfo ChatRef ChatItemId
- | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
+ | APISendMessage {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
| APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId
@@ -352,14 +353,14 @@ data ChatCommand
| AddressAutoAccept (Maybe AutoAccept)
| AcceptContact IncognitoEnabled ContactName
| RejectContact ContactName
- | SendMessage ChatName Text
- | SendLiveMessage ChatName Text
+ | SendMessage SendName Text
+ | SendLiveMessage SendName Text
| SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: Text, message :: Text}
| SendMessageBroadcast Text -- UserId (not used in UI)
| DeleteMessage ChatName Text
| DeleteMemberMessage GroupName ContactName Text
| EditMessage {chatName :: ChatName, editedMsg :: Text, message :: Text}
- | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text}
+ | UpdateLiveMessage {sendName :: SendName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text}
| ReactToMessage {add :: Bool, reaction :: MsgReaction, chatName :: ChatName, reactToMessage :: Text}
| APINewGroup UserId GroupProfile
| NewGroup GroupProfile
@@ -381,17 +382,17 @@ data ChatCommand
| GroupLinkMemberRole GroupName GroupMemberRole
| DeleteGroupLink GroupName
| ShowGroupLink GroupName
- | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: Text, message :: Text}
+ | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, directMemberName :: Maybe ContactName, quotedMsg :: Text, message :: Text}
| LastChats (Maybe Int) -- UserId (not used in UI)
| LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI)
| LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI)
| ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
| ShowChatItemInfo ChatName Text
| ShowLiveItems Bool
- | SendFile ChatName FilePath
- | SendImage ChatName FilePath
- | ForwardFile ChatName FileTransferId
- | ForwardImage ChatName FileTransferId
+ | SendFile SendName FilePath
+ | SendImage SendName FilePath
+ | ForwardFile SendName FileTransferId
+ | ForwardImage SendName FileTransferId
| SendFileDescription ChatName FilePath
| ReceiveFile {fileId :: FileTransferId, storeEncrypted :: Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
| SetFileToReceive {fileId :: FileTransferId, storeEncrypted :: Bool}
@@ -612,6 +613,37 @@ instance ToJSON ChatResponse where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
+data SendRef
+ = SRDirect ContactId
+ | SRGroup GroupId (Maybe GroupMemberId)
+ deriving (Eq, Show)
+
+sendToChatRef :: SendRef -> ChatRef
+sendToChatRef = \case
+ SRDirect cId -> ChatRef CTDirect cId
+ SRGroup gId _ -> ChatRef CTGroup gId
+
+data SendName
+ = SNDirect ContactName
+ | SNGroup GroupName (Maybe ContactName)
+ deriving (Eq, Show)
+
+sendNameStr :: SendName -> String
+sendNameStr = \case
+ SNDirect cName -> "@" <> T.unpack cName
+ SNGroup gName (Just cName) -> "#" <> T.unpack gName <> " @" <> T.unpack cName
+ SNGroup gName Nothing -> "#" <> T.unpack gName
+
+data SendDirection
+ = SDDirect Contact
+ | SDGroup GroupInfo [GroupMember]
+ deriving (Eq, Show)
+
+sendDirToContactOrGroup :: SendDirection -> ContactOrGroup
+sendDirToContactOrGroup = \case
+ SDDirect c -> CGContact c
+ SDGroup g _ -> CGGroup g
+
newtype UserPwd = UserPwd {unUserPwd :: Text}
deriving (Eq, Show)
@@ -927,6 +959,7 @@ data ChatErrorType
| CEAgentCommandError {message :: String}
| CEInvalidFileDescription {message :: String}
| CEConnectionIncognitoChangeProhibited
+ | CEPeerChatVRangeIncompatible
| CEInternalError {message :: String}
| CEException {message :: String}
deriving (Show, Exception, Generic)
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index 45e5f9ff74..f97a0dd1b3 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -50,16 +50,6 @@ data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
data ChatName = ChatName ChatType Text
deriving (Show)
-chatTypeStr :: ChatType -> String
-chatTypeStr = \case
- CTDirect -> "@"
- CTGroup -> "#"
- CTContactRequest -> "<@"
- CTContactConnection -> ":"
-
-chatNameStr :: ChatName -> String
-chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
-
data ChatRef = ChatRef ChatType Int64
deriving (Eq, Show, Ord)
@@ -148,16 +138,16 @@ instance MsgDirectionI d => ToJSON (ChatItem c d) where
data CIDirection (c :: ChatType) (d :: MsgDirection) where
CIDirectSnd :: CIDirection 'CTDirect 'MDSnd
CIDirectRcv :: CIDirection 'CTDirect 'MDRcv
- CIGroupSnd :: CIDirection 'CTGroup 'MDSnd
- CIGroupRcv :: GroupMember -> CIDirection 'CTGroup 'MDRcv
+ CIGroupSnd :: Maybe GroupMember -> CIDirection 'CTGroup 'MDSnd
+ CIGroupRcv :: GroupMember -> MessageScope -> CIDirection 'CTGroup 'MDRcv
deriving instance Show (CIDirection c d)
data JSONCIDirection
= JCIDirectSnd
| JCIDirectRcv
- | JCIGroupSnd
- | JCIGroupRcv {groupMember :: GroupMember}
+ | JCIGroupSnd {directMember :: Maybe GroupMember}
+ | JCIGroupRcv {groupMember :: GroupMember, messageScope :: MessageScope}
deriving (Generic, Show)
instance ToJSON JSONCIDirection where
@@ -172,8 +162,19 @@ jsonCIDirection :: CIDirection c d -> JSONCIDirection
jsonCIDirection = \case
CIDirectSnd -> JCIDirectSnd
CIDirectRcv -> JCIDirectRcv
- CIGroupSnd -> JCIGroupSnd
- CIGroupRcv m -> JCIGroupRcv m
+ CIGroupSnd dm -> JCIGroupSnd dm
+ CIGroupRcv m ms -> JCIGroupRcv m ms
+
+ciDirDirectMember :: CIDirection 'CTGroup d -> Maybe GroupMember
+ciDirDirectMember = \case
+ CIGroupSnd dm -> dm
+ CIGroupRcv _ MSGroup -> Nothing
+ CIGroupRcv m MSDirect -> Just m
+
+directMemberToMsgScope :: Maybe GroupMember -> MessageScope
+directMemberToMsgScope = \case
+ Nothing -> MSGroup
+ Just _ -> MSDirect
data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int}
deriving (Show, Generic)
@@ -208,8 +209,8 @@ timedDeleteAt' CITimed {deleteAt} = deleteAt
chatItemMember :: GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo {membership} ChatItem {chatDir} = case chatDir of
- CIGroupSnd -> membership
- CIGroupRcv m -> m
+ CIGroupSnd _ -> membership
+ CIGroupRcv m _ -> m
ciReactionAllowed :: ChatItem c d -> Bool
ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False
@@ -238,22 +239,22 @@ chatItemDeletedState ChatItem {meta = CIMeta {itemDeleted}, content} =
data ChatDirection (c :: ChatType) (d :: MsgDirection) where
CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectRcv :: Contact -> ChatDirection 'CTDirect 'MDRcv
- CDGroupSnd :: GroupInfo -> ChatDirection 'CTGroup 'MDSnd
- CDGroupRcv :: GroupInfo -> GroupMember -> ChatDirection 'CTGroup 'MDRcv
+ CDGroupSnd :: GroupInfo -> Maybe GroupMember -> ChatDirection 'CTGroup 'MDSnd
+ CDGroupRcv :: GroupInfo -> GroupMember -> MessageScope -> ChatDirection 'CTGroup 'MDRcv
toCIDirection :: ChatDirection c d -> CIDirection c d
toCIDirection = \case
CDDirectSnd _ -> CIDirectSnd
CDDirectRcv _ -> CIDirectRcv
- CDGroupSnd _ -> CIGroupSnd
- CDGroupRcv _ m -> CIGroupRcv m
+ CDGroupSnd _ dm -> CIGroupSnd dm
+ CDGroupRcv _ m ms -> CIGroupRcv m ms
toChatInfo :: ChatDirection c d -> ChatInfo c
toChatInfo = \case
CDDirectSnd c -> DirectChat c
CDDirectRcv c -> DirectChat c
- CDGroupSnd g -> GroupChat g
- CDGroupRcv g _ -> GroupChat g
+ CDGroupSnd g _ -> GroupChat g
+ CDGroupRcv g _ _ -> GroupChat g
data NewChatItem d = NewChatItem
{ createdByMsgId :: Maybe MessageId,
@@ -433,29 +434,39 @@ instance ToJSON (JSONCIReaction c d) where
data CIQDirection (c :: ChatType) where
CIQDirectSnd :: CIQDirection 'CTDirect
CIQDirectRcv :: CIQDirection 'CTDirect
- CIQGroupSnd :: CIQDirection 'CTGroup
- CIQGroupRcv :: Maybe GroupMember -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet
+ CIQGroupSnd :: MessageScope -> CIQDirection 'CTGroup
+ CIQGroupRcv :: Maybe GroupMember -> MessageScope -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet
deriving instance Show (CIQDirection c)
+data JSONCIQDirection
+ = JCIQDirectSnd
+ | JCIQDirectRcv
+ | JCIQGroupSnd {messageScope :: MessageScope}
+ | JCIQGroupRcv {groupMember :: Maybe GroupMember, messageScope :: MessageScope}
+ deriving (Generic, Show)
+
+instance ToJSON JSONCIQDirection where
+ toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIQ"
+ toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIQ"
+
instance ToJSON (CIQDirection c) where
toJSON = J.toJSON . jsonCIQDirection
toEncoding = J.toEncoding . jsonCIQDirection
-jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection
+jsonCIQDirection :: CIQDirection c -> JSONCIQDirection
jsonCIQDirection = \case
- CIQDirectSnd -> Just JCIDirectSnd
- CIQDirectRcv -> Just JCIDirectRcv
- CIQGroupSnd -> Just JCIGroupSnd
- CIQGroupRcv (Just m) -> Just $ JCIGroupRcv m
- CIQGroupRcv Nothing -> Nothing
+ CIQDirectSnd -> JCIQDirectSnd
+ CIQDirectRcv -> JCIQDirectRcv
+ CIQGroupSnd ms -> JCIQGroupSnd ms
+ CIQGroupRcv m ms -> JCIQGroupRcv m ms
quoteMsgDirection :: CIQDirection c -> MsgDirection
quoteMsgDirection = \case
CIQDirectSnd -> MDSnd
CIQDirectRcv -> MDRcv
- CIQGroupSnd -> MDSnd
- CIQGroupRcv _ -> MDRcv
+ CIQGroupSnd _ -> MDSnd
+ CIQGroupRcv _ _ -> MDRcv
data CIFile (d :: MsgDirection) = CIFile
{ fileId :: Int64,
diff --git a/src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs b/src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs
new file mode 100644
index 0000000000..6c150b19ce
--- /dev/null
+++ b/src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230904_item_direct_group_member_id where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230904_item_direct_group_member_id :: Query
+m20230904_item_direct_group_member_id =
+ [sql|
+ALTER TABLE chat_items ADD COLUMN item_direct_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL;
+ALTER TABLE chat_items ADD COLUMN quoted_message_scope TEXT;
+
+CREATE INDEX idx_chat_items_item_direct_group_member_id ON chat_items(item_direct_group_member_id);
+|]
+
+down_m20230904_item_direct_group_member_id :: Query
+down_m20230904_item_direct_group_member_id =
+ [sql|
+DROP INDEX idx_chat_items_item_direct_group_member_id;
+
+ALTER TABLE chat_items DROP COLUMN quoted_message_scope;
+ALTER TABLE chat_items DROP COLUMN item_direct_group_member_id;
+|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index c71cc9aa90..f9a9309db5 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -392,7 +392,9 @@ CREATE TABLE chat_items(
timed_delete_at TEXT,
item_live INTEGER,
item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
- item_deleted_ts TEXT
+ item_deleted_ts TEXT,
+ item_direct_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
+ quoted_message_scope TEXT
);
CREATE TABLE chat_item_messages(
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
@@ -713,3 +715,6 @@ CREATE INDEX idx_chat_items_user_id_item_status ON chat_items(
item_status
);
CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe);
+CREATE INDEX idx_chat_items_item_direct_group_member_id ON chat_items(
+ item_direct_group_member_id
+);
diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs
index 13692b57cc..b42ede41c8 100644
--- a/src/Simplex/Chat/Protocol.hs
+++ b/src/Simplex/Chat/Protocol.hs
@@ -44,7 +44,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Util
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
import Simplex.Messaging.Version hiding (version)
@@ -58,6 +58,10 @@ supportedChatVRange = mkVersionRange 1 currentChatVersion
groupNoDirectVRange :: VersionRange
groupNoDirectVRange = mkVersionRange 2 currentChatVersion
+-- version range that supports private messages from members in a group
+groupPrivateMessagesVRange :: VersionRange
+groupPrivateMessagesVRange = mkVersionRange 2 currentChatVersion
+
data ConnectionEntity
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
@@ -158,11 +162,28 @@ instance ToJSON SharedMsgId where
toJSON = strToJSON
toEncoding = strToJEncoding
+data MessageScope = MSGroup | MSDirect
+ deriving (Eq, Show, Generic)
+
+instance FromJSON MessageScope where
+ parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MS"
+
+instance ToJSON MessageScope where
+ toJSON = J.genericToJSON . enumJSON $ dropPrefix "MS"
+ toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MS"
+
+instance ToField MessageScope where
+ toField = toField . encodeJSON
+
+instance FromField MessageScope where
+ fromField = fromTextField_ decodeJSON
+
data MsgRef = MsgRef
{ msgId :: Maybe SharedMsgId,
sentAt :: UTCTime,
sent :: Bool,
- memberId :: Maybe MemberId -- must be present in all group message references, both referencing sent and received
+ memberId :: Maybe MemberId, -- must be present in all group message references, both referencing sent and received
+ msgScope :: Maybe MessageScope
}
deriving (Eq, Show, Generic)
@@ -447,7 +468,13 @@ msgContentTag = \case
MCFile {} -> MCFile_
MCUnknown {tag} -> MCUnknown_ tag
-data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
+data ExtMsgContent = ExtMsgContent
+ { content :: MsgContent,
+ file :: Maybe FileInvitation,
+ ttl :: Maybe Int,
+ live :: Maybe Bool,
+ scope :: Maybe MessageScope
+ }
deriving (Eq, Show)
parseMsgContainer :: J.Object -> JT.Parser MsgContainer
@@ -456,10 +483,10 @@ parseMsgContainer v =
<|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
<|> MCSimple <$> mc
where
- mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
+ mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live" <*> v .:? "scope"
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
-extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
+extMsgContent mc file = ExtMsgContent mc file Nothing Nothing Nothing
justTrue :: Bool -> Maybe Bool
justTrue True = Just True
@@ -503,7 +530,7 @@ 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 c file ttl live scope) = ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("scope" .=? scope) ["content" .= c]
instance ToJSON MsgContent where
toJSON = \case
diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs
index ddd59319d5..93b9ed612f 100644
--- a/src/Simplex/Chat/Store/Messages.hs
+++ b/src/Simplex/Chat/Store/Messages.hs
@@ -25,6 +25,7 @@ module Simplex.Chat.Store.Messages
createRcvMsgDeliveryEvent,
createPendingGroupMessage,
getPendingGroupMessages,
+ deleteMessage,
deletePendingGroupMessage,
deleteOldMessages,
updateChatTs,
@@ -289,6 +290,10 @@ getPendingGroupMessages db groupMemberId =
pendingGroupMessage (msgId, cmEventTag, msgBody, introId_) =
PendingGroupMessage {msgId, cmEventTag, msgBody, introId_}
+deleteMessage :: DB.Connection -> MessageId -> IO ()
+deleteMessage db msgId = do
+ DB.execute db "DELETE FROM messages WHERE message_id = ?" (Only msgId)
+
deletePendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> IO ()
deletePendingGroupMessage db groupMemberId messageId =
DB.execute db "DELETE FROM pending_group_messages WHERE group_member_id = ? AND message_id = ?" (groupMemberId, messageId)
@@ -297,7 +302,7 @@ deleteOldMessages :: DB.Connection -> UTCTime -> IO ()
deleteOldMessages db createdAtCutoff = do
DB.execute db "DELETE FROM messages WHERE created_at <= ?" (Only createdAtCutoff)
-type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId)
+type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId, Maybe MessageScope)
updateChatTs :: DB.Connection -> User -> ChatDirection c d -> UTCTime -> IO ()
updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirection of
@@ -320,14 +325,15 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
createdByMsgId = if msgId == 0 then Nothing else Just msgId
quoteRow :: NewQuoteRow
quoteRow = case quotedItem of
- Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
- Just CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content} ->
- uncurry (quotedSharedMsgId,Just sentAt,Just content,,) $ case chatDir of
- CIQDirectSnd -> (Just True, Nothing)
- CIQDirectRcv -> (Just False, Nothing)
- CIQGroupSnd -> (Just True, Nothing)
- CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
- CIQGroupRcv Nothing -> (Just False, Nothing)
+ Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
+ Just CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content} -> do
+ let (quotedSent, quotedMemberId, quotedMsgScope) = case chatDir of
+ CIQDirectSnd -> (Just True, Nothing, Nothing)
+ CIQDirectRcv -> (Just False, Nothing, Nothing)
+ CIQGroupSnd messageScope -> (Just True, Nothing, Just messageScope)
+ CIQGroupRcv (Just GroupMember {memberId}) messageScope -> (Just False, Just memberId, Just messageScope)
+ CIQGroupRcv Nothing messageScope -> (Just False, Nothing, Just messageScope)
+ (quotedSharedMsgId, Just sentAt, Just content, quotedSent, quotedMemberId, quotedMsgScope)
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent timed live itemTs createdAt = do
@@ -338,19 +344,20 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar
quotedMsg = cmToQuotedMsg chatMsgEvent
quoteRow :: NewQuoteRow
quoteRow = case quotedMsg of
- Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
- Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId}, content} ->
- uncurry (sharedMsgId,Just sentAt,Just content,,) $ case chatDirection of
- CDDirectRcv _ -> (Just $ not sent, Nothing)
- CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ ->
- (Just $ Just userMemberId == memberId, memberId)
+ Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
+ Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId, msgScope}, content} -> do
+ let (quotedSent, quotedMemberId, quotedMsgScope) = case chatDirection of
+ CDDirectRcv _ -> (Just $ not sent, Nothing, Nothing)
+ CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ _ ->
+ (Just $ Just userMemberId == memberId, memberId, msgScope)
+ (sharedMsgId, Just sentAt, Just content, quotedSent, quotedMemberId, quotedMsgScope)
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItemNoMsg db user chatDirection ciContent =
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False
where
quoteRow :: NewQuoteRow
- quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
+ quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs createdAt = do
@@ -359,12 +366,12 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
[sql|
INSERT INTO chat_items (
-- user and IDs
- user_id, created_by_msg_id, contact_id, group_id, group_member_id,
+ user_id, created_by_msg_id, contact_id, group_id, group_member_id, item_direct_group_member_id,
-- meta
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
-- quote
- quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
- ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id, quoted_message_scope
+ ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
ciId <- insertedRowId db
@@ -373,12 +380,16 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
where
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
- idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
+ idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
idsRow = case chatDirection of
- CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
- CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing)
- CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId)
- CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing)
+ CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
+ CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
+ CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} messageScope -> case messageScope of
+ MSGroup -> (Nothing, Just groupId, Just groupMemberId, Nothing)
+ MSDirect -> (Nothing, Just groupId, Just groupMemberId, Just groupMemberId)
+ CDGroupSnd GroupInfo {groupId} directMember -> case directMember of
+ Nothing -> (Nothing, Just groupId, Nothing, Nothing)
+ Just GroupMember {groupMemberId} -> (Nothing, Just groupId, Nothing, Just groupMemberId)
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
@@ -388,19 +399,21 @@ insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime ->
insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts)
getChatItemQuote_ :: DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
-getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} =
+getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId, msgScope}, content} =
case chatDirection of
CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent)
- CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} ->
+ CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} _directMember ->
case memberId of
Just mId
- | mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId
- | mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId mId
+ | mId == userMemberId -> (`ciQuote` CIQGroupSnd messageScope) <$> getUserGroupChatItemId_ groupId
+ | mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender) messageScope) <$> getGroupChatItemId_ groupId mId
| otherwise -> getGroupChatItemQuote_ groupId mId
- _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing
+ _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing messageScope
where
ciQuote :: Maybe ChatItemId -> CIQDirection c -> CIQuote c
ciQuote itemId dir = CIQuote dir itemId msgId sentAt content . parseMaybeMarkdownList $ msgContentText content
+ messageScope :: MessageScope
+ messageScope = fromMaybe MSGroup msgScope
getDirectChatItemQuote_ :: Int64 -> Bool -> IO (CIQuote 'CTDirect)
getDirectChatItemQuote_ contactId userSent = do
fmap ciQuoteDirect . maybeFirstRow fromOnly $
@@ -447,8 +460,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
[":user_id" := userId, ":group_id" := groupId, ":member_id" := mId, ":msg_id" := msgId]
where
ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
- ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
- ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
+ ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing messageScope
+ ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId $ CIQGroupRcv (Just $ toGroupMember userContactId memberRow) messageScope
getChatPreviews :: DB.Connection -> User -> Bool -> IO [AChat]
getChatPreviews db user withPCC = do
@@ -556,7 +569,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
- ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
+ ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, i.quoted_message_scope,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
@@ -564,7 +577,11 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
- dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
+ dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
+ -- direct GroupMember
+ dirm.group_member_id, dirm.group_id, dirm.member_id, dirm.member_role, dirm.member_category,
+ dirm.member_status, dirm.invited_by, dirm.local_display_name, dirm.contact_id, dirm.contact_profile_id, dirp.contact_profile_id,
+ dirp.display_name, dirp.full_name, dirp.image, dirp.contact_link, dirp.local_alias, dirp.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
@@ -590,6 +607,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
+ LEFT JOIN group_members dirm ON dirm.group_member_id = i.item_direct_group_member_id
+ LEFT JOIN contact_profiles dirp ON dirp.contact_profile_id = COALESCE(dirm.member_profile_id, dirm.contact_profile_id)
WHERE g.user_id = ? AND mu.contact_id = ?
ORDER BY i.item_ts DESC
|]
@@ -967,10 +986,8 @@ toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
where
direction sent = if sent then CIQDirectSnd else CIQDirectRcv
-
-toQuote :: QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
-toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir =
- CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
+ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir =
+ CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
-- this function can be changed so it never fails, not only avoid failure on invalid json
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
@@ -1013,37 +1030,60 @@ toDirectChatItemList currentTs (((Just itemId, Just itemTs, Just msgDir, Just it
either (const []) (: []) $ toDirectChatItem currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
toDirectChatItemList _ _ = []
-type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
+type GroupQuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MessageScope)
-type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
+type GroupQuoteMemberRow = GroupQuoteRow :. MaybeGroupMemberRow
-toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
-toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
+type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteMemberRow :. MaybeGroupMemberRow :. MaybeGroupMemberRow
+
+toGroupQuote :: GroupQuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
+toGroupQuote qr@(_, _, _, _, quotedSent, msgScope) quotedMember_ =
+ toQuote qr $ direction quotedSent quotedMember_
where
- direction (Just True) _ = Just CIQGroupSnd
- direction (Just False) (Just member) = Just . CIQGroupRcv $ Just member
- direction (Just False) Nothing = Just $ CIQGroupRcv Nothing
+ direction (Just True) _ = Just $ CIQGroupSnd messageScope
+ direction (Just False) (Just member) = Just $ CIQGroupRcv (Just member) messageScope
+ direction (Just False) Nothing = Just $ CIQGroupRcv Nothing messageScope
direction _ _ = Nothing
+ messageScope = fromMaybe MSGroup msgScope
+ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _, _) dir =
+ CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
-- this function can be changed so it never fails, not only avoid failure on invalid json
-toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
-toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
+toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteMemberRow :. MaybeGroupMemberRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
+toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_) = do
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
where
member_ = toMaybeGroupMember userContactId memberRow_
quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
deletedByGroupMember_ = toMaybeGroupMember userContactId deletedByGroupMemberRow_
+ directMember_ = toMaybeGroupMember userContactId directMemberRow_
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
chatItem itemContent = case (itemContent, itemStatus, member_, fileStatus_) of
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) ->
- Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent (maybeCIFile fileStatus)
+ Right $ cItem SMDSnd (CIGroupSnd directMember_) ciStatus ciContent (maybeCIFile fileStatus)
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Nothing) ->
- Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent Nothing
+ Right $ cItem SMDSnd (CIGroupSnd directMember_) ciStatus ciContent Nothing
+ -- read of group chat item can be refactored so that direct member is not read for rcv items:
+ -- if item_direct_group_member_id is equal to group_member_id, then message scope is direct
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Just (AFS SMDRcv fileStatus)) ->
- Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent (maybeCIFile fileStatus)
+ case directMember_ of
+ Just directMember
+ | sameMember member directMember ->
+ Right $ cItem SMDRcv (CIGroupRcv member MSDirect) ciStatus ciContent (maybeCIFile fileStatus)
+ | otherwise -> badItem
+ Nothing ->
+ Right $ cItem SMDRcv (CIGroupRcv member MSGroup) ciStatus ciContent (maybeCIFile fileStatus)
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Nothing) ->
- Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent Nothing
+ case directMember_ of
+ Just directMember
+ | sameMember member directMember ->
+ Right $ cItem SMDRcv (CIGroupRcv member MSDirect) ciStatus ciContent Nothing
+ | otherwise -> badItem
+ Nothing ->
+ Right $ cItem SMDRcv (CIGroupRcv member MSGroup) ciStatus ciContent Nothing
_ -> badItem
+ sameMember :: GroupMember -> GroupMember -> Bool
+ sameMember GroupMember {groupMemberId = gmId1} GroupMember {groupMemberId = gmId2} = gmId1 == gmId2
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
maybeCIFile fileStatus =
case (fileId_, fileName_, fileSize_, fileProtocol_) of
@@ -1068,8 +1108,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
-toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
- either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
+toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_) =
+ either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_)
toGroupChatItemList _ _ _ = []
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
@@ -1484,7 +1524,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
- ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
+ ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, i.quoted_message_scope,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
@@ -1492,7 +1532,11 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
- dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
+ dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
+ -- direct GroupMember
+ dirm.group_member_id, dirm.group_id, dirm.member_id, dirm.member_role, dirm.member_category,
+ dirm.member_status, dirm.invited_by, dirm.local_display_name, dirm.contact_id, dirm.contact_profile_id, dirp.contact_profile_id,
+ dirp.display_name, dirp.full_name, dirp.image, dirp.contact_link, dirp.local_alias, dirp.preferences
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
@@ -1502,6 +1546,8 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
+ LEFT JOIN group_members dirm ON dirm.group_member_id = i.item_direct_group_member_id
+ LEFT JOIN contact_profiles dirp ON dirp.contact_profile_id = COALESCE(dirm.member_profile_id, dirm.contact_profile_id)
WHERE i.user_id = ? AND i.group_id = ? AND i.chat_item_id = ?
|]
(userId, groupId, itemId)
diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs
index cbcc4ddd28..74e2d89d72 100644
--- a/src/Simplex/Chat/Store/Migrations.hs
+++ b/src/Simplex/Chat/Store/Migrations.hs
@@ -79,6 +79,7 @@ import Simplex.Chat.Migrations.M20230814_indexes
import Simplex.Chat.Migrations.M20230827_file_encryption
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
+import Simplex.Chat.Migrations.M20230904_item_direct_group_member_id
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -157,7 +158,8 @@ schemaMigrations =
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption),
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
- ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe)
+ ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
+ ("20230904_item_direct_group_member_id", m20230904_item_direct_group_member_id, Just down_m20230904_item_direct_group_member_id)
]
-- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs
index 36cec49d7c..f28795a374 100644
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -73,19 +73,19 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
Right SendMessageBroadcast {} -> True
_ -> False
startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
- startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
+ startLiveMessage (Right (SendLiveMessage sendName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
whenM (isNothing <$> readTVarIO liveMessageState) $ do
let s = T.unpack msg
int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int
liveThreadId <- mkWeakThreadId =<< runLiveMessage int `forkFinally` const (atomically $ writeTVar liveMessageState Nothing)
promptThreadId <- mkWeakThreadId =<< forkIO blinkLivePrompt
atomically $ do
- let lm = LiveMessage {chatName, chatItemId = itemId, livePrompt = True, sentMsg = s, typedMsg = s, liveThreadId, promptThreadId}
+ let lm = LiveMessage {sendName, chatItemId = itemId, livePrompt = True, sentMsg = s, typedMsg = s, liveThreadId, promptThreadId}
writeTVar liveMessageState (Just lm)
modifyTVar termState $ \ts -> ts {inputString = s, inputPosition = length s, inputPrompt = liveInputPrompt lm}
where
- liveInputPrompt LiveMessage {chatName = n, livePrompt} =
- "> " <> chatNameStr n <> " [" <> (if livePrompt then "LIVE" else " ") <> "] "
+ liveInputPrompt LiveMessage {sendName = n, livePrompt} =
+ "> " <> sendNameStr n <> " [" <> (if livePrompt then "LIVE" else " ") <> "] "
runLiveMessage :: Int -> IO ()
runLiveMessage int = do
threadDelay int
@@ -123,8 +123,8 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
startLiveMessage _ _ = pure ()
sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO ChatResponse
-sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
- let cmd = UpdateLiveMessage chatName chatItemId live $ T.pack sentMsg
+sendUpdatedLiveMessage cc sentMsg LiveMessage {sendName, chatItemId} live = do
+ let cmd = UpdateLiveMessage sendName chatItemId live $ T.pack sentMsg
either (CRChatCmdError Nothing) id <$> runExceptT (processChatCommand cmd) `runReaderT` cc
runTerminalInput :: ChatTerminal -> ChatController -> IO ()
@@ -174,14 +174,14 @@ receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, chatStore} ct@C
let s = inputString ts
lm_ <- readTVar liveMessageState
case lm_ of
- Just LiveMessage {chatName}
+ Just LiveMessage {sendName}
| live -> do
writeTVar termState ts' {previousInput}
- writeTBQueue inputQ $ "/live " <> chatNameStr chatName
+ writeTBQueue inputQ $ "/live " <> sendNameStr sendName
| otherwise ->
writeTVar termState ts' {inputPrompt = "> ", previousInput}
where
- previousInput = chatNameStr chatName <> " " <> s
+ previousInput = sendNameStr sendName <> " " <> s
_
| live -> when (isSend s) $ do
writeTVar termState ts' {previousInput = s}
diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs
index ce68d715fe..1a36380282 100644
--- a/src/Simplex/Chat/Terminal/Output.hs
+++ b/src/Simplex/Chat/Terminal/Output.hs
@@ -55,7 +55,7 @@ data AutoCompleteState = ACState
}
data LiveMessage = LiveMessage
- { chatName :: ChatName,
+ { sendName :: SendName,
chatItemId :: ChatItemId,
livePrompt :: Bool,
sentMsg :: String,
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 2d77cbe771..bcef3cbff9 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -330,12 +330,12 @@ data GroupSummary = GroupSummary
instance ToJSON GroupSummary where toEncoding = J.genericToEncoding J.defaultOptions
-data ContactOrGroup = CGContact Contact | CGGroup Group
+data ContactOrGroup = CGContact Contact | CGGroup GroupInfo
contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
contactAndGroupIds = \case
CGContact Contact {contactId} -> (Just contactId, Nothing)
- CGGroup (Group GroupInfo {groupId} _) -> (Nothing, Just groupId)
+ CGGroup GroupInfo {groupId} -> (Nothing, Just groupId)
-- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties)
data ChatSettings = ChatSettings
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 1a740bef5f..4656ea5b20 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -322,14 +322,35 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
testViewChat :: AChat -> [StyledString]
testViewChat (AChat _ Chat {chatInfo, chatItems}) = [sShow $ map toChatView chatItems]
where
- toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text), Maybe String)
- toChatView ci@(CChatItem dir ChatItem {quotedItem, file}) =
- ((msgDirectionInt $ toMsgDirection dir, testViewItem ci (chatInfoMembership chatInfo)), qItem, fPath)
+ toChatView :: CChatItem c -> ((Int, String, Text), Maybe (Int, String, Text), Maybe String)
+ toChatView ci@(CChatItem dir ChatItem {chatDir, quotedItem, file}) =
+ (item, qItem, fPath)
where
+ item =
+ ( msgDirectionInt $ toMsgDirection dir,
+ directMemberName,
+ testViewItem ci (chatInfoMembership chatInfo)
+ )
+ directMemberName = case chatDir of
+ CIGroupSnd (Just GroupMember {localDisplayName = n}) -> T.unpack n
+ CIGroupRcv GroupMember {localDisplayName = n} MSDirect -> T.unpack n
+ _ -> ""
qItem = case quotedItem of
Nothing -> Nothing
Just CIQuote {chatDir = quoteDir, content} ->
- Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
+ Just
+ ( msgDirectionInt $ quoteMsgDirection quoteDir,
+ qMsgScope,
+ msgContentText content
+ )
+ where
+ qMsgScope = case quoteDir of
+ CIQGroupSnd ms -> msgScopeText ms
+ CIQGroupRcv _ ms -> msgScopeText ms
+ _ -> ""
+ msgScopeText ms = case ms of
+ MSGroup -> "group"
+ MSDirect -> "direct"
fPath = case file of
Just CIFile {fileSource = Just (CryptoFile fp _)} -> Just fp
_ -> Nothing
@@ -380,7 +401,7 @@ viewUsersList = mapMaybe userInfo . sortOn ldn
muted :: ChatInfo c -> CIDirection c d -> Bool
muted chat chatDir = case (chat, chatDir) of
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
- (GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> True
+ (GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _ _) -> True
_ -> False
viewGroupSubscribed :: GroupInfo -> [StyledString]
@@ -403,8 +424,9 @@ viewChats ts tz = concatMap chatPreview . reverse
where
chatName = case chat of
DirectChat ct -> [" " <> ttyToContact' ct]
- GroupChat g -> [" " <> ttyToGroup g]
+ GroupChat g -> [" " <> ttyToGroup' g]
_ -> []
+ ttyToGroup' g@GroupInfo {localDisplayName = n} = membershipIncognito g <> ttyTo ("#" <> n <> " ")
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz =
@@ -426,20 +448,20 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
where
quote = maybe [] (directQuote chatDir) quotedItem
GroupChat g -> case chatDir of
- CIGroupSnd -> case content of
+ CIGroupSnd directMember -> case content of
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
CISndGroupInvitation {} -> showSndItemProhibited to
_ -> showSndItem to
where
- to = ttyToGroup g
- CIGroupRcv m -> case content of
+ to = ttyToGroup g directMember
+ CIGroupRcv m msgScope -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvGroupInvitation {} -> showRcvItemProhibited from
- CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
+ CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m msgScope) quote meta [plainContent content] False
_ -> showRcvItem from
where
- from = ttyFromGroup g m
+ from = ttyFromGroup g m msgScope
where
quote = maybe [] (groupQuote g) quotedItem
_ -> []
@@ -531,18 +553,18 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}
where
quote = maybe [] (directQuote chatDir) quotedItem
GroupChat g -> case chatDir of
- CIGroupRcv m -> case content of
+ CIGroupRcv m msgScope -> case content of
CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> []
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
_ -> []
where
- from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
- CIGroupSnd -> case content of
+ from = if itemEdited then ttyFromGroupEdited g m msgScope else ttyFromGroup g m msgScope
+ CIGroupSnd directMember -> case content of
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
_ -> []
where
- to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
+ to = if itemEdited then ttyToGroupEdited g directMember else ttyToGroup g directMember
where
quote = maybe [] (groupQuote g) quotedItem
_ -> []
@@ -567,7 +589,8 @@ viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem
GroupChat g -> case ciMsgContent deletedContent of
Just mc ->
let m = chatItemMember g ci
- in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts tz meta
+ msgScope = directMemberToMsgScope $ ciDirDirectMember chatDir
+ in viewReceivedMessage (ttyFromGroupDeleted g m msgScope deletedText_) [] mc ts tz meta
_ -> prohibited
_ -> prohibited
where
@@ -586,14 +609,14 @@ viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md
where
from = ttyFromContact c
reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then ">>" else ">"
- (GroupChat g, CIGroupRcv m) -> case ciMsgContent content of
+ (GroupChat g, CIGroupRcv m messageScope) -> case ciMsgContent content of
Just mc -> view from $ reactionMsg mc
_ -> []
where
- from = ttyFromGroup g m
+ from = ttyFromGroup g m messageScope
reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir
(_, CIDirectSnd) -> [sentText]
- (_, CIGroupSnd) -> [sentText]
+ (_, CIGroupSnd _) -> [sentText]
where
view from msg
| showReactions = viewReceivedReaction from msg reactionText ts tz sentAt
@@ -621,13 +644,13 @@ groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQu
sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember
sentByMember GroupInfo {membership} = \case
- CIQGroupSnd -> Just membership
- CIQGroupRcv m -> m
+ CIQGroupSnd _ -> Just membership
+ CIQGroupRcv m _ -> m
sentByMember' :: GroupInfo -> CIDirection 'CTGroup d -> GroupMember
sentByMember' GroupInfo {membership} = \case
- CIGroupSnd -> membership
- CIGroupRcv m -> m
+ CIGroupSnd _ -> membership
+ CIGroupRcv m _ -> m
quoteText :: MsgContent -> StyledString -> [StyledString]
quoteText qmc sentBy = prependFirst (sentBy <> " ") $ msgPreview qmc
@@ -1319,8 +1342,9 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
uploadingFile :: StyledString -> AChatItem -> [StyledString]
uploadingFile status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd}) =
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
-uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd}) =
- [status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
+uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd directMember}) =
+ let forMember = maybe "" (\GroupMember {localDisplayName = m} -> styled (colored Blue) $ " @" <> m <> " (direct)") directMember
+ in [status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g <> forMember]
uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
sndFile :: SndFileTransfer -> StyledString
@@ -1352,7 +1376,7 @@ savingFile' :: Bool -> AChatItem -> [StyledString]
savingFile' testView (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath cfArgs_)}, chatDir}) =
let from = case (chat, chatDir) of
(DirectChat Contact {localDisplayName = c}, CIDirectRcv) -> " from " <> ttyContact c
- (_, CIGroupRcv GroupMember {localDisplayName = m}) -> " from " <> ttyContact m
+ (_, CIGroupRcv GroupMember {localDisplayName = m} _) -> " from " <> ttyContact m
_ -> ""
in ["saving file " <> sShow fileId <> from <> " to " <> plain filePath] <> cfArgsStr
where
@@ -1366,7 +1390,7 @@ savingFile' _ _ = ["saving file"] -- shouldn't happen
receivingFile_' :: StyledString -> AChatItem -> [StyledString]
receivingFile_' status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) =
[status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact c]
-receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv GroupMember {localDisplayName = m}}) =
+receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv GroupMember {localDisplayName = m} _}) =
[status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact m]
receivingFile_' status _ = [status <> " receiving file"] -- shouldn't happen
@@ -1582,7 +1606,7 @@ viewChatError logLevel = \case
CEXFTPSndFile fileId aFileId e -> ["error sending XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError]
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"]
+ CEInvalidQuote -> ["invalid message reply"]
CEInvalidChatItemUpdate -> ["cannot update this item"]
CEInvalidChatItemDelete -> ["cannot delete this item"]
CEHasCurrentCall -> ["call already in progress"]
@@ -1597,6 +1621,7 @@ viewChatError logLevel = \case
CEAgentCommandError e -> ["agent command error: " <> plain e]
CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
CEConnectionIncognitoChangeProhibited -> ["incognito mode change prohibited"]
+ CEPeerChatVRangeIncompatible -> ["peer chat protocol version range incompatible"]
CEInternalError e -> ["internal chat error: " <> plain e]
CEException e -> ["exception: " <> plain e]
-- e -> ["chat error: " <> sShow e]
@@ -1737,19 +1762,24 @@ ttyFullGroup :: GroupInfo -> StyledString
ttyFullGroup GroupInfo {localDisplayName = g, groupProfile = GroupProfile {fullName}} =
ttyGroup g <> optFullName g fullName
-ttyFromGroup :: GroupInfo -> GroupMember -> StyledString
-ttyFromGroup g m = membershipIncognito g <> ttyFrom (fromGroup_ g m)
+ttyFromGroup :: GroupInfo -> GroupMember -> MessageScope -> StyledString
+ttyFromGroup g m ms = membershipIncognito g <> ttyFrom (fromGroup_ g m ms)
-ttyFromGroupEdited :: GroupInfo -> GroupMember -> StyledString
-ttyFromGroupEdited g m = membershipIncognito g <> ttyFrom (fromGroup_ g m <> "[edited] ")
+ttyFromGroupEdited :: GroupInfo -> GroupMember -> MessageScope -> StyledString
+ttyFromGroupEdited g m ms = membershipIncognito g <> ttyFrom (fromGroup_ g m ms <> "[edited] ")
-ttyFromGroupDeleted :: GroupInfo -> GroupMember -> Maybe Text -> StyledString
-ttyFromGroupDeleted g m deletedText_ =
- membershipIncognito g <> ttyFrom (fromGroup_ g m <> maybe "" (\t -> "[" <> t <> "] ") deletedText_)
+ttyFromGroupDeleted :: GroupInfo -> GroupMember -> MessageScope -> Maybe Text -> StyledString
+ttyFromGroupDeleted g m ms deletedText_ =
+ membershipIncognito g <> ttyFrom (fromGroup_ g m ms <> maybe "" (\t -> "[" <> t <> "] ") deletedText_)
-fromGroup_ :: GroupInfo -> GroupMember -> Text
-fromGroup_ GroupInfo {localDisplayName = g} GroupMember {localDisplayName = m} =
- "#" <> g <> " " <> m <> "> "
+fromGroup_ :: GroupInfo -> GroupMember -> MessageScope -> Text
+fromGroup_ GroupInfo {localDisplayName = g} GroupMember {localDisplayName = m} ms =
+ "#" <> g <> " " <> m <> fromGroupScope ms <> "> "
+
+fromGroupScope :: MessageScope -> Text
+fromGroupScope = \case
+ MSGroup -> ""
+ MSDirect -> " (direct)"
ttyFrom :: Text -> StyledString
ttyFrom = styled $ colored Yellow
@@ -1757,13 +1787,18 @@ ttyFrom = styled $ colored Yellow
ttyTo :: Text -> StyledString
ttyTo = styled $ colored Cyan
-ttyToGroup :: GroupInfo -> StyledString
-ttyToGroup g@GroupInfo {localDisplayName = n} =
- membershipIncognito g <> ttyTo ("#" <> n <> " ")
+ttyToGroup :: GroupInfo -> Maybe GroupMember -> StyledString
+ttyToGroup g@GroupInfo {localDisplayName = n} dirMem =
+ membershipIncognito g <> ttyTo ("#" <> n <> toDirectMember dirMem <> " ")
-ttyToGroupEdited :: GroupInfo -> StyledString
-ttyToGroupEdited g@GroupInfo {localDisplayName = n} =
- membershipIncognito g <> ttyTo ("#" <> n <> " [edited] ")
+ttyToGroupEdited :: GroupInfo -> Maybe GroupMember -> StyledString
+ttyToGroupEdited g@GroupInfo {localDisplayName = n} dirMem =
+ membershipIncognito g <> ttyTo ("#" <> n <> toDirectMember dirMem <> " [edited] ")
+
+toDirectMember :: Maybe GroupMember -> Text
+toDirectMember = \case
+ Nothing -> ""
+ Just GroupMember {localDisplayName = m} -> " @" <> m <> " (direct)"
ttyFilePath :: FilePath -> StyledString
ttyFilePath = plain
diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs
index 9e5d4fe1c0..de6353d2e0 100644
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -259,7 +259,7 @@ getTermLine cc =
Just s -> do
-- remove condition to always echo virtual terminal
when (printOutput cc) $ do
- -- when True $ do
+ -- when True $ do
name <- userName cc
putStrLn $ name <> ": " <> s
pure s
diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs
index d476285fcd..6c804659e7 100644
--- a/tests/ChatTests/Groups.hs
+++ b/tests/ChatTests/Groups.hs
@@ -8,8 +8,9 @@ import ChatTests.Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Monad (when)
+import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
-import Simplex.Chat.Controller (ChatConfig (..))
+import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
import Simplex.Chat.Protocol (supportedChatVRange)
import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
import Simplex.Chat.Types (GroupMemberRole (..))
@@ -81,6 +82,21 @@ chatGroupTests = do
testNoDirect4 _1 _0 _1 False False False -- False False True
testNoDirect4 _1 _1 _0 False False False
testNoDirect4 _1 _1 _1 False False False
+ describe "group direct messages" $ do
+ it "should send group direct messages" testGroupDirectMessages
+ it "should create group direct messages chat items" testGroupDirectMessagesItems
+ it "should send group direct quotes" testGroupDirectQuotes
+ it "should create group direct quotes chat items" testGroupDirectQuotesItems
+ it "should send group direct XFTP files" testGroupDirectFilesXFTP
+ it "should send group direct SMP files" testGroupDirectFilesSMP
+ it "should cancel sent group direct XFTP file" testGroupDirectCancelFileXFTP
+ it "should send group direct quotes with files" testGroupDirectQuotesFiles
+ it "should update group direct message" testGroupDirectUpdate
+ it "should delete group direct message" testGroupDirectDelete
+ it "should send group direct live message" testGroupDirectLiveMessage
+ it "should send group direct message reactions" testGroupDirectReactions
+ it "should prohibit group direct messages based on preference" testGroupDirectProhibitPreference
+ it "should prohibit group direct messages if peer version doesn't support" testGroupDirectProhibitNotSupported
where
_0 = supportedChatVRange -- don't create direct connections
_1 = groupCreateDirectVRange
@@ -804,7 +820,7 @@ testGroupMessageQuotedReply =
(bob <# "#team alice> hello! how are you?")
(cath <# "#team alice> hello! how are you?")
threadDelay 1000000
- bob `send` "> #team @alice (hello) hello, all good, you?"
+ bob `send` "> #team >@alice (hello) hello, all good, you?"
bob <# "#team > alice hello! how are you?"
bob <## " hello, all good, you?"
concurrently_
@@ -819,7 +835,7 @@ testGroupMessageQuotedReply =
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((1, "hello, all good, you?"), Just (0, "hello! how are you?"))])
alice #$> ("/_get chat #1 count=2", chat', [((1, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (1, "hello! how are you?"))])
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (0, "hello! how are you?"))])
- bob `send` "> #team bob (hello, all good) will tell more"
+ bob `send` "> #team >@bob (hello, all good) will tell more"
bob <# "#team > bob hello, all good, you?"
bob <## " will tell more"
concurrently_
@@ -835,7 +851,7 @@ testGroupMessageQuotedReply =
alice #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))])
cath #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))])
threadDelay 1000000
- cath `send` "> #team bob (hello) hi there!"
+ cath `send` "> #team >@bob (hello) hi there!"
cath <# "#team > bob hello, all good, you?"
cath <## " hi there!"
concurrently_
@@ -891,7 +907,7 @@ testGroupMessageUpdate =
threadDelay 1000000
-- alice, bob: msg id 6, cath: msg id 5
- bob `send` "> #team @alice (hey) hi alice"
+ bob `send` "> #team >@alice (hey) hi alice"
bob <# "#team > alice hey 👋"
bob <## " hi alice"
concurrently_
@@ -918,7 +934,7 @@ testGroupMessageUpdate =
alice #$> ("/_update item #1 " <> msgItemId2 <> " text updating bob's message", id, "cannot update this item")
threadDelay 1000000
- cath `send` "> #team @alice (greetings) greetings!"
+ cath `send` "> #team >@alice (greetings) greetings!"
cath <# "#team > alice greetings 🤝"
cath <## " greetings!"
concurrently_
@@ -994,7 +1010,6 @@ testGroupMessageEditHistory =
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey there")
alice <# "#team [edited] hey there"
- bob <# "#team alice> [edited] hey there"
alice ##> "/item info #team hey"
alice <##. "sent at: "
@@ -1004,10 +1019,7 @@ testGroupMessageEditHistory =
alice .<## ": hey 👋"
alice .<## ": hello!"
bob ##> "/item info #team hey"
- bob <##. "sent at: "
- bob <##. "received at: "
- bob <## "message history:"
- bob .<## ": hey there"
+ bob <## "message not found by text: hey"
testGroupMessageDelete :: HasCallStack => FilePath -> IO ()
testGroupMessageDelete =
@@ -1031,7 +1043,7 @@ testGroupMessageDelete =
threadDelay 1000000
-- alice: msg id 5, bob: msg id 6, cath: msg id 5
- bob `send` "> #team @alice (hello) hi alic"
+ bob `send` "> #team >@alice (hello) hi alic"
bob <# "#team > alice hello!"
bob <## " hi alic"
concurrently_
@@ -1060,14 +1072,10 @@ testGroupMessageDelete =
bob ##> ("/_update item #1 " <> msgItemId3 <> " text hi alice")
bob <# "#team [edited] > alice hello!"
bob <## " hi alice"
- concurrently_
- (alice <# "#team bob> [edited] hi alice")
- ( do
- cath <# "#team bob> [edited] > alice hello!"
- cath <## " hi alice"
- )
+ cath <# "#team bob> [edited] > alice hello!"
+ cath <## " hi alice"
- alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alice"), Nothing)])
+ alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
@@ -2686,3 +2694,534 @@ testNoGroupDirectConns4Members hostVRange mem2VRange mem3VRange mem4VRange noCon
cc1 <## ("no contact " <> name2)
cc2 ##> ("@" <> name1 <> " hi")
cc2 <## ("no contact " <> name1)
+
+testGroupDirectMessages :: HasCallStack => FilePath -> IO ()
+testGroupDirectMessages =
+ testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do
+ createGroup3 "team" alice bob cath
+ connectUsers alice dan
+ addMember "team" alice dan GRMember
+ dan ##> "/j team"
+ concurrentlyN_
+ [ alice <## "#team: dan joined the group",
+ do
+ dan <## "#team: you joined the group"
+ dan
+ <### [ "#team: member bob (Bob) is connected",
+ "#team: member cath (Catherine) is connected"
+ ],
+ aliceAddedDan bob,
+ aliceAddedDan cath
+ ]
+
+ alice #> "#team hi"
+ bob <# "#team alice> hi"
+ cath <# "#team alice> hi"
+ dan <# "#team alice> hi"
+
+ alice `send` "#team @bob hi bob"
+ alice <# "#team @bob (direct) hi bob"
+ bob <# "#team alice (direct)> hi bob"
+
+ bob `send` "#team @alice hi alice"
+ bob <# "#team @alice (direct) hi alice"
+ alice <# "#team bob (direct)> hi alice"
+
+ dan #> "#team hello"
+ alice <# "#team dan> hello"
+ bob <# "#team dan> hello"
+ cath <# "#team dan> hello"
+
+ bob `send` "#team @cath hi cath"
+ bob <# "#team @cath (direct) hi cath"
+ cath <# "#team bob (direct)> hi cath"
+
+ cath `send` "#team @bob hello bob"
+ cath <# "#team @bob (direct) hello bob"
+ bob <# "#team cath (direct)> hello bob"
+ where
+ aliceAddedDan :: HasCallStack => TestCC -> IO ()
+ aliceAddedDan cc = do
+ cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
+ cc <## "#team: new member dan is connected"
+
+testGroupDirectMessagesItems :: HasCallStack => FilePath -> IO ()
+testGroupDirectMessagesItems =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+ threadDelay 1000000
+
+ alice #> "#team hi"
+ bob <# "#team alice> hi"
+ cath <# "#team alice> hi"
+ threadDelay 1000000
+
+ alice `send` "#team @bob hi bob"
+ alice <# "#team @bob (direct) hi bob"
+ bob <# "#team alice (direct)> hi bob"
+ threadDelay 1000000
+
+ bob `send` "#team @alice hi alice"
+ bob <# "#team @alice (direct) hi alice"
+ alice <# "#team bob (direct)> hi alice"
+ threadDelay 1000000
+
+ alice #$> ("/_get chat #1 count=4", mapChat, [(0, "", "connected"), (1, "", "hi"), (1, "bob", "hi bob"), (0, "bob", "hi alice")])
+ bob #$> ("/_get chat #1 count=4", mapChat, [(0, "", "connected"), (0, "", "hi"), (0, "alice", "hi bob"), (1, "alice", "hi alice")])
+ cath #$> ("/_get chat #1 count=2", mapChat, [(0, "", "connected"), (0, "", "hi")])
+ where
+ mapChat = map (\(a, _, _) -> a) . chat'''
+
+testGroupDirectQuotes :: HasCallStack => FilePath -> IO ()
+testGroupDirectQuotes =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+
+ alice #> "#team 1-g-a"
+ bob <# "#team alice> 1-g-a"
+ cath <# "#team alice> 1-g-a"
+
+ bob #> "#team 2-g-b"
+ alice <# "#team bob> 2-g-b"
+ cath <# "#team bob> 2-g-b"
+
+ cath #> "#team 3-g-c"
+ alice <# "#team cath> 3-g-c"
+ bob <# "#team cath> 3-g-c"
+
+ alice `send` "#team @bob 4-p-ab"
+ alice <# "#team @bob (direct) 4-p-ab"
+ bob <# "#team alice (direct)> 4-p-ab"
+
+ bob `send` "#team @alice 5-p-ba"
+ bob <# "#team @alice (direct) 5-p-ba"
+ alice <# "#team bob (direct)> 5-p-ba"
+
+ alice `send` "#team @cath 6-p-ac"
+ alice <# "#team @cath (direct) 6-p-ac"
+ cath <# "#team alice (direct)> 6-p-ac"
+
+ cath `send` "#team @alice 7-p-ca"
+ cath <# "#team @alice (direct) 7-p-ca"
+ alice <# "#team cath (direct)> 7-p-ca"
+
+ -- quotes
+
+ alice `send` "> #team @bob (1-g-a) 8-pq-ab"
+ alice <# "#team @bob (direct) > alice 1-g-a"
+ alice <## " 8-pq-ab"
+ bob <# "#team alice (direct)> > alice 1-g-a"
+ bob <## " 8-pq-ab"
+
+ alice `send` "> #team @bob (2-g-b) 9-pq-ab"
+ alice <# "#team @bob (direct) > bob 2-g-b"
+ alice <## " 9-pq-ab"
+ bob <# "#team alice (direct)> > bob 2-g-b"
+ bob <## " 9-pq-ab"
+
+ alice `send` "> #team >@cath @bob (3-g-c) 10-pq-ab"
+ alice <# "#team @bob (direct) > cath 3-g-c"
+ alice <## " 10-pq-ab"
+ bob <# "#team alice (direct)> > cath 3-g-c"
+ bob <## " 10-pq-ab"
+
+ alice `send` "> #team @bob (4-p-ab) 11-pq-ab"
+ alice <# "#team @bob (direct) > alice 4-p-ab"
+ alice <## " 11-pq-ab"
+ bob <# "#team alice (direct)> > alice 4-p-ab"
+ bob <## " 11-pq-ab"
+
+ alice `send` "> #team >@bob @bob (5-p-ba) 12-pq-ab"
+ alice <# "#team @bob (direct) > bob 5-p-ba"
+ alice <## " 12-pq-ab"
+ bob <# "#team alice (direct)> > bob 5-p-ba"
+ bob <## " 12-pq-ab"
+
+ alice `send` "> #team @bob (6-p-ac) 13-pq-ab"
+ alice <## "> #team @bob (6-p-ac) 13-pq-ab"
+ alice <## "invalid message reply"
+
+ alice `send` "> #team @bob (7-p-ca) 14-pq-ab"
+ alice <## "> #team @bob (7-p-ca) 14-pq-ab"
+ alice <## "invalid message reply"
+
+ alice `send` "> #team (4-p-ab) 15-gq-a"
+ alice <## "> #team (4-p-ab) 15-gq-a"
+ alice <## "invalid message reply"
+
+ alice `send` "> #team (5-p-ba) 16-gq-a"
+ alice <## "> #team (5-p-ba) 16-gq-a"
+ alice <## "invalid message reply"
+
+testGroupDirectQuotesItems :: HasCallStack => FilePath -> IO ()
+testGroupDirectQuotesItems =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+
+ alice #> "#team 1-g-a"
+ bob <# "#team alice> 1-g-a"
+ cath <# "#team alice> 1-g-a"
+
+ alice `send` "#team @bob 2-p-ab"
+ alice <# "#team @bob (direct) 2-p-ab"
+ bob <# "#team alice (direct)> 2-p-ab"
+
+ bob `send` "#team @alice 3-p-ba"
+ bob <# "#team @alice (direct) 3-p-ba"
+ alice <# "#team bob (direct)> 3-p-ba"
+ threadDelay 1000000
+
+ -- quotes
+
+ alice `send` "> #team @bob (1-g-a) 4-pq-ab"
+ alice <# "#team @bob (direct) > alice 1-g-a"
+ alice <## " 4-pq-ab"
+ bob <# "#team alice (direct)> > alice 1-g-a"
+ bob <## " 4-pq-ab"
+ threadDelay 1000000
+
+ alice `send` "> #team @bob (2-p-ab) 5-pq-ab"
+ alice <# "#team @bob (direct) > alice 2-p-ab"
+ alice <## " 5-pq-ab"
+ bob <# "#team alice (direct)> > alice 2-p-ab"
+ bob <## " 5-pq-ab"
+ threadDelay 1000000
+
+ alice `send` "> #team >@bob @bob (3-p-ba) 6-pq-ab"
+ alice <# "#team @bob (direct) > bob 3-p-ba"
+ alice <## " 6-pq-ab"
+ bob <# "#team alice (direct)> > bob 3-p-ba"
+ bob <## " 6-pq-ab"
+
+ alice
+ #$> ( "/_get chat #1 count=3",
+ mapChat,
+ [ ((1, "bob", "4-pq-ab"), Just (1, "group", "1-g-a")),
+ ((1, "bob", "5-pq-ab"), Just (1, "direct", "2-p-ab")),
+ ((1, "bob", "6-pq-ab"), Just (0, "direct", "3-p-ba"))
+ ]
+ )
+ bob
+ #$> ( "/_get chat #1 count=3",
+ mapChat,
+ [ ((0, "alice", "4-pq-ab"), Just (0, "group", "1-g-a")),
+ ((0, "alice", "5-pq-ab"), Just (0, "direct", "2-p-ab")),
+ ((0, "alice", "6-pq-ab"), Just (1, "direct", "3-p-ba"))
+ ]
+ )
+ where
+ mapChat = map (\(a, b, _) -> (a, b)) . chat'''
+
+testGroupDirectFilesXFTP :: HasCallStack => FilePath -> IO ()
+testGroupDirectFilesXFTP =
+ testChatCfg3 cfg aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ withXFTPServer $ do
+ createGroup3 "team" alice bob cath
+ threadDelay 1000000
+
+ alice `send` "/f #team @bob ./tests/fixtures/test.pdf"
+ alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [
/ | ] to receive it"
+ alice <## "completed uploading file 1 (test.pdf) for #team @bob (direct)"
+
+ bob ##> "/fr 1 ./tests/tmp"
+ bob
+ <### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
+ "started receiving file 1 (test.pdf) from alice"
+ ]
+ bob <## "completed receiving file 1 (test.pdf) from alice"
+
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
+
+ cath / 50000
+ cath ##> "/fr 1 ./tests/tmp"
+ cath <##. "chat db error: SEUserNotFoundByFileId"
+
+ alice `send` "/f #team @cath ./tests/fixtures/test.jpg"
+ alice <# "/f #team @cath (direct) ./tests/fixtures/test.jpg"
+ alice <## "use /fc 2 to cancel sending"
+ cath <# "#team alice (direct)> sends file test.jpg (136.5 KiB / 139737 bytes)"
+ cath <## "use /fr 1 [/ | ] to receive it"
+ alice <## "completed uploading file 2 (test.jpg) for #team @cath (direct)"
+
+ cath ##> "/fr 1 ./tests/tmp"
+ cath
+ <### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
+ "started receiving file 1 (test.jpg) from alice"
+ ]
+ cath <## "completed receiving file 1 (test.jpg) from alice"
+
+ src2 <- B.readFile "./tests/fixtures/test.jpg"
+ dest2 <- B.readFile "./tests/tmp/test.jpg"
+ dest2 `shouldBe` src2
+
+ bob / 50000
+
+ alice #$> ("/_get chat #1 count=2", mapChat, [((1, "bob", ""), Just "./tests/fixtures/test.pdf"), ((1, "cath", ""), Just "./tests/fixtures/test.jpg")])
+ bob #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.pdf")])
+ cath #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.jpg")])
+ where
+ cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+ mapChat = map (\(a, _, c) -> (a, c)) . chat'''
+
+testGroupDirectFilesSMP :: HasCallStack => FilePath -> IO ()
+testGroupDirectFilesSMP =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+ threadDelay 1000000
+
+ alice `send` "/f #team @bob ./tests/fixtures/test.pdf"
+ alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ bob ##> "/fr 1 ./tests/tmp"
+ bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+ concurrently_
+ (alice <## "started sending file 1 (test.pdf) to bob")
+ (bob <## "started receiving file 1 (test.pdf) from alice")
+ concurrently_
+ (alice <## "completed sending file 1 (test.pdf) to bob")
+ (bob <## "completed receiving file 1 (test.pdf) from alice")
+
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
+
+ cath / 50000
+ cath ##> "/fr 1 ./tests/tmp"
+ cath <##. "chat db error: SEUserNotFoundByFileId"
+
+ alice `send` "/f #team @cath ./tests/fixtures/test.jpg"
+ alice <# "/f #team @cath (direct) ./tests/fixtures/test.jpg"
+ alice <## "use /fc 2 to cancel sending"
+ cath <# "#team alice (direct)> sends file test.jpg (136.5 KiB / 139737 bytes)"
+ cath <## "use /fr 1 [/ | ] to receive it"
+ cath ##> "/fr 1 ./tests/tmp"
+ cath <## "saving file 1 from alice to ./tests/tmp/test.jpg"
+ concurrently_
+ (alice <## "started sending file 2 (test.jpg) to cath")
+ (cath <## "started receiving file 1 (test.jpg) from alice")
+ concurrently_
+ (alice <## "completed sending file 2 (test.jpg) to cath")
+ (cath <## "completed receiving file 1 (test.jpg) from alice")
+
+ src2 <- B.readFile "./tests/fixtures/test.jpg"
+ dest2 <- B.readFile "./tests/tmp/test.jpg"
+ dest2 `shouldBe` src2
+
+ bob / 50000
+
+ alice #$> ("/_get chat #1 count=2", mapChat, [((1, "bob", ""), Just "./tests/fixtures/test.pdf"), ((1, "cath", ""), Just "./tests/fixtures/test.jpg")])
+ bob #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.pdf")])
+ cath #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.jpg")])
+ where
+ mapChat = map (\(a, _, c) -> (a, c)) . chat'''
+
+testGroupDirectCancelFileXFTP :: HasCallStack => FilePath -> IO ()
+testGroupDirectCancelFileXFTP =
+ testChatCfg3 cfg aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ withXFTPServer $ do
+ createGroup3 "team" alice bob cath
+
+ alice `send` "/f #team @bob ./tests/fixtures/test.pdf"
+ alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ alice <## "completed uploading file 1 (test.pdf) for #team @bob (direct)"
+
+ cath / 50000
+
+ alice ##> "/fc 1"
+ alice <## "cancelled sending file 1 (test.pdf) to bob"
+ bob <## "alice cancelled sending file 1 (test.pdf)"
+
+ cath / 50000
+
+ bob ##> "/fr 1 ./tests/tmp"
+ bob <## "file cancelled: test.pdf"
+
+ cath ##> "/fr 1 ./tests/tmp"
+ cath <##. "chat db error: SEUserNotFoundByFileId"
+ where
+ cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupDirectQuotesFiles :: HasCallStack => FilePath -> IO ()
+testGroupDirectQuotesFiles =
+ testChatCfg3 cfg aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ withXFTPServer $ do
+ createGroup3 "team" alice bob cath
+ threadDelay 1000000
+
+ bob `send` "#team @alice hi alice"
+ bob <# "#team @alice (direct) hi alice"
+ alice <# "#team bob (direct)> hi alice"
+ threadDelay 1000000
+
+ msgItemId1 <- lastItemId alice
+ alice ##> ("/_send #1 @2 json {\"filePath\": \"./tests/fixtures/test.pdf\", \"quotedItemId\": " <> msgItemId1 <> ", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}")
+ alice <# "#team @bob (direct) > bob hi alice"
+ alice <## " hey bob"
+ alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
+ alice <## "use /fc 1 to cancel sending"
+ bob <# "#team alice (direct)> > bob hi alice"
+ bob <## " hey bob"
+ bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
+ bob <## "use /fr 1 [/ | ] to receive it"
+ alice <## "completed uploading file 1 (test.pdf) for #team @bob (direct)"
+
+ bob ##> "/fr 1 ./tests/tmp"
+ bob
+ <### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
+ "started receiving file 1 (test.pdf) from alice"
+ ]
+ bob <## "completed receiving file 1 (test.pdf) from alice"
+
+ src <- B.readFile "./tests/fixtures/test.pdf"
+ dest <- B.readFile "./tests/tmp/test.pdf"
+ dest `shouldBe` src
+
+ cath / 50000
+ cath ##> "/fr 1 ./tests/tmp"
+ cath <##. "chat db error: SEUserNotFoundByFileId"
+
+ alice
+ #$> ( "/_get chat #1 count=2",
+ chat''',
+ [ ((0, "bob", "hi alice"), Nothing, Nothing),
+ ((1, "bob", "hey bob"), Just (0, "direct", "hi alice"), Just "./tests/fixtures/test.pdf")
+ ]
+ )
+ bob
+ #$> ( "/_get chat #1 count=2",
+ chat''',
+ [ ((1, "alice", "hi alice"), Nothing, Nothing),
+ ((0, "alice", "hey bob"), Just (1, "direct", "hi alice"), Just "./tests/tmp/test.pdf")
+ ]
+ )
+ cath #$> ("/_get chat #1 count=1", chat''', [((0, "", "connected"), Nothing, Nothing)])
+ where
+ cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupDirectUpdate :: HasCallStack => FilePath -> IO ()
+testGroupDirectUpdate =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+
+ alice `send` "#team @bob hi bob"
+ alice <# "#team @bob (direct) hi bob"
+ bob <# "#team alice (direct)> hi bob"
+
+ msgItemId1 <- lastItemId alice
+ alice ##> ("/_update item #1 " <> msgItemId1 <> " text hey 👋")
+ alice <# "#team @bob (direct) [edited] hey 👋"
+ bob <# "#team alice (direct)> [edited] hey 👋"
+ cath / 50000
+
+ alice ##> "! #team (hey 👋) hello there"
+ alice <# "#team @bob (direct) [edited] hello there"
+ bob <# "#team alice (direct)> [edited] hello there"
+ cath / 50000
+
+testGroupDirectDelete :: HasCallStack => FilePath -> IO ()
+testGroupDirectDelete =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+
+ alice `send` "#team @bob hi bob"
+ alice <# "#team @bob (direct) hi bob"
+ bob <# "#team alice (direct)> hi bob"
+
+ msgItemId1 <- lastItemId alice
+ alice #$> ("/_delete item #1 " <> msgItemId1 <> " broadcast", id, "message marked deleted")
+ bob <# "#team alice (direct)> [marked deleted] hi bob"
+ cath / 50000
+
+testGroupDirectLiveMessage :: HasCallStack => FilePath -> IO ()
+testGroupDirectLiveMessage =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+
+ alice `send` "/live #team @bob hello"
+ msgItemId1 <- lastItemId alice
+ bob <#. "#team alice (direct)> [LIVE started]"
+ alice ##> ("/_update item #1 " <> msgItemId1 <> " text hello there")
+ alice <# "#team @bob (direct) [LIVE] hello there"
+ bob <# "#team alice (direct)> [LIVE ended] hello there"
+ cath / 50000
+
+testGroupDirectReactions :: HasCallStack => FilePath -> IO ()
+testGroupDirectReactions =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3 "team" alice bob cath
+
+ alice `send` "#team @bob hi bob"
+ alice <# "#team @bob (direct) hi bob"
+ bob <# "#team alice (direct)> hi bob"
+
+ bob ##> "+1 #team hi"
+ bob <## "added 👍"
+ alice <# "#team bob (direct)> > alice hi bob"
+ alice <## " + 👍"
+ cath / 50000
+
+ alice ##> "+^ #team hi"
+ alice <## "added 🚀"
+ bob <# "#team alice (direct)> > alice hi bob"
+ bob <## " + 🚀"
+ cath / 50000
+
+testGroupDirectProhibitPreference :: HasCallStack => FilePath -> IO ()
+testGroupDirectProhibitPreference =
+ testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+ createGroup3' "team" alice bob cath GRMember
+
+ alice ##> "/set direct #team off"
+ alice <## "updated group preferences:"
+ alice <## "Direct messages: off"
+ directProhibited bob
+ directProhibited cath
+
+ bob ##> "#team @cath hi cath"
+ bob <## "bad chat command: direct messages not allowed"
+
+ cath ##> "#team @bob hi cath"
+ cath <## "bad chat command: direct messages not allowed"
+
+ alice ##> "/mr team bob admin"
+ alice <## "#team: you changed the role of bob from member to admin"
+ concurrentlyN_
+ [ bob <## "#team: alice changed your role from member to admin",
+ cath <## "#team: alice changed the role of bob from member to admin"
+ ]
+
+ -- admin can send & can send to admin
+
+ bob `send` "#team @cath hi cath, as admin"
+ bob <# "#team @cath (direct) hi cath, as admin"
+ cath <# "#team bob (direct)> hi cath, as admin"
+
+ cath `send` "#team @bob hi bob, to admin"
+ cath <# "#team @bob (direct) hi bob, to admin"
+ bob <# "#team cath (direct)> hi bob, to admin"
+ where
+ directProhibited :: HasCallStack => TestCC -> IO ()
+ directProhibited cc = do
+ cc <## "alice updated group #team:"
+ cc <## "updated group preferences:"
+ cc <## "Direct messages: off"
+
+testGroupDirectProhibitNotSupported :: HasCallStack => FilePath -> IO ()
+testGroupDirectProhibitNotSupported tmp =
+ withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+ withNewTestChat tmp "bob" bobProfile $ \bob -> do
+ withNewTestChatCfg tmp testCfg {chatVRange = mkVersionRange 1 1} "cath" cathProfile $ \cath -> do
+ createGroup3 "team" alice bob cath
+
+ bob ##> "#team @cath hi cath"
+ bob <## "peer chat protocol version range incompatible"
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index c120d661ff..05075f5b5f 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -181,7 +181,12 @@ chatF :: String -> [((Int, String), Maybe String)]
chatF = map (\(a, _, c) -> (a, c)) . chat''
chat'' :: String -> [((Int, String), Maybe (Int, String), Maybe String)]
-chat'' = read
+chat'' = map (\(a, b, c) -> (mapNoDirect a, mapNoDirect <$> b, c)) . chat'''
+ where
+ mapNoDirect (a1, _, a3) = (a1, a3)
+
+chat''' :: String -> [((Int, String, String), Maybe (Int, String, String), Maybe String)]
+chat''' = read
chatFeatures :: [(Int, String)]
chatFeatures = map (\(a, _, _) -> a) chatFeatures''
@@ -456,27 +461,33 @@ showName (TestCC ChatController {currentUser} _ _ _ _ _) = do
pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName
createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
-createGroup2 gName cc1 cc2 = do
+createGroup2 gName cc1 cc2 = createGroup2' gName cc1 cc2 GRAdmin
+
+createGroup2' :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
+createGroup2' gName cc1 cc2 memberRole = do
connectUsers cc1 cc2
name2 <- userName cc2
cc1 ##> ("/g " <> gName)
cc1 <## ("group #" <> gName <> " is created")
cc1 <## ("to add members use /a " <> gName <> " or /create link #" <> gName)
- addMember gName cc1 cc2 GRAdmin
+ addMember gName cc1 cc2 memberRole
cc2 ##> ("/j " <> gName)
concurrently_
(cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
(cc2 <## ("#" <> gName <> ": you joined the group"))
createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
-createGroup3 gName cc1 cc2 cc3 = do
- createGroup2 gName cc1 cc2
+createGroup3 gName cc1 cc2 cc3 = createGroup3' gName cc1 cc2 cc3 GRAdmin
+
+createGroup3' :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> GroupMemberRole -> IO ()
+createGroup3' gName cc1 cc2 cc3 memberRole = do
+ createGroup2' gName cc1 cc2 memberRole
connectUsers cc1 cc3
name1 <- userName cc1
name3 <- userName cc3
sName2 <- showName cc2
sName3 <- showName cc3
- addMember gName cc1 cc3 GRAdmin
+ addMember gName cc1 cc3 memberRole
cc3 ##> ("/j " <> gName)
concurrentlyN_
[ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"),
diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs
index 3acc78e7d8..f9421f6914 100644
--- a/tests/ProtocolTests.hs
+++ b/tests/ProtocolTests.hs
@@ -57,7 +57,7 @@ testConnReq = CRInvitationUri connReqData testE2ERatchetParams
quotedMsg :: QuotedMsg
quotedMsg =
QuotedMsg
- (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing)
+ (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing Nothing)
$ MCText "hello there!"
(==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
@@ -105,10 +105,13 @@ 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 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) Nothing))
+ it "x.msg.new simple text - direct message scope" $
+ "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"scope\":\"direct\"}}"
+ #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing Nothing (Just MSDirect)))
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))
@@ -130,27 +133,41 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
chatInitialVRange
(Just $ SharedMsgId "\1\2\3\4")
(XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing)))
+ it "x.msg.new quote - direct referenced message scope" $
+ "{\"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\",\"msgScope\":\"direct\"}}}}"
+ ##==## ChatMessage
+ chatInitialVRange
+ (Just $ SharedMsgId "\1\2\3\4")
+ ( XMsgNew
+ ( MCQuote
+ ( QuotedMsg
+ (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing (Just MSDirect))
+ $ MCText "hello there!"
+ )
+ (extMsgContent (MCText "hello to you too") Nothing)
+ )
+ )
it "x.msg.new quote - timed message TTL" $
"{\"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\"}},\"ttl\":3600}}"
##==## 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 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) Nothing)))
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 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) Nothing))
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})))
From 4b88a2abfd14fb2704aa10f24b3e185eb2e50ac1 Mon Sep 17 00:00:00 2001
From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com>
Date: Mon, 11 Sep 2023 22:32:31 +0300
Subject: [PATCH 03/17] multiplatform: voice playing fix (#3046)
---
.../chat/simplex/common/platform/RecAndPlay.android.kt | 6 +++---
.../kotlin/chat/simplex/common/model/ChatModel.kt | 4 ++++
.../kotlin/chat/simplex/common/platform/RecAndPlay.kt | 2 +-
.../chat/simplex/common/platform/RecAndPlay.desktop.kt | 2 +-
4 files changed, 9 insertions(+), 5 deletions(-)
diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt
index ebc1b416b5..5996193abb 100644
--- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt
+++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/RecAndPlay.android.kt
@@ -134,7 +134,7 @@ actual object AudioPlayer: AudioPlayerInterface {
// Returns real duration of the track
private fun start(fileSource: CryptoFile, seek: Int? = null, onProgressUpdate: (position: Int?, state: TrackState) -> Unit): Int? {
- val absoluteFilePath = getAppFilePath(fileSource.filePath)
+ val absoluteFilePath = if (fileSource.isAbsolutePath) fileSource.filePath else getAppFilePath(fileSource.filePath)
if (!File(absoluteFilePath).exists()) {
Log.e(TAG, "No such file: ${fileSource.filePath}")
return null
@@ -272,10 +272,10 @@ actual object AudioPlayer: AudioPlayerInterface {
}
}
- override fun duration(filePath: String): Int? {
+ override fun duration(unencryptedFilePath: String): Int? {
var res: Int? = null
kotlin.runCatching {
- helperPlayer.setDataSource(filePath)
+ helperPlayer.setDataSource(unencryptedFilePath)
helperPlayer.prepare()
helperPlayer.start()
helperPlayer.stop()
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
index fc0867aad6..cdabe71449 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
@@ -2089,6 +2089,10 @@ data class CryptoFile(
val filePath: String,
val cryptoArgs: CryptoFileArgs?
) {
+
+ val isAbsolutePath: Boolean
+ get() = File(filePath).isAbsolute
+
companion object {
fun plain(f: String): CryptoFile = CryptoFile(f, null)
}
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/RecAndPlay.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/RecAndPlay.kt
index 2d6bb2a371..0e0f769487 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/RecAndPlay.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/RecAndPlay.kt
@@ -29,7 +29,7 @@ interface AudioPlayerInterface {
fun stop(fileName: String?)
fun pause(audioPlaying: MutableState, pro: MutableState)
fun seekTo(ms: Int, pro: MutableState, filePath: String?)
- fun duration(filePath: String): Int?
+ fun duration(unencryptedFilePath: String): Int?
}
expect object AudioPlayer: AudioPlayerInterface
diff --git a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/RecAndPlay.desktop.kt b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/RecAndPlay.desktop.kt
index 6e85ea91c6..8e6a7d7ef9 100644
--- a/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/RecAndPlay.desktop.kt
+++ b/apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/platform/RecAndPlay.desktop.kt
@@ -42,7 +42,7 @@ actual object AudioPlayer: AudioPlayerInterface {
/*LALAL*/
}
- override fun duration(filePath: String): Int? {
+ override fun duration(unencryptedFilePath: String): Int? {
/*LALAL*/
return null
}
From 75f18bc5f05fd1777949cd9a2213998a62d714b6 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 12 Sep 2023 17:24:41 +0400
Subject: [PATCH 04/17] docs: group member contacts rfc (#3049)
---
docs/rfcs/2023-09-12-group-member-contacts.md | 56 +++++++++++++++++++
1 file changed, 56 insertions(+)
create mode 100644 docs/rfcs/2023-09-12-group-member-contacts.md
diff --git a/docs/rfcs/2023-09-12-group-member-contacts.md b/docs/rfcs/2023-09-12-group-member-contacts.md
new file mode 100644
index 0000000000..0d403b0641
--- /dev/null
+++ b/docs/rfcs/2023-09-12-group-member-contacts.md
@@ -0,0 +1,56 @@
+# Groups member contacts
+
+## Problem
+
+Ability to send direct messages to group members, w/t creating additional direct connections, while keeping existing UX of separate conversations.
+
+## Solution
+
+### Protocol
+
+Same changes on chat protocol level as for direct messages:
+
+```haskell
+data MessageScope = MSGroup | MSDirect
+
+-- ExtMsgContent extended with scope
+data ExtMsgContent = ExtMsgContent
+ { ...
+ scope :: Maybe MessageScope
+ }
+```
+
+Changes to MsgRef are not necessary - it would be impossible to quote group message directly to member contact.
+
+### Model
+
+If member doesn't have existing contact (e.g. legacy, merged or "member contact" created before), button "Send direct message" / "Open direct chat" in UI would create a new "member contact" record in contacts table that would use the same connection as group member.
+
+New API:
+
+```haskell
+APICreateMemberContact GroupId GroupMemberId
+```
+
+- would create a new contact record and assign contact_id to group_member record
+- should be unmergeable so that the same connection is not used for member across groups
+ - flag
+ - or group_member_id in contacts table
+- member removal (member leaves or removed) and deletion (group is deleted) should check if "member contact" exists for the same connection, if yes connection should be kept
+- contact deletion should also check if member exists
+- due to ON DELETE CASCADE constraints entity id should be first set to null before deleting contact/member record
+
+On receiving group message with MSDirect scope, if "member contact" doesn't exist it should be created (same as above).
+
+What if member record already had regular contact assigned? (a contact with a separate connection and no group_member_id) It can happen if merge completed for these members previously, and one of the members deleted contact; or if merge has only completed for one of members.
+
+- Assigning chat items received as "member contact" to a regular contact would mix messages from different connections in the same conversation. This would practically be indistinguishable in UI, but would further complicate understanding of connection level errors.
+- Replacing contact_id for group_members record would seem to user as if previous messages were lost when chat is entered via "open direct chat" button, unless there's an indication inside this new chat that an old contact exists separately (requires yet additional field on contact - main_contact_id?).
+
+When next messages are received read connection entity based on message scope? (parameterize getConnectionEntity, toConnection with message scope). Move message scope on a level above ExtMsgContent? If it's on AChatMsgEvent level - this would allow only MSG agent messages and not make it a fully fledged connection entity. Should "member contact" be able to receive any messages other than XMsgNew and messages referring by shared msg id? If not, maybe it shouldn't be treated as connection entity and instead "member contact" record should be read ad-hoc when processing these messages (for example see processGroupScopeMsg for group direct message). For example, should "member contacts" be available for inviting to other groups? Probably not - if they were, connection established in one group would be reused in another group.
+
+We could also make distinction between regular contacts and "member contacts" in chat list - e.g. show both group and member avatar/icon, or include group name in conversation name. This would also improve clarity for users which contacts were created for which reason and to better understand consequences to deleting it.
+
+TODO:
+
+We should also double check that removed members messages are dropped if received - right now their connections are deleted so it's practically not possible for them to send after being removed; if their connection is kept for "member contact" purpose though, they would still be able to send group messages.
From 01f99baaac4b8c25b288fb77f5163809fe5189b0 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 12 Sep 2023 17:36:47 +0400
Subject: [PATCH 05/17] Revert "core: direct messages in group (#2994)"
This reverts commit 5fddf64adb51f86fe8a8fb26e0cb8970dc8b7847.
---
simplex-chat.cabal | 1 -
src/Simplex/Chat.hs | 585 +++++++-----------
src/Simplex/Chat/Bot.hs | 2 +-
src/Simplex/Chat/Controller.hs | 51 +-
src/Simplex/Chat/Messages.hs | 79 +--
.../M20230904_item_direct_group_member_id.hs | 24 -
src/Simplex/Chat/Migrations/chat_schema.sql | 7 +-
src/Simplex/Chat/Protocol.hs | 39 +-
src/Simplex/Chat/Store/Messages.hs | 154 ++---
src/Simplex/Chat/Store/Migrations.hs | 4 +-
src/Simplex/Chat/Terminal/Input.hs | 18 +-
src/Simplex/Chat/Terminal/Output.hs | 2 +-
src/Simplex/Chat/Types.hs | 4 +-
src/Simplex/Chat/View.hs | 123 ++--
tests/ChatClient.hs | 2 +-
tests/ChatTests/Groups.hs | 577 +----------------
tests/ChatTests/Utils.hs | 23 +-
tests/ProtocolTests.hs | 31 +-
18 files changed, 428 insertions(+), 1298 deletions(-)
delete mode 100644 src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 35e01e7bca..ebd3d1d646 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -111,7 +111,6 @@ library
Simplex.Chat.Migrations.M20230827_file_encryption
Simplex.Chat.Migrations.M20230829_connections_chat_vrange
Simplex.Chat.Migrations.M20230903_connections_to_subscribe
- Simplex.Chat.Migrations.M20230904_item_direct_group_member_id
Simplex.Chat.Mobile
Simplex.Chat.Mobile.File
Simplex.Chat.Mobile.Shared
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 9522d22180..49c5fc94ed 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -540,8 +540,8 @@ processChatCommand = \case
memStatuses -> pure $ Just $ map (uncurry MemberDeliveryStatus) memStatuses
_ -> pure Nothing
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses}
- APISendMessage sendRef live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case sendRef of
- SRDirect chatId -> do
+ APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of
+ CTDirect -> do
ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId
assertDirectAllowed user MDSnd ct XMsgNew_
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
@@ -567,7 +567,7 @@ processChatCommand = \case
(fileSize, fileMode) <- checkSndFile mc file 1
case fileMode of
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
- SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ SDDirect ct
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ CGContact ct
where
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
@@ -590,38 +590,36 @@ processChatCommand = \case
pure (fileInvitation, ciFile, ft)
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
prepareMsg fInv_ timed_ = case quotedItemId_ of
- Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) Nothing), Nothing)
+ Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
Just quotedItemId -> do
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getDirectChatItem db user chatId quotedItemId
(origQmc, qd, sent) <- quoteData qci
- let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing, msgScope = Nothing}
+ let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
qmc = quoteContent 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) Nothing), Just quotedItem)
+ pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
where
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True)
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
quoteData _ = throwChatError CEInvalidQuote
- SRGroup chatId directMemberId -> do
- gInfo <- withStore $ \db -> getGroupInfo db user chatId
- directMember <- forM directMemberId $ \dmId -> withStore $ \db -> getGroupMember db user chatId dmId
- assertGroupSendAllowed gInfo directMember
- send gInfo directMember
+ CTGroup -> do
+ g@(Group gInfo _) <- withStore $ \db -> getGroup db user chatId
+ assertUserGroupRole gInfo GRAuthor
+ send g
where
- send gInfo@GroupInfo {groupId, membership, localDisplayName = gName} directMember
+ send g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms)
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
| otherwise = do
- ms <- getReceivingMembers user gInfo directMember
- (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo ms (length ms)
+ (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL
- (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership directMember
+ (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
- ci <- saveSndChatItem' user (CDGroupSnd gInfo directMember) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
+ ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
withStore' $ \db ->
forM_ sentToMembers $ \GroupMember {groupMemberId} ->
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
@@ -630,12 +628,12 @@ processChatCommand = \case
setActive $ ActiveG gName
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
- setupSndFileTransfer :: GroupInfo -> [GroupMember] -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
- setupSndFileTransfer gInfo ms n = forM file_ $ \file -> do
+ setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
+ setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
(fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n
case fileMode of
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
- SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ SDGroup gInfo ms
+ SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup g
where
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
@@ -659,44 +657,25 @@ processChatCommand = \case
void . withStore' $ \db -> createSndGroupInlineFT db m conn ft
sendMemberFileInline m conn ft sharedMsgId
processMember _ = pure ()
- prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> Maybe GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
- prepareMsg fInv_ timed_ membership directMember = case quotedItemId_ of
- Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) (Just msgScope)), Nothing)
+ prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
+ prepareMsg fInv_ timed_ membership = case quotedItemId_ of
+ Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
Just quotedItemId -> do
- CChatItem _ qci@ChatItem {chatDir = quoteChatDir, meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
+ CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
- let qMsgScope = directMemberToMsgScope $ ciDirDirectMember quoteChatDir
- (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership qMsgScope
- let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId, msgScope = Just qMsgScope}
+ (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
+ let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
qmc = quoteContent origQmc file
- quotedItem = CIQuote {chatDir = qd, itemId = Just $ chatItemId' qci, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
- pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live) (Just msgScope)), Just quotedItem)
+ 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)
where
- msgScope = directMemberToMsgScope directMember
- quoteData :: ChatItem c d -> GroupMember -> MessageScope -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
- quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ _ =
- throwChatError CEInvalidQuote
- quoteData ChatItem {chatDir = qChatDir@(CIGroupSnd _), content = CISndMsgContent qmc} membership' qMsgScope =
- checkDirDirectMember qChatDir $ pure (qmc, CIQGroupSnd qMsgScope, True, membership')
- quoteData ChatItem {chatDir = qChatDir@(CIGroupRcv m _), content = CIRcvMsgContent qmc} _ qMsgScope =
- checkDirDirectMember qChatDir $ pure (qmc, CIQGroupRcv (Just m) qMsgScope, False, m)
- quoteData _ _ _ =
- throwChatError CEInvalidQuote
- -- can quote:
- -- - group message to group (Nothing, Nothing)
- -- - group message to direct member (Nothing, Just)
- -- - direct message to the same direct member (Just, Just, same Id)
- -- can't quote:
- -- - direct message to group (Just, Nothing)
- -- - direct message to another direct member (Just, Just, different Id)
- checkDirDirectMember :: CIDirection 'CTGroup d -> m a -> m a
- checkDirDirectMember quoteChatDir a = case (ciDirDirectMember quoteChatDir, directMember) of
- (Nothing, Nothing) -> a
- (Nothing, Just _) -> a
- (Just _, Nothing) -> throwChatError CEInvalidQuote
- (Just GroupMember {groupMemberId = dirDirectMemId}, Just GroupMember {groupMemberId = directMemId})
- | directMemId == dirDirectMemId -> a
- | otherwise -> throwChatError CEInvalidQuote
+ quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
+ quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
+ 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
+ CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
+ CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
where
quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
quoteContent qmc ciFile_
@@ -721,8 +700,8 @@ processChatCommand = \case
qText = msgContentText qmc
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
qTextOrFile = if T.null qText then qFileName else qText
- xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> SendDirection -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
- xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n sendDirection = do
+ xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
+ xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
let fileName = takeFileName filePath
fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
fInv = xftpFileInvitation fileName fileSize fileDescr
@@ -731,20 +710,19 @@ processChatCommand = \case
aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) srcFile (roundedFDCount n)
-- TODO CRSndFileStart event for XFTP
chSize <- asks $ fileChunkSize . config
- let contactOrGroup = sendDirToContactOrGroup sendDirection
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv (AgentSndFileId aFileId) chSize
let fileSource = Just $ CryptoFile filePath cfArgs
ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP}
- case sendDirection of
- SDDirect Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr
- SDGroup _ ms -> forM_ ms $ \m -> saveMemberFD ft fileDescr m `catchChatError` (toView . CRChatError (Just user))
+ case contactOrGroup of
+ CGContact Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr
+ CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CRChatError (Just user))
+ where
+ -- we are not sending files to pending members, same as with inline files
+ saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
+ when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $
+ withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr
+ saveMemberFD _ = pure ()
pure (fInv, ciFile, ft)
- where
- -- we are not sending files to pending members, same as with inline files
- saveMemberFD ft fileDescr m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
- when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $
- withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr
- saveMemberFD _ _ _ = pure ()
unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c)
unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c)
unzipMaybe3 _ = (Nothing, Nothing, Nothing)
@@ -772,28 +750,28 @@ processChatCommand = \case
_ -> throwChatError CEInvalidChatItemUpdate
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
CTGroup -> do
- aci <- withStore $ \db -> getAChatItem db user (ChatRef CTGroup chatId) itemId
- case aci of
- AChatItem _ _ (GroupChat gInfo) ci@ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, editable = True}, content = CISndMsgContent oldMC} -> do
- let GroupInfo {groupId, localDisplayName = gName} = gInfo
- ChatItem {meta = CIMeta {itemTimed, itemLive}} = ci
- changed = mc /= oldMC
- if changed || fromMaybe False itemLive
- then do
- (ms, directMember') <- getReceivingMembers' user gInfo directMember
- assertGroupSendAllowed gInfo directMember'
- let msg = XMsgUpdate sharedMsgId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)
- (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms msg
- ci' <- withStore' $ \db -> do
- currentTs <- liftIO getCurrentTime
- when changed $
- addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
- updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
- startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
- setActive $ ActiveG gName
- pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci')
- else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
- _ -> throwChatError CEInvalidChatItemUpdate
+ Group gInfo@GroupInfo {groupId, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
+ assertUserGroupRole gInfo GRAuthor
+ cci <- withStore $ \db -> getGroupChatItem db user chatId itemId
+ case cci of
+ CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do
+ case (ciContent, itemSharedMsgId, editable) of
+ (CISndMsgContent oldMC, Just itemSharedMId, True) -> do
+ 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))
+ ci' <- withStore' $ \db -> do
+ currentTs <- liftIO getCurrentTime
+ when changed $
+ addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc)
+ updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId
+ startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci'
+ setActive $ ActiveG gName
+ 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
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of
@@ -810,25 +788,22 @@ processChatCommand = \case
else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime
(CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
CTGroup -> do
- aci <- withStore $ \db -> getAChatItem db user (ChatRef CTGroup chatId) itemId
- case (mode, aci) of
- (CIDMInternal, AChatItem _ md (GroupChat gInfo) ci) -> do
- let cci = CChatItem md ci
- deleteGroupCI user gInfo cci True False Nothing =<< liftIO getCurrentTime
- (CIDMBroadcast, AChatItem _ _ (GroupChat gInfo) ci@ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, editable = True}}) -> do
- assertUserMembershipStatus gInfo -- can delete messages sent earlier in any role
- (ms, _) <- getReceivingMembers' user gInfo directMember
- (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel sharedMsgId Nothing
- let cci = CChatItem SMDSnd ci
- delGroupChatItem user gInfo cci msgId Nothing
- _ -> throwChatError CEInvalidChatItemDelete
+ Group gInfo ms <- withStore $ \db -> getGroup db user chatId
+ ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}}) <- withStore $ \db -> getGroupChatItem db user chatId itemId
+ case (mode, msgDir, itemSharedMsgId, editable) of
+ (CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime
+ (CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do
+ assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
+ (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
+ delGroupChatItem user gInfo ci msgId Nothing
+ (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do
Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db user gId
ci@(CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user gId itemId
case (chatDir, itemSharedMsgId) of
- (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId} MSGroup, Just itemSharedMId) -> do
+ (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do
when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete
assertUserGroupRole gInfo $ max GRAdmin memberRole
(SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId
@@ -854,15 +829,13 @@ processChatCommand = \case
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
CTGroup ->
- withStore (\db -> getAChatItem db user (ChatRef CTGroup chatId) itemId) >>= \case
- (AChatItem _ md (GroupChat g@GroupInfo {membership}) ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
+ withStore (\db -> (,) <$> getGroup db user chatId <*> getGroupChatItem db user chatId itemId) >>= \case
+ (Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (groupFeatureAllowed SGFReactions g) $
throwChatError $ CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)
unless (ciReactionAllowed ci) $
throwChatError $ CECommandError "reaction not allowed - chat item has no content"
let GroupMember {memberId = itemMemberId} = chatItemMember g ci
- directMember = ciDirDirectMember chatDir
- (ms, _) <- getReceivingMembers' user g directMember
rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True
checkReactionAllowed rs
(SndMessage {msgId}, _) <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add)
@@ -871,7 +844,7 @@ processChatCommand = \case
setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt
liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId
let ci' = CChatItem md ci {reactions}
- r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction (CIGroupSnd directMember) ci' createdAt reaction
+ r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
@@ -1235,7 +1208,7 @@ processChatCommand = \case
case memberConnId m of
Just connId -> do
cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId force
- createInternalChatItem user (CDGroupSnd g Nothing) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing
+ createInternalChatItem user (CDGroupSnd g) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing
pure $ CRGroupMemberRatchetSyncStarted user g m cStats
_ -> throwChatError CEGroupMemberNotActive
APIGetContactCode contactId -> withUser $ \user -> do
@@ -1395,8 +1368,8 @@ processChatCommand = \case
RejectContact cName -> withUser $ \User {userId} -> do
connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
processChatCommand $ APIRejectContact connReqId
- SendMessage sendName msg -> sendTextMessage sendName msg False
- SendLiveMessage sendName msg -> sendTextMessage sendName msg True
+ SendMessage chatName msg -> sendTextMessage chatName msg False
+ SendLiveMessage chatName msg -> sendTextMessage chatName msg True
SendMessageBroadcast msg -> withUser $ \user -> do
contacts <- withStore' (`getUserContacts` user)
let cts = filter (\ct -> isReady ct && directOrUsed ct) contacts
@@ -1416,7 +1389,7 @@ processChatCommand = \case
contactId <- withStore $ \db -> getContactIdByName db user cName
quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
let mc = MCText msg
- processChatCommand . APISendMessage (SRDirect contactId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
+ processChatCommand . APISendMessage (ChatRef CTDirect contactId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
DeleteMessage chatName deletedMsg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
@@ -1430,10 +1403,10 @@ processChatCommand = \case
editedItemId <- getSentChatItemIdByText user chatRef editedMsg
let mc = MCText msg
processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc
- UpdateLiveMessage sendName chatItemId live msg -> withUser $ \user -> do
- sendRef <- getSendRef user sendName
+ UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do
+ chatRef <- getChatRef user chatName
let mc = MCText msg
- processChatCommand $ APIUpdateChatItem (sendToChatRef sendRef) chatItemId live mc
+ processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc
ReactToMessage add reaction chatName msg -> withUser $ \user -> do
chatRef <- getChatRef user chatName
chatItemId <- getChatItemIdByText user chatRef msg
@@ -1518,7 +1491,7 @@ processChatCommand = \case
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
_ -> do
(msg, _) <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole
- ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndGroupEvent gEvent)
+ ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
APIRemoveMember groupId memberId -> withUser $ \user -> do
@@ -1534,7 +1507,7 @@ processChatCommand = \case
withStore' $ \db -> deleteGroupMember db user m
_ -> do
(msg, _) <- sendGroupMessage user gInfo members $ XGrpMemDel mId
- ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
+ ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
deleteMemberConnection user m
-- undeleted "member connected" chat item will prevent deletion of member record
@@ -1544,7 +1517,7 @@ processChatCommand = \case
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
withChatLock "leaveGroup" . procCmd $ do
(msg, _) <- sendGroupMessage user gInfo members XGrpLeave
- ci <- saveSndChatItem user (CDGroupSnd gInfo Nothing) msg (CISndGroupEvent SGEUserLeft)
+ ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
-- TODO delete direct connections that were unused
deleteGroupLinkIfExists user gInfo
@@ -1627,13 +1600,11 @@ processChatCommand = \case
ShowGroupLink gName -> withUser $ \user -> do
groupId <- withStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APIGetGroupLink groupId
- SendGroupMessageQuote gName cName directMemberName quotedMsg msg -> withUser $ \user -> do
+ SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
groupId <- withStore $ \db -> getGroupIdByName db user gName
- directMemberId <- forM directMemberName $ \dmn -> withStore $ \db -> getGroupMemberIdByName db user groupId dmn
quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg
- let sendRef = SRGroup groupId directMemberId
- mc = MCText msg
- processChatCommand . APISendMessage sendRef False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
+ let mc = MCText msg
+ processChatCommand . APISendMessage (ChatRef CTGroup groupId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc
LastChats count_ -> withUser' $ \user -> do
chats <- withStore' $ \db -> getChatPreviews db user False
pure $ CRChats $ maybe id take count_ chats
@@ -1666,19 +1637,19 @@ processChatCommand = \case
processChatCommand $ APIGetChatItemInfo chatRef itemId
ShowLiveItems on -> withUser $ \_ ->
asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
- SendFile sendName f -> withUser $ \user -> do
- sendRef <- getSendRef user sendName
- processChatCommand . APISendMessage sendRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCFile "")
- SendImage sendName f -> withUser $ \user -> do
- sendRef <- getSendRef user sendName
+ SendFile chatName f -> withUser $ \user -> do
+ chatRef <- getChatRef user chatName
+ processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCFile "")
+ SendImage chatName f -> withUser $ \user -> do
+ chatRef <- getChatRef user chatName
filePath <- toFSFilePath f
unless (any (`isSuffixOf` map toLower f) imageExtensions) $ throwChatError CEFileImageType {filePath}
fileSize <- getFileSize filePath
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
-- TODO include file description for preview
- processChatCommand . APISendMessage sendRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCImage "" fixedImagePreview)
- ForwardFile sendName fileId -> forwardFile sendName fileId SendFile
- ForwardImage sendName fileId -> forwardFile sendName fileId SendImage
+ processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCImage "" fixedImagePreview)
+ ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
+ ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
ReceiveFile fileId encrypted rcvInline_ filePath_ -> withUser $ \_ ->
withChatLock "receiveFile" . procCmd $ do
@@ -1702,7 +1673,7 @@ processChatCommand = \case
(_, RcvFileTransfer {xftpRcvFile = f}) <- withStore (`getRcvFileTransferById` fileId)
unless (isJust f) $ throwChatError $ CEFileInternal "locally encrypted files can't be received via SMP"
liftIO $ Just <$> CF.randomArgs
- CancelFile fileId -> withUser $ \user ->
+ CancelFile fileId -> withUser $ \user@User {userId} ->
withChatLock "cancelFile" . procCmd $
withStore (\db -> getFileTransfer db user fileId) >>= \case
FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts
@@ -1712,22 +1683,20 @@ processChatCommand = \case
| otherwise -> do
fileAgentConnIds <- cancelSndFile user ftm fts True
deleteAgentConnectionsAsync user fileAgentConnIds
- sendXFileCancel
- ci' <- withStore $ \db -> getChatItemByFileId db user fileId
- pure $ CRSndFileCancelled user ci' ftm fts
+ sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
+ withStore (\db -> getChatRefByFileId db user fileId) >>= \case
+ ChatRef CTDirect contactId -> do
+ contact <- withStore $ \db -> getContact db user contactId
+ void . sendDirectContactMessage contact $ XFileCancel sharedMsgId
+ ChatRef CTGroup groupId -> do
+ Group gInfo ms <- withStore $ \db -> getGroup db user groupId
+ void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId
+ _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
+ ci <- withStore $ \db -> getChatItemByFileId db user fileId
+ pure $ CRSndFileCancelled user ci ftm fts
where
fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} =
s == FSCancelled || (s == FSComplete && isNothing xftpSndFile)
- sendXFileCancel :: m ()
- sendXFileCancel = do
- ci <- withStore $ \db -> getChatItemByFileId db user fileId
- case ci of
- (AChatItem _ _ (DirectChat ct) ChatItem {chatDir = CIDirectSnd, meta = CIMeta {itemSharedMsgId = Just sharedMsgId}}) ->
- void $ sendDirectContactMessage ct (XFileCancel sharedMsgId)
- (AChatItem _ _ (GroupChat gInfo) ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId}}) -> do
- (ms, _) <- getReceivingMembers' user gInfo directMember
- void $ sendGroupMessage user gInfo ms (XFileCancel sharedMsgId)
- _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
FTRcv ftr@RcvFileTransfer {cancelled, fileStatus, xftpRcvFile}
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
| rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete"
@@ -1842,15 +1811,6 @@ processChatCommand = \case
CTDirect -> withStore $ \db -> getContactIdByName db user name
CTGroup -> withStore $ \db -> getGroupIdByName db user name
_ -> throwChatError $ CECommandError "not supported"
- getSendRef :: User -> SendName -> m SendRef
- getSendRef user sendName = case sendName of
- SNDirect name -> SRDirect <$> withStore (\db -> getContactIdByName db user name)
- SNGroup name directMemberName -> do
- (gId, dmId) <- withStore $ \db -> do
- gId <- getGroupIdByName db user name
- dmId <- forM directMemberName $ \dmn -> getGroupMemberIdByName db user gId dmn
- pure (gId, dmId)
- pure $ SRGroup gId dmId
checkChatStopped :: m ChatResponse -> m ChatResponse
checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
setStoreChanged :: m ()
@@ -1983,29 +1943,15 @@ processChatCommand = \case
assertUserGroupRole g GROwner
g' <- withStore $ \db -> updateGroupProfile db user g p'
(msg, _) <- sendGroupMessage user g' ms (XGrpInfo p')
- let cd = CDGroupSnd g' Nothing
+ let cd = CDGroupSnd g'
unless (sameGroupProfileInfo p p') $ do
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p')
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat g') ci)
createGroupFeatureChangedItems user cd CISndGroupFeature g g'
pure $ CRGroupUpdated user g g' Nothing
- assertGroupSendAllowed :: GroupInfo -> Maybe GroupMember -> m ()
- assertGroupSendAllowed
- gInfo@GroupInfo {membership = GroupMember {memberRole = userRole}}
- (Just GroupMember {memberRole = directMemberRole, activeConn = Just Connection {peerChatVRange}}) = do
- unless (isCompatibleRange peerChatVRange groupPrivateMessagesVRange) $ throwChatError CEPeerChatVRangeIncompatible
- if
- | userRole >= GRAdmin || directMemberRole >= GRAdmin -> assertUserMembershipStatus gInfo
- | not (groupFeatureAllowed SGFDirectMessages gInfo) -> throwChatError $ CECommandError "direct messages not allowed"
- | otherwise -> assertUserGroupRole gInfo GRAuthor
- assertGroupSendAllowed _ (Just GroupMember {activeConn = Nothing}) = throwChatError CEGroupMemberNotActive
- assertGroupSendAllowed gInfo Nothing = assertUserGroupRole gInfo GRAuthor
assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m ()
assertUserGroupRole g@GroupInfo {membership} requiredRole = do
when (memberRole (membership :: GroupMember) < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole
- assertUserMembershipStatus g
- assertUserMembershipStatus :: GroupInfo -> m ()
- assertUserMembershipStatus g@GroupInfo {membership} = do
when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
@@ -2050,14 +1996,14 @@ processChatCommand = \case
withServerProtocol p action = case userProtocol p of
Just Dict -> action
_ -> throwChatError $ CEServerProtocol $ AProtocolType p
- forwardFile :: SendName -> FileTransferId -> (SendName -> FilePath -> ChatCommand) -> m ChatResponse
- forwardFile sendName fileId sendCommand = withUser $ \user -> do
+ forwardFile :: ChatName -> FileTransferId -> (ChatName -> FilePath -> ChatCommand) -> m ChatResponse
+ forwardFile chatName fileId sendCommand = withUser $ \user -> do
withStore (\db -> getFileTransfer db user fileId) >>= \case
FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> forward filePath
FTSnd {fileTransferMeta = FileTransferMeta {filePath}} -> forward filePath
_ -> throwChatError CEFileNotReceived {fileId}
where
- forward = processChatCommand . sendCommand sendName
+ forward = processChatCommand . sendCommand chatName
getGroupAndMemberId :: User -> GroupName -> ContactName -> m (GroupId, GroupMemberId)
getGroupAndMemberId user gName groupMemberName =
withStore $ \db -> do
@@ -2073,10 +2019,10 @@ processChatCommand = \case
ci <- saveSndChatItem user (CDDirectSnd ct) msg content
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
setActive $ ActiveG localDisplayName
- sendTextMessage sendName msg live = withUser $ \user -> do
- sendRef <- getSendRef user sendName
+ sendTextMessage chatName msg live = withUser $ \user -> do
+ chatRef <- getChatRef user chatName
let mc = MCText msg
- processChatCommand . APISendMessage sendRef live Nothing $ ComposedMessage Nothing Nothing mc
+ processChatCommand . APISendMessage chatRef live Nothing $ ComposedMessage Nothing Nothing mc
sndContactCITimed :: Bool -> Contact -> Maybe Int -> m (Maybe CITimed)
sndContactCITimed live = sndCITimed_ live . contactTimedTTL
sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> m (Maybe CITimed)
@@ -2148,26 +2094,6 @@ processChatCommand = \case
_ -> throwChatError $ CECommandError "not supported"
processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings
-getReceivingMembers :: ChatMonad m => User -> GroupInfo -> Maybe GroupMember -> m [GroupMember]
-getReceivingMembers user gInfo directMember = do
- ms <- case directMember of
- Nothing -> withStore' $ \db -> getGroupMembers db user gInfo
- Just dm -> pure [dm]
- pure $ filter memberCurrent ms
-
--- use in contexts where directMember is retrieved via chat item direction:
--- when reading chat item member is loaded w/t connection
-getReceivingMembers' :: ChatMonad m => User -> GroupInfo -> Maybe GroupMember -> m ([GroupMember], Maybe GroupMember)
-getReceivingMembers' user gInfo@GroupInfo {groupId} directMember = do
- (ms, dm) <- case directMember of
- Nothing -> do
- ms <- withStore' $ \db -> getGroupMembers db user gInfo
- pure (ms, Nothing)
- Just GroupMember {groupMemberId} -> do
- dm <- withStore $ \db -> getGroupMember db user groupId groupMemberId
- pure ([dm], Just dm)
- pure (filter memberCurrent ms, dm)
-
assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m ()
assertDirectAllowed user dir ct event =
unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $
@@ -2386,7 +2312,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
)
receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> RcvFileDescr -> Maybe CryptoFileArgs -> m ()
-receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} cfArgs = do
+receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} cfArgs =
when fileDescrComplete $ do
rd <- parseFileDescription fileDescrText
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd cfArgs
@@ -2823,46 +2749,45 @@ processAgentMsgSndFile _corrId aFileId msg =
toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal
SFDONE sndDescr rfds -> do
withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr)
- ci <- withStore $ \db -> getChatItemByFileId db user fileId
- case (rfds, sfts, ci) of
- (rfd : extraRFDs, [sft], AChatItem _ _ (DirectChat ct) ChatItem {chatDir = CIDirectSnd, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, itemDeleted = Nothing}}) -> do
- checkStart ci
- withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
- msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
- withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
- withAgent (`xftpDeleteSndFileInternal` aFileId)
- (_, _, AChatItem _ _ (GroupChat gInfo) ChatItem {chatDir = CIGroupSnd directMember, meta = CIMeta {itemSharedMsgId = Just sharedMsgId, itemDeleted = Nothing}}) -> do
- checkStart ci
- (ms, _) <- getReceivingMembers' user gInfo directMember
- let rfdsMemberFTs = zip rfds $ memberFTs ms
- extraRFDs = drop (length rfdsMemberFTs) rfds
- withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
- forM_ rfdsMemberFTs $ \mt -> sendToMember gInfo mt `catchChatError` (toView . CRChatError (Just user))
- ci' <- withStore $ \db -> do
- liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
- getChatItemByFileId db user fileId
- withAgent (`xftpDeleteSndFileInternal` aFileId)
- toView $ CRSndFileCompleteXFTP user ci' ft
- where
- memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
- memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
- where
- mConns' = mapMaybe useMember ms
- sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
- useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
- | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
- | otherwise = Nothing
- useMember _ = Nothing
- sendToMember :: GroupInfo -> (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
- sendToMember GroupInfo {groupId} (rfd, (conn, sft)) =
- void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
- _ -> throwChatError $ CEInternalError "invalid XFTP file transfer"
- where
- checkStart :: AChatItem -> m ()
- checkStart ci = do
+ ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <-
+ withStore $ \db -> getChatItemByFileId db user fileId
+ case (msgId_, itemDeleted) of
+ (Just sharedMsgId, Nothing) -> do
when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
-- TODO either update database status or move to SFPROG
toView $ CRSndFileProgressXFTP user ci ft 1 1
+ case (rfds, sfts, d, cInfo) of
+ (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do
+ withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
+ msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
+ withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
+ withAgent (`xftpDeleteSndFileInternal` aFileId)
+ (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
+ ms <- withStore' $ \db -> getGroupMembers db user g
+ let rfdsMemberFTs = zip rfds $ memberFTs ms
+ extraRFDs = drop (length rfdsMemberFTs) rfds
+ withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
+ forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchChatError` (toView . CRChatError (Just user))
+ ci' <- withStore $ \db -> do
+ liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
+ getChatItemByFileId db user fileId
+ withAgent (`xftpDeleteSndFileInternal` aFileId)
+ toView $ CRSndFileCompleteXFTP user ci' ft
+ where
+ memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
+ memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
+ where
+ mConns' = mapMaybe useMember ms
+ sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
+ useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
+ | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
+ | otherwise = Nothing
+ useMember _ = Nothing
+ sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
+ sendToMember (rfd, (conn, sft)) =
+ void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
+ _ -> pure ()
+ _ -> pure () -- TODO error?
SFERR e
| temporaryAgentError e ->
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
@@ -3198,7 +3123,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile groupLinkId
(_msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv
-- we could link chat item with sent group invitation message (_msg)
- createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
CONF confId _ connInfo -> do
@@ -3287,10 +3212,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let m' = m {activeConn = Just conn'} :: GroupMember
updateChatLock "groupMessage" event
case event of
- XMsgNew mc -> newGroupContentMessage gInfo m' mc msg msgMeta
- XMsgFileDescr sharedMsgId fileDescr -> groupMessageFileDescription gInfo m' sharedMsgId fileDescr msgMeta
+ XMsgNew mc -> canSend m' $ newGroupContentMessage gInfo m' mc msg msgMeta
+ XMsgFileDescr sharedMsgId fileDescr -> canSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr msgMeta
XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m' sharedMsgId msgMeta
- XMsgUpdate sharedMsgId mContent ttl live -> groupMessageUpdate gInfo m' sharedMsgId mContent msg msgMeta ttl live
+ XMsgUpdate sharedMsgId mContent ttl live -> canSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg msgMeta ttl live
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg msgMeta
XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg msgMeta
-- TODO discontinue XFile
@@ -3314,6 +3239,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
fromMaybe (sendRcptsSmallGroups user) sendRcpts
&& hasDeliveryReceipt (toCMEventTag event)
&& currentMemCount <= smallGroupsRcptsMemLimit
+ where
+ canSend mem a
+ | memberRole (mem :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages"
+ | otherwise = a
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId conn msgMeta $
groupMsgReceived gInfo m conn msgMeta msgRcpt
@@ -3324,8 +3253,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
SWITCH qd phase cStats -> do
toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
- QDRcv -> createInternalChatItem user (CDGroupSnd gInfo Nothing) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
- QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
+ QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
+ QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
RSYNC rss cryptoErr_ cStats ->
case (rss, connectionCode, cryptoErr_) of
(RSRequired, _, Just cryptoErr) -> processErr cryptoErr
@@ -3335,7 +3264,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let m' = m {activeConn = Just (conn {connectionCode = Nothing} :: Connection)} :: GroupMember
ratchetSyncEventItem m'
toView $ CRGroupMemberVerificationReset user gInfo m'
- createInternalChatItem user (CDGroupRcv gInfo m' MSGroup) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent RCEVerificationCodeReset) Nothing
_ -> ratchetSyncEventItem m
where
processErr cryptoErr = do
@@ -3349,10 +3278,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just ci -> toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
_ -> do
toView $ CRGroupMemberRatchetSync user gInfo m (RatchetSyncProgress rss cStats)
- createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvDecryptionError mde n) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvDecryptionError mde n) Nothing
ratchetSyncEventItem m' = do
toView $ CRGroupMemberRatchetSync user gInfo m' (RatchetSyncProgress rss cStats)
- createInternalChatItem user (CDGroupRcv gInfo m' MSGroup) (CIRcvConnEvent $ RCERatchetSync rss) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m') (CIRcvConnEvent $ RCERatchetSync rss) Nothing
OK ->
-- [async agent commands] continuation on receiving OK
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} ->
@@ -3649,11 +3578,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
memberConnectedChatItem :: GroupInfo -> GroupMember -> m ()
memberConnectedChatItem gInfo m =
-- ts should be broker ts but we don't have it for CON
- createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvGroupEvent RGEMemberConnected) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEMemberConnected) Nothing
groupDescriptionChatItem :: GroupInfo -> GroupMember -> Text -> m ()
groupDescriptionChatItem gInfo m descr =
- createInternalChatItem user (CDGroupRcv gInfo m MSGroup) (CIRcvMsgContent $ MCText descr) Nothing
+ createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvMsgContent $ MCText descr) Nothing
notifyMemberConnected :: GroupInfo -> GroupMember -> Maybe Contact -> m ()
notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} ct_ = do
@@ -3691,7 +3620,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
newContentMessage ct@Contact {localDisplayName = c, contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
- 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" ->
@@ -3703,7 +3632,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
setActive $ ActiveC c
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
@@ -3731,16 +3660,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processFDMessage fileId fileDescr
groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
- groupMessageFileDescription gInfo@GroupInfo {groupId} GroupMember {groupMemberId, memberId} sharedMsgId fileDescr _msgMeta = do
- cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
- case cci of
- CChatItem SMDRcv ChatItem {chatDir = CIGroupRcv m' msgScope, file = Just CIFile {fileId}} ->
- if sameMemberId memberId m'
- then do
- assertMemberSendAllowed gInfo m' msgScope directMsgProhibitedErr
- processFDMessage fileId fileDescr
- else messageError "x.msg.file.descr: message of another member"
- _ -> messageError "x.msg.file.descr: group member attempted invalid file send"
+ groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr _msgMeta = do
+ fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
+ processFDMessage fileId fileDescr
processFDMessage :: FileTransferId -> FileDescr -> m ()
processFDMessage fileId fileDescr = do
@@ -3861,14 +3783,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
where
updateChatItemReaction = do
cr_ <- withStore $ \db -> do
- CChatItem md ci@ChatItem {chatDir} <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId
- if directMemberCIUpdateAllowed ci m && ciReactionAllowed ci
+ CChatItem md ci <- getGroupMemberCIBySharedMsgId db user groupId itemMemberId sharedMsgId
+ if ciReactionAllowed ci
then liftIO $ do
setGroupReaction db g m itemMemberId sharedMsgId False reaction add msgId brokerTs
reactions <- getGroupCIReactions db g itemMemberId sharedMsgId
let ci' = CChatItem md ci {reactions}
- msgScope = directMemberToMsgScope $ ciDirDirectMember chatDir
- r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m msgScope) ci' brokerTs reaction
+ r = ACIReaction SCTGroup SMDRcv (GroupChat g) $ CIReaction (CIGroupRcv m) ci' brokerTs reaction
pure $ Just $ CRChatItemReaction user add r
else pure Nothing
mapM_ toView cr_
@@ -3876,12 +3797,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
reactionAllowed :: Bool -> MsgReaction -> [MsgReaction] -> Bool
reactionAllowed add reaction rs = (reaction `elem` rs) /= add && not (add && length rs >= maxMsgReactions)
- directMemberCIUpdateAllowed :: ChatItem 'CTGroup d -> GroupMember -> Bool
- directMemberCIUpdateAllowed ChatItem {chatDir} GroupMember {groupMemberId} =
- case ciDirDirectMember chatDir of
- Just GroupMember {groupMemberId = directMemberId} -> groupMemberId == directMemberId
- Nothing -> True
-
catchCINotFound :: m a -> (SharedMsgId -> m a) -> m a
catchCINotFound f handle =
f `catchChatError` \case
@@ -3889,41 +3804,32 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
e -> throwError e
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
- newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
- assertMemberSendAllowed gInfo m msgScope $ rejected GFDirectMessages >> directMsgProhibitedErr
- processMessage
+ newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta
+ | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
+ | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
+ | otherwise = do
+ -- TODO integrity message check
+ -- check if message moderation event was received ahead of message
+ let timed_ = rcvGroupCITimed gInfo itemTTL
+ live = fromMaybe False live_
+ withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
+ Just ciModeration -> do
+ applyModeration timed_ live ciModeration
+ withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
+ Nothing -> createItem timed_ live
where
- processMessage
- | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
- | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
- | otherwise = do
- -- TODO integrity message check
- -- check if message moderation event was received ahead of message
- let timed_ = rcvGroupCITimed gInfo itemTTL
- live = fromMaybe False live_
- case msgScope_ of
- Nothing -> processGroupScopeMsg timed_ live
- Just MSGroup -> processGroupScopeMsg timed_ live
- Just MSDirect -> createItem timed_ live
- processGroupScopeMsg timed_ live =
- withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
- Just ciModeration -> do
- applyModeration timed_ live ciModeration
- withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
- Nothing -> createItem timed_ live
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
- ExtMsgContent content fInv_ itemTTL live_ msgScope_ = mcExtMsgContent mc
- msgScope = fromMaybe MSGroup msgScope_
+ ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
| moderatorRole < GRAdmin || moderatorRole < memberRole =
createItem timed_ live
| groupFeatureAllowed SGFFullDelete gInfo = do
- ci <- saveRcvChatItem' user (CDGroupRcv gInfo m MSGroup) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo (CChatItem SMDRcv ci) moderator moderatedAt
toView $ CRNewChatItem user ci'
| otherwise = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
- ci <- saveRcvChatItem' user (CDGroupRcv gInfo m MSGroup) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False
cr <- markGroupCIDeleted user gInfo (CChatItem SMDRcv ci) createdByMsgId False (Just moderator) moderatedAt
toView cr
createItem timed_ live = do
@@ -3935,39 +3841,24 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
setActive $ ActiveG g
newChatItem ciContent ciFile_ timed_ live = do
- ci <- saveRcvChatItem' user (CDGroupRcv gInfo m msgScope) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
groupMsgToView gInfo m ci {reactions} msgMeta
pure ci
- assertMemberSendAllowed :: GroupInfo -> GroupMember -> MessageScope -> m () -> m ()
- assertMemberSendAllowed
- gInfo@GroupInfo {membership = GroupMember {memberRole = userRole}}
- m@GroupMember {memberRole}
- MSDirect
- directMessagesProhibitedAction
- | userRole >= GRAdmin || memberRole >= GRAdmin = assertMemberStatus m
- | not (groupFeatureAllowed SGFDirectMessages gInfo) = directMessagesProhibitedAction
- | otherwise = assertMemberGroupRole m GRAuthor
- assertMemberSendAllowed _ m MSGroup _ =
- assertMemberGroupRole m GRAuthor
-
- directMsgProhibitedErr :: m ()
- directMsgProhibitedErr = throwChatError $ CECommandError "direct messages not allowed"
-
- assertMemberGroupRole :: GroupMember -> GroupMemberRole -> m ()
- assertMemberGroupRole member requiredRole = do
- when (memberRole (member :: GroupMember) < requiredRole) $ messageError "member is not allowed to send messages (member role)"
- assertMemberStatus member
-
- assertMemberStatus :: GroupMember -> m ()
- assertMemberStatus member =
- when (memberRemoved member) $ messageError "member is not allowed to send messages (member removed)"
-
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m ()
- groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} GroupMember {groupMemberId, memberId} sharedMsgId mc RcvMessage {msgId} msgMeta _ttl_ live_ =
- updateRcvChatItem `catchCINotFound` \_ ->
- withStore' (`deleteMessage` msgId)
+ groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ =
+ updateRcvChatItem `catchCINotFound` \_ -> do
+ -- This patches initial sharedMsgId into chat item when locally deleted chat item
+ -- 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) msgMeta content Nothing timed_ live
+ ci' <- withStore' $ \db -> do
+ createChatItemVersion db (chatItemId' ci) brokerTs mc
+ updateGroupChatItem db user groupId ci content live Nothing
+ toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci')
+ setActive $ ActiveG g
where
MsgMeta {broker = (_, brokerTs)} = msgMeta
content = CIRcvMsgContent mc
@@ -3975,10 +3866,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
updateRcvChatItem = do
cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
case cci of
- CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m' msgScope, meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
+ CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
if sameMemberId memberId m'
then do
- assertMemberSendAllowed gInfo m' msgScope directMsgProhibitedErr
let changed = mc /= oldMC
if changed || fromMaybe False itemLive
then do
@@ -3998,13 +3888,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
let msgMemberId = fromMaybe memberId sndMemberId_
withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case
Right ci@(CChatItem _ ChatItem {chatDir}) -> case chatDir of
- CIGroupRcv mem msgScope
+ CIGroupRcv mem
| sameMemberId memberId mem && msgMemberId == memberId -> delete ci Nothing >>= toView
- | msgScope == MSGroup -> deleteMsg mem ci
- | otherwise -> messageError "x.msg.del: private message of another member"
- CIGroupSnd directMember
- | isNothing directMember -> deleteMsg membership ci
- | otherwise -> messageError "x.msg.del: private message sent by user"
+ | otherwise -> deleteMsg mem ci
+ CIGroupSnd -> deleteMsg membership ci
Left e
| msgMemberId == memberId -> messageError $ "x.msg.del: message not found, " <> tshow e
| senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e
@@ -4047,7 +3934,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
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 MSGroup) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
+ ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
groupMsgToView gInfo m ci msgMeta
let g = groupName' gInfo
whenGroupNtfs user gInfo $ do
@@ -4156,11 +4043,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m ()
xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {groupMemberId, memberId} sharedMsgId msgMeta = do
- checkIntegrityCreateItem (CDGroupRcv g mem MSGroup) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv g mem) msgMeta
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
case (msgDir, chatDir) of
- (SMDRcv, CIGroupRcv m _) -> do
+ (SMDRcv, CIGroupRcv m) -> do
if sameMemberId memberId m
then do
ft <- withStore (\db -> getRcvFileTransfer db user fileId)
@@ -4173,7 +4060,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> MsgMeta -> m ()
xFileAcptInvGroup g@GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName msgMeta = do
- checkIntegrityCreateItem (CDGroupRcv g m MSGroup) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv g m) msgMeta
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
(AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db user fileId
assertSMPAcceptNotProhibited ci
@@ -4204,7 +4091,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupMsgToView :: GroupInfo -> GroupMember -> ChatItem 'CTGroup 'MDRcv -> MsgMeta -> m ()
groupMsgToView gInfo m ci msgMeta = do
- checkIntegrityCreateItem (CDGroupRcv gInfo m MSGroup) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
toView $ CRNewChatItem user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci)
processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m ()
@@ -4280,7 +4167,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
forM_ allGroupFeatures $ \(AGF f) -> do
let p = getGroupPreference f fullGroupPreferences
(_, param) = groupFeatureState p
- createInternalChatItem user (CDGroupRcv g m MSGroup) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
+ createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe =
@@ -4443,7 +4330,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
then messageError "x.grp.mem.new error: member already exists"
else do
newMember@GroupMember {groupMemberId} <- withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
- ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberAdded groupMemberId memberProfile)
groupMsgToView gInfo m ci msgMeta
toView $ CRJoinedGroupMemberConnecting user gInfo m newMember
@@ -4527,7 +4414,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| 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 MSGroup) msg msgMeta (CIRcvGroupEvent gEvent)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent)
groupMsgToView gInfo m ci msgMeta
toView CRMemberRole {user, groupInfo = gInfo', byMember = m, member = member {memberRole = memRole}, fromRole, toRole = memRole}
@@ -4562,7 +4449,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
messageError "x.grp.mem.del with insufficient member permissions"
| otherwise = a
deleteMemberItem gEvent = do
- ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent gEvent)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent gEvent)
groupMsgToView gInfo m ci msgMeta
sameMemberId :: MemberId -> GroupMember -> Bool
@@ -4573,7 +4460,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
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 MSGroup) msg msgMeta (CIRcvGroupEvent RGEMemberLeft)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft)
groupMsgToView gInfo m ci msgMeta
toView $ CRLeftMember user gInfo m {memberStatus = GSMemLeft}
@@ -4586,7 +4473,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
pure members
-- member records are not deleted to keep history
deleteMembersConnections user ms
- ci <- saveRcvChatItem user (CDGroupRcv gInfo m MSGroup) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted)
+ ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted)
groupMsgToView gInfo m ci msgMeta
toView $ CRGroupDeleted user gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m
@@ -4596,7 +4483,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| otherwise = unless (p == p') $ do
g' <- withStore $ \db -> updateGroupProfile db user g p'
toView $ CRGroupUpdated user g g' (Just m)
- let cd = CDGroupRcv g' m MSGroup
+ let cd = CDGroupRcv g' m
unless (sameGroupProfileInfo p p') $ do
ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p')
groupMsgToView g' m ci msgMeta
@@ -4611,7 +4498,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do
- checkIntegrityCreateItem (CDGroupRcv gInfo m MSGroup) msgMeta
+ checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
updateGroupItemStatus gInfo m conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
@@ -5324,7 +5211,7 @@ chatCommandP =
"/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
"/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
- "/_send " *> (APISendMessage <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
+ "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))),
"/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP),
"/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode),
"/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal),
@@ -5448,7 +5335,8 @@ chatCommandP =
"/set link role #" *> (GroupLinkMemberRole <$> displayName <*> memberRole),
"/delete link #" *> (DeleteGroupLink <$> displayName),
"/show link #" *> (ShowGroupLink <$> displayName),
- (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <*> optional (" >@" *> displayName) <*> optional (" @" *> displayName) <* A.space <*> quotedMsg <*> msgTextP),
+ (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP),
+ (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
@@ -5456,8 +5344,8 @@ chatCommandP =
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
("/connect" <|> "/c") *> (AddContact <$> incognitoP),
- SendMessage <$> sendNameP <* A.space <*> msgTextP,
- "/live " *> (SendLiveMessage <$> sendNameP <*> (A.space *> msgTextP <|> pure "")),
+ SendMessage <$> chatNameP <* A.space <*> msgTextP,
+ "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")),
(">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv),
(">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd),
("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> textP),
@@ -5472,10 +5360,10 @@ chatCommandP =
"/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)),
"/show " *> (ShowChatItem . Just <$> A.decimal),
"/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP),
- ("/file " <|> "/f ") *> (SendFile <$> sendNameP' <* A.space <*> filePath),
- ("/image " <|> "/img ") *> (SendImage <$> sendNameP' <* A.space <*> filePath),
- ("/fforward " <|> "/ff ") *> (ForwardFile <$> sendNameP' <* A.space <*> A.decimal),
- ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> sendNameP' <* A.space <*> A.decimal),
+ ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath),
+ ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
+ ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
+ ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> (" encrypt=" *> onOffP <|> pure False) <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
"/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> (" encrypt=" *> onOffP <|> pure False)),
@@ -5586,13 +5474,6 @@ chatCommandP =
chatNameP = ChatName <$> chatTypeP <*> displayName
chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName
chatRefP = ChatRef <$> chatTypeP <*> A.decimal
- sendNameP =
- (A.char '@' $> SNDirect <*> displayName)
- <|> (A.char '#' $> SNGroup <*> displayName <*> optional (" @" *> displayName))
- sendNameP' = sendNameP <|> (SNDirect <$> displayName)
- sendRefP =
- (A.char '@' $> SRDirect <*> A.decimal)
- <|> (A.char '#' $> SRGroup <*> A.decimal <*> optional (" @" *> A.decimal))
msgCountP = A.space *> A.decimal <|> pure 10
ciTTLDecimal = ("none" $> Nothing) <|> (Just <$> A.decimal)
ciTTL =
diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs
index 50bddbb190..df9c66ceee 100644
--- a/src/Simplex/Chat/Bot.hs
+++ b/src/Simplex/Chat/Bot.hs
@@ -67,7 +67,7 @@ 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 (APISendMessage (SRDirect ctId) False Nothing cm) >>= \case
+ sendChatCmd cc (APISendMessage (ChatRef CTDirect ctId) False Nothing cm) >>= \case
CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
r -> putStrLn $ "unexpected send message response: " <> show r
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 26e4f43565..af9aa964cf 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -34,7 +34,6 @@ import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.String
import Data.Text (Text)
-import qualified Data.Text as T
import Data.Time (NominalDiffTime)
import Data.Time.Clock (UTCTime)
import Data.Version (showVersion)
@@ -242,7 +241,7 @@ data ChatCommand
| APIGetChat ChatRef ChatPagination (Maybe String)
| APIGetChatItems ChatPagination (Maybe String)
| APIGetChatItemInfo ChatRef ChatItemId
- | APISendMessage {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
+ | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
| APIDeleteChatItem ChatRef ChatItemId CIDeleteMode
| APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId
@@ -353,14 +352,14 @@ data ChatCommand
| AddressAutoAccept (Maybe AutoAccept)
| AcceptContact IncognitoEnabled ContactName
| RejectContact ContactName
- | SendMessage SendName Text
- | SendLiveMessage SendName Text
+ | SendMessage ChatName Text
+ | SendLiveMessage ChatName Text
| SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: Text, message :: Text}
| SendMessageBroadcast Text -- UserId (not used in UI)
| DeleteMessage ChatName Text
| DeleteMemberMessage GroupName ContactName Text
| EditMessage {chatName :: ChatName, editedMsg :: Text, message :: Text}
- | UpdateLiveMessage {sendName :: SendName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text}
+ | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text}
| ReactToMessage {add :: Bool, reaction :: MsgReaction, chatName :: ChatName, reactToMessage :: Text}
| APINewGroup UserId GroupProfile
| NewGroup GroupProfile
@@ -382,17 +381,17 @@ data ChatCommand
| GroupLinkMemberRole GroupName GroupMemberRole
| DeleteGroupLink GroupName
| ShowGroupLink GroupName
- | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, directMemberName :: Maybe ContactName, quotedMsg :: Text, message :: Text}
+ | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: Text, message :: Text}
| LastChats (Maybe Int) -- UserId (not used in UI)
| LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI)
| LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI)
| ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
| ShowChatItemInfo ChatName Text
| ShowLiveItems Bool
- | SendFile SendName FilePath
- | SendImage SendName FilePath
- | ForwardFile SendName FileTransferId
- | ForwardImage SendName FileTransferId
+ | SendFile ChatName FilePath
+ | SendImage ChatName FilePath
+ | ForwardFile ChatName FileTransferId
+ | ForwardImage ChatName FileTransferId
| SendFileDescription ChatName FilePath
| ReceiveFile {fileId :: FileTransferId, storeEncrypted :: Bool, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
| SetFileToReceive {fileId :: FileTransferId, storeEncrypted :: Bool}
@@ -613,37 +612,6 @@ instance ToJSON ChatResponse where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
-data SendRef
- = SRDirect ContactId
- | SRGroup GroupId (Maybe GroupMemberId)
- deriving (Eq, Show)
-
-sendToChatRef :: SendRef -> ChatRef
-sendToChatRef = \case
- SRDirect cId -> ChatRef CTDirect cId
- SRGroup gId _ -> ChatRef CTGroup gId
-
-data SendName
- = SNDirect ContactName
- | SNGroup GroupName (Maybe ContactName)
- deriving (Eq, Show)
-
-sendNameStr :: SendName -> String
-sendNameStr = \case
- SNDirect cName -> "@" <> T.unpack cName
- SNGroup gName (Just cName) -> "#" <> T.unpack gName <> " @" <> T.unpack cName
- SNGroup gName Nothing -> "#" <> T.unpack gName
-
-data SendDirection
- = SDDirect Contact
- | SDGroup GroupInfo [GroupMember]
- deriving (Eq, Show)
-
-sendDirToContactOrGroup :: SendDirection -> ContactOrGroup
-sendDirToContactOrGroup = \case
- SDDirect c -> CGContact c
- SDGroup g _ -> CGGroup g
-
newtype UserPwd = UserPwd {unUserPwd :: Text}
deriving (Eq, Show)
@@ -959,7 +927,6 @@ data ChatErrorType
| CEAgentCommandError {message :: String}
| CEInvalidFileDescription {message :: String}
| CEConnectionIncognitoChangeProhibited
- | CEPeerChatVRangeIncompatible
| CEInternalError {message :: String}
| CEException {message :: String}
deriving (Show, Exception, Generic)
diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs
index f97a0dd1b3..45e5f9ff74 100644
--- a/src/Simplex/Chat/Messages.hs
+++ b/src/Simplex/Chat/Messages.hs
@@ -50,6 +50,16 @@ data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
data ChatName = ChatName ChatType Text
deriving (Show)
+chatTypeStr :: ChatType -> String
+chatTypeStr = \case
+ CTDirect -> "@"
+ CTGroup -> "#"
+ CTContactRequest -> "<@"
+ CTContactConnection -> ":"
+
+chatNameStr :: ChatName -> String
+chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
+
data ChatRef = ChatRef ChatType Int64
deriving (Eq, Show, Ord)
@@ -138,16 +148,16 @@ instance MsgDirectionI d => ToJSON (ChatItem c d) where
data CIDirection (c :: ChatType) (d :: MsgDirection) where
CIDirectSnd :: CIDirection 'CTDirect 'MDSnd
CIDirectRcv :: CIDirection 'CTDirect 'MDRcv
- CIGroupSnd :: Maybe GroupMember -> CIDirection 'CTGroup 'MDSnd
- CIGroupRcv :: GroupMember -> MessageScope -> CIDirection 'CTGroup 'MDRcv
+ CIGroupSnd :: CIDirection 'CTGroup 'MDSnd
+ CIGroupRcv :: GroupMember -> CIDirection 'CTGroup 'MDRcv
deriving instance Show (CIDirection c d)
data JSONCIDirection
= JCIDirectSnd
| JCIDirectRcv
- | JCIGroupSnd {directMember :: Maybe GroupMember}
- | JCIGroupRcv {groupMember :: GroupMember, messageScope :: MessageScope}
+ | JCIGroupSnd
+ | JCIGroupRcv {groupMember :: GroupMember}
deriving (Generic, Show)
instance ToJSON JSONCIDirection where
@@ -162,19 +172,8 @@ jsonCIDirection :: CIDirection c d -> JSONCIDirection
jsonCIDirection = \case
CIDirectSnd -> JCIDirectSnd
CIDirectRcv -> JCIDirectRcv
- CIGroupSnd dm -> JCIGroupSnd dm
- CIGroupRcv m ms -> JCIGroupRcv m ms
-
-ciDirDirectMember :: CIDirection 'CTGroup d -> Maybe GroupMember
-ciDirDirectMember = \case
- CIGroupSnd dm -> dm
- CIGroupRcv _ MSGroup -> Nothing
- CIGroupRcv m MSDirect -> Just m
-
-directMemberToMsgScope :: Maybe GroupMember -> MessageScope
-directMemberToMsgScope = \case
- Nothing -> MSGroup
- Just _ -> MSDirect
+ CIGroupSnd -> JCIGroupSnd
+ CIGroupRcv m -> JCIGroupRcv m
data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int}
deriving (Show, Generic)
@@ -209,8 +208,8 @@ timedDeleteAt' CITimed {deleteAt} = deleteAt
chatItemMember :: GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo {membership} ChatItem {chatDir} = case chatDir of
- CIGroupSnd _ -> membership
- CIGroupRcv m _ -> m
+ CIGroupSnd -> membership
+ CIGroupRcv m -> m
ciReactionAllowed :: ChatItem c d -> Bool
ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False
@@ -239,22 +238,22 @@ chatItemDeletedState ChatItem {meta = CIMeta {itemDeleted}, content} =
data ChatDirection (c :: ChatType) (d :: MsgDirection) where
CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectRcv :: Contact -> ChatDirection 'CTDirect 'MDRcv
- CDGroupSnd :: GroupInfo -> Maybe GroupMember -> ChatDirection 'CTGroup 'MDSnd
- CDGroupRcv :: GroupInfo -> GroupMember -> MessageScope -> ChatDirection 'CTGroup 'MDRcv
+ CDGroupSnd :: GroupInfo -> ChatDirection 'CTGroup 'MDSnd
+ CDGroupRcv :: GroupInfo -> GroupMember -> ChatDirection 'CTGroup 'MDRcv
toCIDirection :: ChatDirection c d -> CIDirection c d
toCIDirection = \case
CDDirectSnd _ -> CIDirectSnd
CDDirectRcv _ -> CIDirectRcv
- CDGroupSnd _ dm -> CIGroupSnd dm
- CDGroupRcv _ m ms -> CIGroupRcv m ms
+ CDGroupSnd _ -> CIGroupSnd
+ CDGroupRcv _ m -> CIGroupRcv m
toChatInfo :: ChatDirection c d -> ChatInfo c
toChatInfo = \case
CDDirectSnd c -> DirectChat c
CDDirectRcv c -> DirectChat c
- CDGroupSnd g _ -> GroupChat g
- CDGroupRcv g _ _ -> GroupChat g
+ CDGroupSnd g -> GroupChat g
+ CDGroupRcv g _ -> GroupChat g
data NewChatItem d = NewChatItem
{ createdByMsgId :: Maybe MessageId,
@@ -434,39 +433,29 @@ instance ToJSON (JSONCIReaction c d) where
data CIQDirection (c :: ChatType) where
CIQDirectSnd :: CIQDirection 'CTDirect
CIQDirectRcv :: CIQDirection 'CTDirect
- CIQGroupSnd :: MessageScope -> CIQDirection 'CTGroup
- CIQGroupRcv :: Maybe GroupMember -> MessageScope -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet
+ CIQGroupSnd :: CIQDirection 'CTGroup
+ CIQGroupRcv :: Maybe GroupMember -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet
deriving instance Show (CIQDirection c)
-data JSONCIQDirection
- = JCIQDirectSnd
- | JCIQDirectRcv
- | JCIQGroupSnd {messageScope :: MessageScope}
- | JCIQGroupRcv {groupMember :: Maybe GroupMember, messageScope :: MessageScope}
- deriving (Generic, Show)
-
-instance ToJSON JSONCIQDirection where
- toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIQ"
- toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIQ"
-
instance ToJSON (CIQDirection c) where
toJSON = J.toJSON . jsonCIQDirection
toEncoding = J.toEncoding . jsonCIQDirection
-jsonCIQDirection :: CIQDirection c -> JSONCIQDirection
+jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection
jsonCIQDirection = \case
- CIQDirectSnd -> JCIQDirectSnd
- CIQDirectRcv -> JCIQDirectRcv
- CIQGroupSnd ms -> JCIQGroupSnd ms
- CIQGroupRcv m ms -> JCIQGroupRcv m ms
+ CIQDirectSnd -> Just JCIDirectSnd
+ CIQDirectRcv -> Just JCIDirectRcv
+ CIQGroupSnd -> Just JCIGroupSnd
+ CIQGroupRcv (Just m) -> Just $ JCIGroupRcv m
+ CIQGroupRcv Nothing -> Nothing
quoteMsgDirection :: CIQDirection c -> MsgDirection
quoteMsgDirection = \case
CIQDirectSnd -> MDSnd
CIQDirectRcv -> MDRcv
- CIQGroupSnd _ -> MDSnd
- CIQGroupRcv _ _ -> MDRcv
+ CIQGroupSnd -> MDSnd
+ CIQGroupRcv _ -> MDRcv
data CIFile (d :: MsgDirection) = CIFile
{ fileId :: Int64,
diff --git a/src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs b/src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs
deleted file mode 100644
index 6c150b19ce..0000000000
--- a/src/Simplex/Chat/Migrations/M20230904_item_direct_group_member_id.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-
-module Simplex.Chat.Migrations.M20230904_item_direct_group_member_id where
-
-import Database.SQLite.Simple (Query)
-import Database.SQLite.Simple.QQ (sql)
-
-m20230904_item_direct_group_member_id :: Query
-m20230904_item_direct_group_member_id =
- [sql|
-ALTER TABLE chat_items ADD COLUMN item_direct_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL;
-ALTER TABLE chat_items ADD COLUMN quoted_message_scope TEXT;
-
-CREATE INDEX idx_chat_items_item_direct_group_member_id ON chat_items(item_direct_group_member_id);
-|]
-
-down_m20230904_item_direct_group_member_id :: Query
-down_m20230904_item_direct_group_member_id =
- [sql|
-DROP INDEX idx_chat_items_item_direct_group_member_id;
-
-ALTER TABLE chat_items DROP COLUMN quoted_message_scope;
-ALTER TABLE chat_items DROP COLUMN item_direct_group_member_id;
-|]
diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql
index f9a9309db5..c71cc9aa90 100644
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Migrations/chat_schema.sql
@@ -392,9 +392,7 @@ CREATE TABLE chat_items(
timed_delete_at TEXT,
item_live INTEGER,
item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
- item_deleted_ts TEXT,
- item_direct_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
- quoted_message_scope TEXT
+ item_deleted_ts TEXT
);
CREATE TABLE chat_item_messages(
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
@@ -715,6 +713,3 @@ CREATE INDEX idx_chat_items_user_id_item_status ON chat_items(
item_status
);
CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe);
-CREATE INDEX idx_chat_items_item_direct_group_member_id ON chat_items(
- item_direct_group_member_id
-);
diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs
index b42ede41c8..13692b57cc 100644
--- a/src/Simplex/Chat/Protocol.hs
+++ b/src/Simplex/Chat/Protocol.hs
@@ -44,7 +44,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Util
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
+import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
import Simplex.Messaging.Version hiding (version)
@@ -58,10 +58,6 @@ supportedChatVRange = mkVersionRange 1 currentChatVersion
groupNoDirectVRange :: VersionRange
groupNoDirectVRange = mkVersionRange 2 currentChatVersion
--- version range that supports private messages from members in a group
-groupPrivateMessagesVRange :: VersionRange
-groupPrivateMessagesVRange = mkVersionRange 2 currentChatVersion
-
data ConnectionEntity
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
@@ -162,28 +158,11 @@ instance ToJSON SharedMsgId where
toJSON = strToJSON
toEncoding = strToJEncoding
-data MessageScope = MSGroup | MSDirect
- deriving (Eq, Show, Generic)
-
-instance FromJSON MessageScope where
- parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MS"
-
-instance ToJSON MessageScope where
- toJSON = J.genericToJSON . enumJSON $ dropPrefix "MS"
- toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MS"
-
-instance ToField MessageScope where
- toField = toField . encodeJSON
-
-instance FromField MessageScope where
- fromField = fromTextField_ decodeJSON
-
data MsgRef = MsgRef
{ msgId :: Maybe SharedMsgId,
sentAt :: UTCTime,
sent :: Bool,
- memberId :: Maybe MemberId, -- must be present in all group message references, both referencing sent and received
- msgScope :: Maybe MessageScope
+ memberId :: Maybe MemberId -- must be present in all group message references, both referencing sent and received
}
deriving (Eq, Show, Generic)
@@ -468,13 +447,7 @@ msgContentTag = \case
MCFile {} -> MCFile_
MCUnknown {tag} -> MCUnknown_ tag
-data ExtMsgContent = ExtMsgContent
- { content :: MsgContent,
- file :: Maybe FileInvitation,
- ttl :: Maybe Int,
- live :: Maybe Bool,
- scope :: Maybe MessageScope
- }
+data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
deriving (Eq, Show)
parseMsgContainer :: J.Object -> JT.Parser MsgContainer
@@ -483,10 +456,10 @@ parseMsgContainer v =
<|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
<|> MCSimple <$> mc
where
- mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live" <*> v .:? "scope"
+ mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
-extMsgContent mc file = ExtMsgContent mc file Nothing Nothing Nothing
+extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
justTrue :: Bool -> Maybe Bool
justTrue True = Just True
@@ -530,7 +503,7 @@ msgContainerJSON = \case
MCSimple mc -> o $ msgContent mc
where
o = JM.fromList
- msgContent (ExtMsgContent c file ttl live scope) = ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) $ ("scope" .=? scope) ["content" .= c]
+ msgContent (ExtMsgContent c file ttl live) = ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) ["content" .= c]
instance ToJSON MsgContent where
toJSON = \case
diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs
index 93b9ed612f..ddd59319d5 100644
--- a/src/Simplex/Chat/Store/Messages.hs
+++ b/src/Simplex/Chat/Store/Messages.hs
@@ -25,7 +25,6 @@ module Simplex.Chat.Store.Messages
createRcvMsgDeliveryEvent,
createPendingGroupMessage,
getPendingGroupMessages,
- deleteMessage,
deletePendingGroupMessage,
deleteOldMessages,
updateChatTs,
@@ -290,10 +289,6 @@ getPendingGroupMessages db groupMemberId =
pendingGroupMessage (msgId, cmEventTag, msgBody, introId_) =
PendingGroupMessage {msgId, cmEventTag, msgBody, introId_}
-deleteMessage :: DB.Connection -> MessageId -> IO ()
-deleteMessage db msgId = do
- DB.execute db "DELETE FROM messages WHERE message_id = ?" (Only msgId)
-
deletePendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> IO ()
deletePendingGroupMessage db groupMemberId messageId =
DB.execute db "DELETE FROM pending_group_messages WHERE group_member_id = ? AND message_id = ?" (groupMemberId, messageId)
@@ -302,7 +297,7 @@ deleteOldMessages :: DB.Connection -> UTCTime -> IO ()
deleteOldMessages db createdAtCutoff = do
DB.execute db "DELETE FROM messages WHERE created_at <= ?" (Only createdAtCutoff)
-type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId, Maybe MessageScope)
+type NewQuoteRow = (Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MemberId)
updateChatTs :: DB.Connection -> User -> ChatDirection c d -> UTCTime -> IO ()
updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirection of
@@ -325,15 +320,14 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
createdByMsgId = if msgId == 0 then Nothing else Just msgId
quoteRow :: NewQuoteRow
quoteRow = case quotedItem of
- Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
- Just CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content} -> do
- let (quotedSent, quotedMemberId, quotedMsgScope) = case chatDir of
- CIQDirectSnd -> (Just True, Nothing, Nothing)
- CIQDirectRcv -> (Just False, Nothing, Nothing)
- CIQGroupSnd messageScope -> (Just True, Nothing, Just messageScope)
- CIQGroupRcv (Just GroupMember {memberId}) messageScope -> (Just False, Just memberId, Just messageScope)
- CIQGroupRcv Nothing messageScope -> (Just False, Nothing, Just messageScope)
- (quotedSharedMsgId, Just sentAt, Just content, quotedSent, quotedMemberId, quotedMsgScope)
+ Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
+ Just CIQuote {chatDir, sharedMsgId = quotedSharedMsgId, sentAt, content} ->
+ uncurry (quotedSharedMsgId,Just sentAt,Just content,,) $ case chatDir of
+ CIQDirectSnd -> (Just True, Nothing)
+ CIQDirectRcv -> (Just False, Nothing)
+ CIQGroupSnd -> (Just True, Nothing)
+ CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
+ CIQGroupRcv Nothing -> (Just False, Nothing)
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent timed live itemTs createdAt = do
@@ -344,20 +338,19 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar
quotedMsg = cmToQuotedMsg chatMsgEvent
quoteRow :: NewQuoteRow
quoteRow = case quotedMsg of
- Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
- Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId, msgScope}, content} -> do
- let (quotedSent, quotedMemberId, quotedMsgScope) = case chatDirection of
- CDDirectRcv _ -> (Just $ not sent, Nothing, Nothing)
- CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ _ ->
- (Just $ Just userMemberId == memberId, memberId, msgScope)
- (sharedMsgId, Just sentAt, Just content, quotedSent, quotedMemberId, quotedMsgScope)
+ Nothing -> (Nothing, Nothing, Nothing, Nothing, Nothing)
+ Just QuotedMsg {msgRef = MsgRef {msgId = sharedMsgId, sentAt, sent, memberId}, content} ->
+ uncurry (sharedMsgId,Just sentAt,Just content,,) $ case chatDirection of
+ CDDirectRcv _ -> (Just $ not sent, Nothing)
+ CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ ->
+ (Just $ Just userMemberId == memberId, memberId)
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItemNoMsg db user chatDirection ciContent =
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False
where
quoteRow :: NewQuoteRow
- quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing)
+ quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs createdAt = do
@@ -366,12 +359,12 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
[sql|
INSERT INTO chat_items (
-- user and IDs
- user_id, created_by_msg_id, contact_id, group_id, group_member_id, item_direct_group_member_id,
+ user_id, created_by_msg_id, contact_id, group_id, group_member_id,
-- meta
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
-- quote
- quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id, quoted_message_scope
- ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
+ ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
ciId <- insertedRowId db
@@ -380,16 +373,12 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
where
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
- idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
+ idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
idsRow = case chatDirection of
- CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
- CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing)
- CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} messageScope -> case messageScope of
- MSGroup -> (Nothing, Just groupId, Just groupMemberId, Nothing)
- MSDirect -> (Nothing, Just groupId, Just groupMemberId, Just groupMemberId)
- CDGroupSnd GroupInfo {groupId} directMember -> case directMember of
- Nothing -> (Nothing, Just groupId, Nothing, Nothing)
- Just GroupMember {groupMemberId} -> (Nothing, Just groupId, Nothing, Just groupMemberId)
+ CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
+ CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing)
+ CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId)
+ CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing)
ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime)
ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt)
@@ -399,21 +388,19 @@ insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime ->
insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts)
getChatItemQuote_ :: DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c)
-getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId, msgScope}, content} =
+getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} =
case chatDirection of
CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent)
- CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} _directMember ->
+ CDGroupRcv GroupInfo {groupId, membership = GroupMember {memberId = userMemberId}} sender@GroupMember {memberId = senderMemberId} ->
case memberId of
Just mId
- | mId == userMemberId -> (`ciQuote` CIQGroupSnd messageScope) <$> getUserGroupChatItemId_ groupId
- | mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender) messageScope) <$> getGroupChatItemId_ groupId mId
+ | mId == userMemberId -> (`ciQuote` CIQGroupSnd) <$> getUserGroupChatItemId_ groupId
+ | mId == senderMemberId -> (`ciQuote` CIQGroupRcv (Just sender)) <$> getGroupChatItemId_ groupId mId
| otherwise -> getGroupChatItemQuote_ groupId mId
- _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing messageScope
+ _ -> pure . ciQuote Nothing $ CIQGroupRcv Nothing
where
ciQuote :: Maybe ChatItemId -> CIQDirection c -> CIQuote c
ciQuote itemId dir = CIQuote dir itemId msgId sentAt content . parseMaybeMarkdownList $ msgContentText content
- messageScope :: MessageScope
- messageScope = fromMaybe MSGroup msgScope
getDirectChatItemQuote_ :: Int64 -> Bool -> IO (CIQuote 'CTDirect)
getDirectChatItemQuote_ contactId userSent = do
fmap ciQuoteDirect . maybeFirstRow fromOnly $
@@ -460,8 +447,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
[":user_id" := userId, ":group_id" := groupId, ":member_id" := mId, ":msg_id" := msgId]
where
ciQuoteGroup :: [Only (Maybe ChatItemId) :. GroupMemberRow] -> CIQuote 'CTGroup
- ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing messageScope
- ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId $ CIQGroupRcv (Just $ toGroupMember userContactId memberRow) messageScope
+ ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
+ ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
getChatPreviews :: DB.Connection -> User -> Bool -> IO [AChat]
getChatPreviews db user withPCC = do
@@ -569,7 +556,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
- ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, i.quoted_message_scope,
+ ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
@@ -577,11 +564,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
- dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
- -- direct GroupMember
- dirm.group_member_id, dirm.group_id, dirm.member_id, dirm.member_role, dirm.member_category,
- dirm.member_status, dirm.invited_by, dirm.local_display_name, dirm.contact_id, dirm.contact_profile_id, dirp.contact_profile_id,
- dirp.display_name, dirp.full_name, dirp.image, dirp.contact_link, dirp.local_alias, dirp.preferences
+ dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
@@ -607,8 +590,6 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
- LEFT JOIN group_members dirm ON dirm.group_member_id = i.item_direct_group_member_id
- LEFT JOIN contact_profiles dirp ON dirp.contact_profile_id = COALESCE(dirm.member_profile_id, dirm.contact_profile_id)
WHERE g.user_id = ? AND mu.contact_id = ?
ORDER BY i.item_ts DESC
|]
@@ -986,8 +967,10 @@ toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect)
toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent
where
direction sent = if sent then CIQDirectSnd else CIQDirectRcv
- toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir =
- CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
+
+toQuote :: QuoteRow -> Maybe (CIQDirection c) -> Maybe (CIQuote c)
+toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir =
+ CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
-- this function can be changed so it never fails, not only avoid failure on invalid json
toDirectChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect)
@@ -1030,60 +1013,37 @@ toDirectChatItemList currentTs (((Just itemId, Just itemTs, Just msgDir, Just it
either (const []) (: []) $ toDirectChatItem currentTs (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. quoteRow)
toDirectChatItemList _ _ = []
-type GroupQuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool, Maybe MessageScope)
+type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
-type GroupQuoteMemberRow = GroupQuoteRow :. MaybeGroupMemberRow
+type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
-type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteMemberRow :. MaybeGroupMemberRow :. MaybeGroupMemberRow
-
-toGroupQuote :: GroupQuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
-toGroupQuote qr@(_, _, _, _, quotedSent, msgScope) quotedMember_ =
- toQuote qr $ direction quotedSent quotedMember_
+toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
+toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
where
- direction (Just True) _ = Just $ CIQGroupSnd messageScope
- direction (Just False) (Just member) = Just $ CIQGroupRcv (Just member) messageScope
- direction (Just False) Nothing = Just $ CIQGroupRcv Nothing messageScope
+ direction (Just True) _ = Just CIQGroupSnd
+ direction (Just False) (Just member) = Just . CIQGroupRcv $ Just member
+ direction (Just False) Nothing = Just $ CIQGroupRcv Nothing
direction _ _ = Nothing
- messageScope = fromMaybe MSGroup msgScope
- toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _, _) dir =
- CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent)
-- this function can be changed so it never fails, not only avoid failure on invalid json
-toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteMemberRow :. MaybeGroupMemberRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
-toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_) = do
+toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
+toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
where
member_ = toMaybeGroupMember userContactId memberRow_
quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_
deletedByGroupMember_ = toMaybeGroupMember userContactId deletedByGroupMemberRow_
- directMember_ = toMaybeGroupMember userContactId directMemberRow_
invalid = ACIContent msgDir $ CIInvalidJSON itemContentText
chatItem itemContent = case (itemContent, itemStatus, member_, fileStatus_) of
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) ->
- Right $ cItem SMDSnd (CIGroupSnd directMember_) ciStatus ciContent (maybeCIFile fileStatus)
+ Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent (maybeCIFile fileStatus)
(ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Nothing) ->
- Right $ cItem SMDSnd (CIGroupSnd directMember_) ciStatus ciContent Nothing
- -- read of group chat item can be refactored so that direct member is not read for rcv items:
- -- if item_direct_group_member_id is equal to group_member_id, then message scope is direct
+ Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent Nothing
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Just (AFS SMDRcv fileStatus)) ->
- case directMember_ of
- Just directMember
- | sameMember member directMember ->
- Right $ cItem SMDRcv (CIGroupRcv member MSDirect) ciStatus ciContent (maybeCIFile fileStatus)
- | otherwise -> badItem
- Nothing ->
- Right $ cItem SMDRcv (CIGroupRcv member MSGroup) ciStatus ciContent (maybeCIFile fileStatus)
+ Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent (maybeCIFile fileStatus)
(ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Nothing) ->
- case directMember_ of
- Just directMember
- | sameMember member directMember ->
- Right $ cItem SMDRcv (CIGroupRcv member MSDirect) ciStatus ciContent Nothing
- | otherwise -> badItem
- Nothing ->
- Right $ cItem SMDRcv (CIGroupRcv member MSGroup) ciStatus ciContent Nothing
+ Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent Nothing
_ -> badItem
- sameMember :: GroupMember -> GroupMember -> Bool
- sameMember GroupMember {groupMemberId = gmId1} GroupMember {groupMemberId = gmId2} = gmId1 == gmId2
maybeCIFile :: CIFileStatus d -> Maybe (CIFile d)
maybeCIFile fileStatus =
case (fileId_, fileName_, fileSize_, fileProtocol_) of
@@ -1108,8 +1068,8 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
-toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_) =
- either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_ :. directMemberRow_)
+toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
+ either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
toGroupChatItemList _ _ _ = []
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
@@ -1524,7 +1484,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
-- quoted ChatItem
- ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, i.quoted_message_scope,
+ ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
@@ -1532,11 +1492,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
- dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
- -- direct GroupMember
- dirm.group_member_id, dirm.group_id, dirm.member_id, dirm.member_role, dirm.member_category,
- dirm.member_status, dirm.invited_by, dirm.local_display_name, dirm.contact_id, dirm.contact_profile_id, dirp.contact_profile_id,
- dirp.display_name, dirp.full_name, dirp.image, dirp.contact_link, dirp.local_alias, dirp.preferences
+ dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
@@ -1546,8 +1502,6 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
LEFT JOIN contact_profiles rp ON rp.contact_profile_id = COALESCE(rm.member_profile_id, rm.contact_profile_id)
LEFT JOIN group_members dbm ON dbm.group_member_id = i.item_deleted_by_group_member_id
LEFT JOIN contact_profiles dbp ON dbp.contact_profile_id = COALESCE(dbm.member_profile_id, dbm.contact_profile_id)
- LEFT JOIN group_members dirm ON dirm.group_member_id = i.item_direct_group_member_id
- LEFT JOIN contact_profiles dirp ON dirp.contact_profile_id = COALESCE(dirm.member_profile_id, dirm.contact_profile_id)
WHERE i.user_id = ? AND i.group_id = ? AND i.chat_item_id = ?
|]
(userId, groupId, itemId)
diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs
index 74e2d89d72..cbcc4ddd28 100644
--- a/src/Simplex/Chat/Store/Migrations.hs
+++ b/src/Simplex/Chat/Store/Migrations.hs
@@ -79,7 +79,6 @@ import Simplex.Chat.Migrations.M20230814_indexes
import Simplex.Chat.Migrations.M20230827_file_encryption
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
-import Simplex.Chat.Migrations.M20230904_item_direct_group_member_id
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -158,8 +157,7 @@ schemaMigrations =
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption),
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
- ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
- ("20230904_item_direct_group_member_id", m20230904_item_direct_group_member_id, Just down_m20230904_item_direct_group_member_id)
+ ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe)
]
-- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs
index f28795a374..36cec49d7c 100644
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -73,19 +73,19 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
Right SendMessageBroadcast {} -> True
_ -> False
startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
- startLiveMessage (Right (SendLiveMessage sendName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
+ startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
whenM (isNothing <$> readTVarIO liveMessageState) $ do
let s = T.unpack msg
int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int
liveThreadId <- mkWeakThreadId =<< runLiveMessage int `forkFinally` const (atomically $ writeTVar liveMessageState Nothing)
promptThreadId <- mkWeakThreadId =<< forkIO blinkLivePrompt
atomically $ do
- let lm = LiveMessage {sendName, chatItemId = itemId, livePrompt = True, sentMsg = s, typedMsg = s, liveThreadId, promptThreadId}
+ let lm = LiveMessage {chatName, chatItemId = itemId, livePrompt = True, sentMsg = s, typedMsg = s, liveThreadId, promptThreadId}
writeTVar liveMessageState (Just lm)
modifyTVar termState $ \ts -> ts {inputString = s, inputPosition = length s, inputPrompt = liveInputPrompt lm}
where
- liveInputPrompt LiveMessage {sendName = n, livePrompt} =
- "> " <> sendNameStr n <> " [" <> (if livePrompt then "LIVE" else " ") <> "] "
+ liveInputPrompt LiveMessage {chatName = n, livePrompt} =
+ "> " <> chatNameStr n <> " [" <> (if livePrompt then "LIVE" else " ") <> "] "
runLiveMessage :: Int -> IO ()
runLiveMessage int = do
threadDelay int
@@ -123,8 +123,8 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
startLiveMessage _ _ = pure ()
sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO ChatResponse
-sendUpdatedLiveMessage cc sentMsg LiveMessage {sendName, chatItemId} live = do
- let cmd = UpdateLiveMessage sendName chatItemId live $ T.pack sentMsg
+sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
+ let cmd = UpdateLiveMessage chatName chatItemId live $ T.pack sentMsg
either (CRChatCmdError Nothing) id <$> runExceptT (processChatCommand cmd) `runReaderT` cc
runTerminalInput :: ChatTerminal -> ChatController -> IO ()
@@ -174,14 +174,14 @@ receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, chatStore} ct@C
let s = inputString ts
lm_ <- readTVar liveMessageState
case lm_ of
- Just LiveMessage {sendName}
+ Just LiveMessage {chatName}
| live -> do
writeTVar termState ts' {previousInput}
- writeTBQueue inputQ $ "/live " <> sendNameStr sendName
+ writeTBQueue inputQ $ "/live " <> chatNameStr chatName
| otherwise ->
writeTVar termState ts' {inputPrompt = "> ", previousInput}
where
- previousInput = sendNameStr sendName <> " " <> s
+ previousInput = chatNameStr chatName <> " " <> s
_
| live -> when (isSend s) $ do
writeTVar termState ts' {previousInput = s}
diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs
index 1a36380282..ce68d715fe 100644
--- a/src/Simplex/Chat/Terminal/Output.hs
+++ b/src/Simplex/Chat/Terminal/Output.hs
@@ -55,7 +55,7 @@ data AutoCompleteState = ACState
}
data LiveMessage = LiveMessage
- { sendName :: SendName,
+ { chatName :: ChatName,
chatItemId :: ChatItemId,
livePrompt :: Bool,
sentMsg :: String,
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index bcef3cbff9..2d77cbe771 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -330,12 +330,12 @@ data GroupSummary = GroupSummary
instance ToJSON GroupSummary where toEncoding = J.genericToEncoding J.defaultOptions
-data ContactOrGroup = CGContact Contact | CGGroup GroupInfo
+data ContactOrGroup = CGContact Contact | CGGroup Group
contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
contactAndGroupIds = \case
CGContact Contact {contactId} -> (Just contactId, Nothing)
- CGGroup GroupInfo {groupId} -> (Nothing, Just groupId)
+ CGGroup (Group GroupInfo {groupId} _) -> (Nothing, Just groupId)
-- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties)
data ChatSettings = ChatSettings
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 4656ea5b20..1a740bef5f 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -322,35 +322,14 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
testViewChat :: AChat -> [StyledString]
testViewChat (AChat _ Chat {chatInfo, chatItems}) = [sShow $ map toChatView chatItems]
where
- toChatView :: CChatItem c -> ((Int, String, Text), Maybe (Int, String, Text), Maybe String)
- toChatView ci@(CChatItem dir ChatItem {chatDir, quotedItem, file}) =
- (item, qItem, fPath)
+ toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text), Maybe String)
+ toChatView ci@(CChatItem dir ChatItem {quotedItem, file}) =
+ ((msgDirectionInt $ toMsgDirection dir, testViewItem ci (chatInfoMembership chatInfo)), qItem, fPath)
where
- item =
- ( msgDirectionInt $ toMsgDirection dir,
- directMemberName,
- testViewItem ci (chatInfoMembership chatInfo)
- )
- directMemberName = case chatDir of
- CIGroupSnd (Just GroupMember {localDisplayName = n}) -> T.unpack n
- CIGroupRcv GroupMember {localDisplayName = n} MSDirect -> T.unpack n
- _ -> ""
qItem = case quotedItem of
Nothing -> Nothing
Just CIQuote {chatDir = quoteDir, content} ->
- Just
- ( msgDirectionInt $ quoteMsgDirection quoteDir,
- qMsgScope,
- msgContentText content
- )
- where
- qMsgScope = case quoteDir of
- CIQGroupSnd ms -> msgScopeText ms
- CIQGroupRcv _ ms -> msgScopeText ms
- _ -> ""
- msgScopeText ms = case ms of
- MSGroup -> "group"
- MSDirect -> "direct"
+ Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
fPath = case file of
Just CIFile {fileSource = Just (CryptoFile fp _)} -> Just fp
_ -> Nothing
@@ -401,7 +380,7 @@ viewUsersList = mapMaybe userInfo . sortOn ldn
muted :: ChatInfo c -> CIDirection c d -> Bool
muted chat chatDir = case (chat, chatDir) of
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
- (GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _ _) -> True
+ (GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> True
_ -> False
viewGroupSubscribed :: GroupInfo -> [StyledString]
@@ -424,9 +403,8 @@ viewChats ts tz = concatMap chatPreview . reverse
where
chatName = case chat of
DirectChat ct -> [" " <> ttyToContact' ct]
- GroupChat g -> [" " <> ttyToGroup' g]
+ GroupChat g -> [" " <> ttyToGroup g]
_ -> []
- ttyToGroup' g@GroupInfo {localDisplayName = n} = membershipIncognito g <> ttyTo ("#" <> n <> " ")
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz =
@@ -448,20 +426,20 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
where
quote = maybe [] (directQuote chatDir) quotedItem
GroupChat g -> case chatDir of
- CIGroupSnd directMember -> case content of
+ CIGroupSnd -> case content of
CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to quote mc
CISndGroupInvitation {} -> showSndItemProhibited to
_ -> showSndItem to
where
- to = ttyToGroup g directMember
- CIGroupRcv m msgScope -> case content of
+ to = ttyToGroup g
+ CIGroupRcv m -> case content of
CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvGroupInvitation {} -> showRcvItemProhibited from
- CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m msgScope) quote meta [plainContent content] False
+ CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
_ -> showRcvItem from
where
- from = ttyFromGroup g m msgScope
+ from = ttyFromGroup g m
where
quote = maybe [] (groupQuote g) quotedItem
_ -> []
@@ -553,18 +531,18 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}
where
quote = maybe [] (directQuote chatDir) quotedItem
GroupChat g -> case chatDir of
- CIGroupRcv m msgScope -> case content of
+ CIGroupRcv m -> case content of
CIRcvMsgContent mc
| itemLive == Just True && not liveItems -> []
| otherwise -> viewReceivedUpdatedMessage from quote mc ts tz meta
_ -> []
where
- from = if itemEdited then ttyFromGroupEdited g m msgScope else ttyFromGroup g m msgScope
- CIGroupSnd directMember -> case content of
+ from = if itemEdited then ttyFromGroupEdited g m else ttyFromGroup g m
+ CIGroupSnd -> case content of
CISndMsgContent mc -> hideLive meta $ viewSentMessage to quote mc ts tz meta
_ -> []
where
- to = if itemEdited then ttyToGroupEdited g directMember else ttyToGroup g directMember
+ to = if itemEdited then ttyToGroupEdited g else ttyToGroup g
where
quote = maybe [] (groupQuote g) quotedItem
_ -> []
@@ -589,8 +567,7 @@ viewItemDelete chat ci@ChatItem {chatDir, meta, content = deletedContent} toItem
GroupChat g -> case ciMsgContent deletedContent of
Just mc ->
let m = chatItemMember g ci
- msgScope = directMemberToMsgScope $ ciDirDirectMember chatDir
- in viewReceivedMessage (ttyFromGroupDeleted g m msgScope deletedText_) [] mc ts tz meta
+ in viewReceivedMessage (ttyFromGroupDeleted g m deletedText_) [] mc ts tz meta
_ -> prohibited
_ -> prohibited
where
@@ -609,14 +586,14 @@ viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md
where
from = ttyFromContact c
reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then ">>" else ">"
- (GroupChat g, CIGroupRcv m messageScope) -> case ciMsgContent content of
+ (GroupChat g, CIGroupRcv m) -> case ciMsgContent content of
Just mc -> view from $ reactionMsg mc
_ -> []
where
- from = ttyFromGroup g m messageScope
+ from = ttyFromGroup g m
reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir
(_, CIDirectSnd) -> [sentText]
- (_, CIGroupSnd _) -> [sentText]
+ (_, CIGroupSnd) -> [sentText]
where
view from msg
| showReactions = viewReceivedReaction from msg reactionText ts tz sentAt
@@ -644,13 +621,13 @@ groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQu
sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember
sentByMember GroupInfo {membership} = \case
- CIQGroupSnd _ -> Just membership
- CIQGroupRcv m _ -> m
+ CIQGroupSnd -> Just membership
+ CIQGroupRcv m -> m
sentByMember' :: GroupInfo -> CIDirection 'CTGroup d -> GroupMember
sentByMember' GroupInfo {membership} = \case
- CIGroupSnd _ -> membership
- CIGroupRcv m _ -> m
+ CIGroupSnd -> membership
+ CIGroupRcv m -> m
quoteText :: MsgContent -> StyledString -> [StyledString]
quoteText qmc sentBy = prependFirst (sentBy <> " ") $ msgPreview qmc
@@ -1342,9 +1319,8 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
uploadingFile :: StyledString -> AChatItem -> [StyledString]
uploadingFile status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd}) =
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
-uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd directMember}) =
- let forMember = maybe "" (\GroupMember {localDisplayName = m} -> styled (colored Blue) $ " @" <> m <> " (direct)") directMember
- in [status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g <> forMember]
+uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd}) =
+ [status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
sndFile :: SndFileTransfer -> StyledString
@@ -1376,7 +1352,7 @@ savingFile' :: Bool -> AChatItem -> [StyledString]
savingFile' testView (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath cfArgs_)}, chatDir}) =
let from = case (chat, chatDir) of
(DirectChat Contact {localDisplayName = c}, CIDirectRcv) -> " from " <> ttyContact c
- (_, CIGroupRcv GroupMember {localDisplayName = m} _) -> " from " <> ttyContact m
+ (_, CIGroupRcv GroupMember {localDisplayName = m}) -> " from " <> ttyContact m
_ -> ""
in ["saving file " <> sShow fileId <> from <> " to " <> plain filePath] <> cfArgsStr
where
@@ -1390,7 +1366,7 @@ savingFile' _ _ = ["saving file"] -- shouldn't happen
receivingFile_' :: StyledString -> AChatItem -> [StyledString]
receivingFile_' status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) =
[status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact c]
-receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv GroupMember {localDisplayName = m} _}) =
+receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv GroupMember {localDisplayName = m}}) =
[status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact m]
receivingFile_' status _ = [status <> " receiving file"] -- shouldn't happen
@@ -1606,7 +1582,7 @@ viewChatError logLevel = \case
CEXFTPSndFile fileId aFileId e -> ["error sending XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError]
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 -> ["invalid message reply"]
+ CEInvalidQuote -> ["cannot reply to this message"]
CEInvalidChatItemUpdate -> ["cannot update this item"]
CEInvalidChatItemDelete -> ["cannot delete this item"]
CEHasCurrentCall -> ["call already in progress"]
@@ -1621,7 +1597,6 @@ viewChatError logLevel = \case
CEAgentCommandError e -> ["agent command error: " <> plain e]
CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
CEConnectionIncognitoChangeProhibited -> ["incognito mode change prohibited"]
- CEPeerChatVRangeIncompatible -> ["peer chat protocol version range incompatible"]
CEInternalError e -> ["internal chat error: " <> plain e]
CEException e -> ["exception: " <> plain e]
-- e -> ["chat error: " <> sShow e]
@@ -1762,24 +1737,19 @@ ttyFullGroup :: GroupInfo -> StyledString
ttyFullGroup GroupInfo {localDisplayName = g, groupProfile = GroupProfile {fullName}} =
ttyGroup g <> optFullName g fullName
-ttyFromGroup :: GroupInfo -> GroupMember -> MessageScope -> StyledString
-ttyFromGroup g m ms = membershipIncognito g <> ttyFrom (fromGroup_ g m ms)
+ttyFromGroup :: GroupInfo -> GroupMember -> StyledString
+ttyFromGroup g m = membershipIncognito g <> ttyFrom (fromGroup_ g m)
-ttyFromGroupEdited :: GroupInfo -> GroupMember -> MessageScope -> StyledString
-ttyFromGroupEdited g m ms = membershipIncognito g <> ttyFrom (fromGroup_ g m ms <> "[edited] ")
+ttyFromGroupEdited :: GroupInfo -> GroupMember -> StyledString
+ttyFromGroupEdited g m = membershipIncognito g <> ttyFrom (fromGroup_ g m <> "[edited] ")
-ttyFromGroupDeleted :: GroupInfo -> GroupMember -> MessageScope -> Maybe Text -> StyledString
-ttyFromGroupDeleted g m ms deletedText_ =
- membershipIncognito g <> ttyFrom (fromGroup_ g m ms <> maybe "" (\t -> "[" <> t <> "] ") deletedText_)
+ttyFromGroupDeleted :: GroupInfo -> GroupMember -> Maybe Text -> StyledString
+ttyFromGroupDeleted g m deletedText_ =
+ membershipIncognito g <> ttyFrom (fromGroup_ g m <> maybe "" (\t -> "[" <> t <> "] ") deletedText_)
-fromGroup_ :: GroupInfo -> GroupMember -> MessageScope -> Text
-fromGroup_ GroupInfo {localDisplayName = g} GroupMember {localDisplayName = m} ms =
- "#" <> g <> " " <> m <> fromGroupScope ms <> "> "
-
-fromGroupScope :: MessageScope -> Text
-fromGroupScope = \case
- MSGroup -> ""
- MSDirect -> " (direct)"
+fromGroup_ :: GroupInfo -> GroupMember -> Text
+fromGroup_ GroupInfo {localDisplayName = g} GroupMember {localDisplayName = m} =
+ "#" <> g <> " " <> m <> "> "
ttyFrom :: Text -> StyledString
ttyFrom = styled $ colored Yellow
@@ -1787,18 +1757,13 @@ ttyFrom = styled $ colored Yellow
ttyTo :: Text -> StyledString
ttyTo = styled $ colored Cyan
-ttyToGroup :: GroupInfo -> Maybe GroupMember -> StyledString
-ttyToGroup g@GroupInfo {localDisplayName = n} dirMem =
- membershipIncognito g <> ttyTo ("#" <> n <> toDirectMember dirMem <> " ")
+ttyToGroup :: GroupInfo -> StyledString
+ttyToGroup g@GroupInfo {localDisplayName = n} =
+ membershipIncognito g <> ttyTo ("#" <> n <> " ")
-ttyToGroupEdited :: GroupInfo -> Maybe GroupMember -> StyledString
-ttyToGroupEdited g@GroupInfo {localDisplayName = n} dirMem =
- membershipIncognito g <> ttyTo ("#" <> n <> toDirectMember dirMem <> " [edited] ")
-
-toDirectMember :: Maybe GroupMember -> Text
-toDirectMember = \case
- Nothing -> ""
- Just GroupMember {localDisplayName = m} -> " @" <> m <> " (direct)"
+ttyToGroupEdited :: GroupInfo -> StyledString
+ttyToGroupEdited g@GroupInfo {localDisplayName = n} =
+ membershipIncognito g <> ttyTo ("#" <> n <> " [edited] ")
ttyFilePath :: FilePath -> StyledString
ttyFilePath = plain
diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs
index de6353d2e0..9e5d4fe1c0 100644
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -259,7 +259,7 @@ getTermLine cc =
Just s -> do
-- remove condition to always echo virtual terminal
when (printOutput cc) $ do
- -- when True $ do
+ -- when True $ do
name <- userName cc
putStrLn $ name <> ": " <> s
pure s
diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs
index 6c804659e7..d476285fcd 100644
--- a/tests/ChatTests/Groups.hs
+++ b/tests/ChatTests/Groups.hs
@@ -8,9 +8,8 @@ import ChatTests.Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Monad (when)
-import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
-import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
+import Simplex.Chat.Controller (ChatConfig (..))
import Simplex.Chat.Protocol (supportedChatVRange)
import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
import Simplex.Chat.Types (GroupMemberRole (..))
@@ -82,21 +81,6 @@ chatGroupTests = do
testNoDirect4 _1 _0 _1 False False False -- False False True
testNoDirect4 _1 _1 _0 False False False
testNoDirect4 _1 _1 _1 False False False
- describe "group direct messages" $ do
- it "should send group direct messages" testGroupDirectMessages
- it "should create group direct messages chat items" testGroupDirectMessagesItems
- it "should send group direct quotes" testGroupDirectQuotes
- it "should create group direct quotes chat items" testGroupDirectQuotesItems
- it "should send group direct XFTP files" testGroupDirectFilesXFTP
- it "should send group direct SMP files" testGroupDirectFilesSMP
- it "should cancel sent group direct XFTP file" testGroupDirectCancelFileXFTP
- it "should send group direct quotes with files" testGroupDirectQuotesFiles
- it "should update group direct message" testGroupDirectUpdate
- it "should delete group direct message" testGroupDirectDelete
- it "should send group direct live message" testGroupDirectLiveMessage
- it "should send group direct message reactions" testGroupDirectReactions
- it "should prohibit group direct messages based on preference" testGroupDirectProhibitPreference
- it "should prohibit group direct messages if peer version doesn't support" testGroupDirectProhibitNotSupported
where
_0 = supportedChatVRange -- don't create direct connections
_1 = groupCreateDirectVRange
@@ -820,7 +804,7 @@ testGroupMessageQuotedReply =
(bob <# "#team alice> hello! how are you?")
(cath <# "#team alice> hello! how are you?")
threadDelay 1000000
- bob `send` "> #team >@alice (hello) hello, all good, you?"
+ bob `send` "> #team @alice (hello) hello, all good, you?"
bob <# "#team > alice hello! how are you?"
bob <## " hello, all good, you?"
concurrently_
@@ -835,7 +819,7 @@ testGroupMessageQuotedReply =
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((1, "hello, all good, you?"), Just (0, "hello! how are you?"))])
alice #$> ("/_get chat #1 count=2", chat', [((1, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (1, "hello! how are you?"))])
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (0, "hello! how are you?"))])
- bob `send` "> #team >@bob (hello, all good) will tell more"
+ bob `send` "> #team bob (hello, all good) will tell more"
bob <# "#team > bob hello, all good, you?"
bob <## " will tell more"
concurrently_
@@ -851,7 +835,7 @@ testGroupMessageQuotedReply =
alice #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))])
cath #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))])
threadDelay 1000000
- cath `send` "> #team >@bob (hello) hi there!"
+ cath `send` "> #team bob (hello) hi there!"
cath <# "#team > bob hello, all good, you?"
cath <## " hi there!"
concurrently_
@@ -907,7 +891,7 @@ testGroupMessageUpdate =
threadDelay 1000000
-- alice, bob: msg id 6, cath: msg id 5
- bob `send` "> #team >@alice (hey) hi alice"
+ bob `send` "> #team @alice (hey) hi alice"
bob <# "#team > alice hey 👋"
bob <## " hi alice"
concurrently_
@@ -934,7 +918,7 @@ testGroupMessageUpdate =
alice #$> ("/_update item #1 " <> msgItemId2 <> " text updating bob's message", id, "cannot update this item")
threadDelay 1000000
- cath `send` "> #team >@alice (greetings) greetings!"
+ cath `send` "> #team @alice (greetings) greetings!"
cath <# "#team > alice greetings 🤝"
cath <## " greetings!"
concurrently_
@@ -1010,6 +994,7 @@ testGroupMessageEditHistory =
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey there")
alice <# "#team [edited] hey there"
+ bob <# "#team alice> [edited] hey there"
alice ##> "/item info #team hey"
alice <##. "sent at: "
@@ -1019,7 +1004,10 @@ testGroupMessageEditHistory =
alice .<## ": hey 👋"
alice .<## ": hello!"
bob ##> "/item info #team hey"
- bob <## "message not found by text: hey"
+ bob <##. "sent at: "
+ bob <##. "received at: "
+ bob <## "message history:"
+ bob .<## ": hey there"
testGroupMessageDelete :: HasCallStack => FilePath -> IO ()
testGroupMessageDelete =
@@ -1043,7 +1031,7 @@ testGroupMessageDelete =
threadDelay 1000000
-- alice: msg id 5, bob: msg id 6, cath: msg id 5
- bob `send` "> #team >@alice (hello) hi alic"
+ bob `send` "> #team @alice (hello) hi alic"
bob <# "#team > alice hello!"
bob <## " hi alic"
concurrently_
@@ -1072,10 +1060,14 @@ testGroupMessageDelete =
bob ##> ("/_update item #1 " <> msgItemId3 <> " text hi alice")
bob <# "#team [edited] > alice hello!"
bob <## " hi alice"
- cath <# "#team bob> [edited] > alice hello!"
- cath <## " hi alice"
+ concurrently_
+ (alice <# "#team bob> [edited] hi alice")
+ ( do
+ cath <# "#team bob> [edited] > alice hello!"
+ cath <## " hi alice"
+ )
- alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
+ alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alice"), Nothing)])
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
@@ -2694,534 +2686,3 @@ testNoGroupDirectConns4Members hostVRange mem2VRange mem3VRange mem4VRange noCon
cc1 <## ("no contact " <> name2)
cc2 ##> ("@" <> name1 <> " hi")
cc2 <## ("no contact " <> name1)
-
-testGroupDirectMessages :: HasCallStack => FilePath -> IO ()
-testGroupDirectMessages =
- testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do
- createGroup3 "team" alice bob cath
- connectUsers alice dan
- addMember "team" alice dan GRMember
- dan ##> "/j team"
- concurrentlyN_
- [ alice <## "#team: dan joined the group",
- do
- dan <## "#team: you joined the group"
- dan
- <### [ "#team: member bob (Bob) is connected",
- "#team: member cath (Catherine) is connected"
- ],
- aliceAddedDan bob,
- aliceAddedDan cath
- ]
-
- alice #> "#team hi"
- bob <# "#team alice> hi"
- cath <# "#team alice> hi"
- dan <# "#team alice> hi"
-
- alice `send` "#team @bob hi bob"
- alice <# "#team @bob (direct) hi bob"
- bob <# "#team alice (direct)> hi bob"
-
- bob `send` "#team @alice hi alice"
- bob <# "#team @alice (direct) hi alice"
- alice <# "#team bob (direct)> hi alice"
-
- dan #> "#team hello"
- alice <# "#team dan> hello"
- bob <# "#team dan> hello"
- cath <# "#team dan> hello"
-
- bob `send` "#team @cath hi cath"
- bob <# "#team @cath (direct) hi cath"
- cath <# "#team bob (direct)> hi cath"
-
- cath `send` "#team @bob hello bob"
- cath <# "#team @bob (direct) hello bob"
- bob <# "#team cath (direct)> hello bob"
- where
- aliceAddedDan :: HasCallStack => TestCC -> IO ()
- aliceAddedDan cc = do
- cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
- cc <## "#team: new member dan is connected"
-
-testGroupDirectMessagesItems :: HasCallStack => FilePath -> IO ()
-testGroupDirectMessagesItems =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
- threadDelay 1000000
-
- alice #> "#team hi"
- bob <# "#team alice> hi"
- cath <# "#team alice> hi"
- threadDelay 1000000
-
- alice `send` "#team @bob hi bob"
- alice <# "#team @bob (direct) hi bob"
- bob <# "#team alice (direct)> hi bob"
- threadDelay 1000000
-
- bob `send` "#team @alice hi alice"
- bob <# "#team @alice (direct) hi alice"
- alice <# "#team bob (direct)> hi alice"
- threadDelay 1000000
-
- alice #$> ("/_get chat #1 count=4", mapChat, [(0, "", "connected"), (1, "", "hi"), (1, "bob", "hi bob"), (0, "bob", "hi alice")])
- bob #$> ("/_get chat #1 count=4", mapChat, [(0, "", "connected"), (0, "", "hi"), (0, "alice", "hi bob"), (1, "alice", "hi alice")])
- cath #$> ("/_get chat #1 count=2", mapChat, [(0, "", "connected"), (0, "", "hi")])
- where
- mapChat = map (\(a, _, _) -> a) . chat'''
-
-testGroupDirectQuotes :: HasCallStack => FilePath -> IO ()
-testGroupDirectQuotes =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
-
- alice #> "#team 1-g-a"
- bob <# "#team alice> 1-g-a"
- cath <# "#team alice> 1-g-a"
-
- bob #> "#team 2-g-b"
- alice <# "#team bob> 2-g-b"
- cath <# "#team bob> 2-g-b"
-
- cath #> "#team 3-g-c"
- alice <# "#team cath> 3-g-c"
- bob <# "#team cath> 3-g-c"
-
- alice `send` "#team @bob 4-p-ab"
- alice <# "#team @bob (direct) 4-p-ab"
- bob <# "#team alice (direct)> 4-p-ab"
-
- bob `send` "#team @alice 5-p-ba"
- bob <# "#team @alice (direct) 5-p-ba"
- alice <# "#team bob (direct)> 5-p-ba"
-
- alice `send` "#team @cath 6-p-ac"
- alice <# "#team @cath (direct) 6-p-ac"
- cath <# "#team alice (direct)> 6-p-ac"
-
- cath `send` "#team @alice 7-p-ca"
- cath <# "#team @alice (direct) 7-p-ca"
- alice <# "#team cath (direct)> 7-p-ca"
-
- -- quotes
-
- alice `send` "> #team @bob (1-g-a) 8-pq-ab"
- alice <# "#team @bob (direct) > alice 1-g-a"
- alice <## " 8-pq-ab"
- bob <# "#team alice (direct)> > alice 1-g-a"
- bob <## " 8-pq-ab"
-
- alice `send` "> #team @bob (2-g-b) 9-pq-ab"
- alice <# "#team @bob (direct) > bob 2-g-b"
- alice <## " 9-pq-ab"
- bob <# "#team alice (direct)> > bob 2-g-b"
- bob <## " 9-pq-ab"
-
- alice `send` "> #team >@cath @bob (3-g-c) 10-pq-ab"
- alice <# "#team @bob (direct) > cath 3-g-c"
- alice <## " 10-pq-ab"
- bob <# "#team alice (direct)> > cath 3-g-c"
- bob <## " 10-pq-ab"
-
- alice `send` "> #team @bob (4-p-ab) 11-pq-ab"
- alice <# "#team @bob (direct) > alice 4-p-ab"
- alice <## " 11-pq-ab"
- bob <# "#team alice (direct)> > alice 4-p-ab"
- bob <## " 11-pq-ab"
-
- alice `send` "> #team >@bob @bob (5-p-ba) 12-pq-ab"
- alice <# "#team @bob (direct) > bob 5-p-ba"
- alice <## " 12-pq-ab"
- bob <# "#team alice (direct)> > bob 5-p-ba"
- bob <## " 12-pq-ab"
-
- alice `send` "> #team @bob (6-p-ac) 13-pq-ab"
- alice <## "> #team @bob (6-p-ac) 13-pq-ab"
- alice <## "invalid message reply"
-
- alice `send` "> #team @bob (7-p-ca) 14-pq-ab"
- alice <## "> #team @bob (7-p-ca) 14-pq-ab"
- alice <## "invalid message reply"
-
- alice `send` "> #team (4-p-ab) 15-gq-a"
- alice <## "> #team (4-p-ab) 15-gq-a"
- alice <## "invalid message reply"
-
- alice `send` "> #team (5-p-ba) 16-gq-a"
- alice <## "> #team (5-p-ba) 16-gq-a"
- alice <## "invalid message reply"
-
-testGroupDirectQuotesItems :: HasCallStack => FilePath -> IO ()
-testGroupDirectQuotesItems =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
-
- alice #> "#team 1-g-a"
- bob <# "#team alice> 1-g-a"
- cath <# "#team alice> 1-g-a"
-
- alice `send` "#team @bob 2-p-ab"
- alice <# "#team @bob (direct) 2-p-ab"
- bob <# "#team alice (direct)> 2-p-ab"
-
- bob `send` "#team @alice 3-p-ba"
- bob <# "#team @alice (direct) 3-p-ba"
- alice <# "#team bob (direct)> 3-p-ba"
- threadDelay 1000000
-
- -- quotes
-
- alice `send` "> #team @bob (1-g-a) 4-pq-ab"
- alice <# "#team @bob (direct) > alice 1-g-a"
- alice <## " 4-pq-ab"
- bob <# "#team alice (direct)> > alice 1-g-a"
- bob <## " 4-pq-ab"
- threadDelay 1000000
-
- alice `send` "> #team @bob (2-p-ab) 5-pq-ab"
- alice <# "#team @bob (direct) > alice 2-p-ab"
- alice <## " 5-pq-ab"
- bob <# "#team alice (direct)> > alice 2-p-ab"
- bob <## " 5-pq-ab"
- threadDelay 1000000
-
- alice `send` "> #team >@bob @bob (3-p-ba) 6-pq-ab"
- alice <# "#team @bob (direct) > bob 3-p-ba"
- alice <## " 6-pq-ab"
- bob <# "#team alice (direct)> > bob 3-p-ba"
- bob <## " 6-pq-ab"
-
- alice
- #$> ( "/_get chat #1 count=3",
- mapChat,
- [ ((1, "bob", "4-pq-ab"), Just (1, "group", "1-g-a")),
- ((1, "bob", "5-pq-ab"), Just (1, "direct", "2-p-ab")),
- ((1, "bob", "6-pq-ab"), Just (0, "direct", "3-p-ba"))
- ]
- )
- bob
- #$> ( "/_get chat #1 count=3",
- mapChat,
- [ ((0, "alice", "4-pq-ab"), Just (0, "group", "1-g-a")),
- ((0, "alice", "5-pq-ab"), Just (0, "direct", "2-p-ab")),
- ((0, "alice", "6-pq-ab"), Just (1, "direct", "3-p-ba"))
- ]
- )
- where
- mapChat = map (\(a, b, _) -> (a, b)) . chat'''
-
-testGroupDirectFilesXFTP :: HasCallStack => FilePath -> IO ()
-testGroupDirectFilesXFTP =
- testChatCfg3 cfg aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- withXFTPServer $ do
- createGroup3 "team" alice bob cath
- threadDelay 1000000
-
- alice `send` "/f #team @bob ./tests/fixtures/test.pdf"
- alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
- alice <## "use /fc 1 to cancel sending"
- bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
- bob <## "use /fr 1 [/ | ] to receive it"
- alice <## "completed uploading file 1 (test.pdf) for #team @bob (direct)"
-
- bob ##> "/fr 1 ./tests/tmp"
- bob
- <### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
- "started receiving file 1 (test.pdf) from alice"
- ]
- bob <## "completed receiving file 1 (test.pdf) from alice"
-
- src <- B.readFile "./tests/fixtures/test.pdf"
- dest <- B.readFile "./tests/tmp/test.pdf"
- dest `shouldBe` src
-
- cath / 50000
- cath ##> "/fr 1 ./tests/tmp"
- cath <##. "chat db error: SEUserNotFoundByFileId"
-
- alice `send` "/f #team @cath ./tests/fixtures/test.jpg"
- alice <# "/f #team @cath (direct) ./tests/fixtures/test.jpg"
- alice <## "use /fc 2 to cancel sending"
- cath <# "#team alice (direct)> sends file test.jpg (136.5 KiB / 139737 bytes)"
- cath <## "use /fr 1 [/ | ] to receive it"
- alice <## "completed uploading file 2 (test.jpg) for #team @cath (direct)"
-
- cath ##> "/fr 1 ./tests/tmp"
- cath
- <### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
- "started receiving file 1 (test.jpg) from alice"
- ]
- cath <## "completed receiving file 1 (test.jpg) from alice"
-
- src2 <- B.readFile "./tests/fixtures/test.jpg"
- dest2 <- B.readFile "./tests/tmp/test.jpg"
- dest2 `shouldBe` src2
-
- bob / 50000
-
- alice #$> ("/_get chat #1 count=2", mapChat, [((1, "bob", ""), Just "./tests/fixtures/test.pdf"), ((1, "cath", ""), Just "./tests/fixtures/test.jpg")])
- bob #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.pdf")])
- cath #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.jpg")])
- where
- cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
- mapChat = map (\(a, _, c) -> (a, c)) . chat'''
-
-testGroupDirectFilesSMP :: HasCallStack => FilePath -> IO ()
-testGroupDirectFilesSMP =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
- threadDelay 1000000
-
- alice `send` "/f #team @bob ./tests/fixtures/test.pdf"
- alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
- alice <## "use /fc 1 to cancel sending"
- bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
- bob <## "use /fr 1 [/ | ] to receive it"
- bob ##> "/fr 1 ./tests/tmp"
- bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
- concurrently_
- (alice <## "started sending file 1 (test.pdf) to bob")
- (bob <## "started receiving file 1 (test.pdf) from alice")
- concurrently_
- (alice <## "completed sending file 1 (test.pdf) to bob")
- (bob <## "completed receiving file 1 (test.pdf) from alice")
-
- src <- B.readFile "./tests/fixtures/test.pdf"
- dest <- B.readFile "./tests/tmp/test.pdf"
- dest `shouldBe` src
-
- cath / 50000
- cath ##> "/fr 1 ./tests/tmp"
- cath <##. "chat db error: SEUserNotFoundByFileId"
-
- alice `send` "/f #team @cath ./tests/fixtures/test.jpg"
- alice <# "/f #team @cath (direct) ./tests/fixtures/test.jpg"
- alice <## "use /fc 2 to cancel sending"
- cath <# "#team alice (direct)> sends file test.jpg (136.5 KiB / 139737 bytes)"
- cath <## "use /fr 1 [/ | ] to receive it"
- cath ##> "/fr 1 ./tests/tmp"
- cath <## "saving file 1 from alice to ./tests/tmp/test.jpg"
- concurrently_
- (alice <## "started sending file 2 (test.jpg) to cath")
- (cath <## "started receiving file 1 (test.jpg) from alice")
- concurrently_
- (alice <## "completed sending file 2 (test.jpg) to cath")
- (cath <## "completed receiving file 1 (test.jpg) from alice")
-
- src2 <- B.readFile "./tests/fixtures/test.jpg"
- dest2 <- B.readFile "./tests/tmp/test.jpg"
- dest2 `shouldBe` src2
-
- bob / 50000
-
- alice #$> ("/_get chat #1 count=2", mapChat, [((1, "bob", ""), Just "./tests/fixtures/test.pdf"), ((1, "cath", ""), Just "./tests/fixtures/test.jpg")])
- bob #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.pdf")])
- cath #$> ("/_get chat #1 count=2", mapChat, [((0, "", "connected"), Nothing), ((0, "alice", ""), Just "./tests/tmp/test.jpg")])
- where
- mapChat = map (\(a, _, c) -> (a, c)) . chat'''
-
-testGroupDirectCancelFileXFTP :: HasCallStack => FilePath -> IO ()
-testGroupDirectCancelFileXFTP =
- testChatCfg3 cfg aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- withXFTPServer $ do
- createGroup3 "team" alice bob cath
-
- alice `send` "/f #team @bob ./tests/fixtures/test.pdf"
- alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
- alice <## "use /fc 1 to cancel sending"
- bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
- bob <## "use /fr 1 [/ | ] to receive it"
- alice <## "completed uploading file 1 (test.pdf) for #team @bob (direct)"
-
- cath / 50000
-
- alice ##> "/fc 1"
- alice <## "cancelled sending file 1 (test.pdf) to bob"
- bob <## "alice cancelled sending file 1 (test.pdf)"
-
- cath / 50000
-
- bob ##> "/fr 1 ./tests/tmp"
- bob <## "file cancelled: test.pdf"
-
- cath ##> "/fr 1 ./tests/tmp"
- cath <##. "chat db error: SEUserNotFoundByFileId"
- where
- cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
-
-testGroupDirectQuotesFiles :: HasCallStack => FilePath -> IO ()
-testGroupDirectQuotesFiles =
- testChatCfg3 cfg aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- withXFTPServer $ do
- createGroup3 "team" alice bob cath
- threadDelay 1000000
-
- bob `send` "#team @alice hi alice"
- bob <# "#team @alice (direct) hi alice"
- alice <# "#team bob (direct)> hi alice"
- threadDelay 1000000
-
- msgItemId1 <- lastItemId alice
- alice ##> ("/_send #1 @2 json {\"filePath\": \"./tests/fixtures/test.pdf\", \"quotedItemId\": " <> msgItemId1 <> ", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}")
- alice <# "#team @bob (direct) > bob hi alice"
- alice <## " hey bob"
- alice <# "/f #team @bob (direct) ./tests/fixtures/test.pdf"
- alice <## "use /fc 1 to cancel sending"
- bob <# "#team alice (direct)> > bob hi alice"
- bob <## " hey bob"
- bob <# "#team alice (direct)> sends file test.pdf (266.0 KiB / 272376 bytes)"
- bob <## "use /fr 1 [/ | ] to receive it"
- alice <## "completed uploading file 1 (test.pdf) for #team @bob (direct)"
-
- bob ##> "/fr 1 ./tests/tmp"
- bob
- <### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
- "started receiving file 1 (test.pdf) from alice"
- ]
- bob <## "completed receiving file 1 (test.pdf) from alice"
-
- src <- B.readFile "./tests/fixtures/test.pdf"
- dest <- B.readFile "./tests/tmp/test.pdf"
- dest `shouldBe` src
-
- cath / 50000
- cath ##> "/fr 1 ./tests/tmp"
- cath <##. "chat db error: SEUserNotFoundByFileId"
-
- alice
- #$> ( "/_get chat #1 count=2",
- chat''',
- [ ((0, "bob", "hi alice"), Nothing, Nothing),
- ((1, "bob", "hey bob"), Just (0, "direct", "hi alice"), Just "./tests/fixtures/test.pdf")
- ]
- )
- bob
- #$> ( "/_get chat #1 count=2",
- chat''',
- [ ((1, "alice", "hi alice"), Nothing, Nothing),
- ((0, "alice", "hey bob"), Just (1, "direct", "hi alice"), Just "./tests/tmp/test.pdf")
- ]
- )
- cath #$> ("/_get chat #1 count=1", chat''', [((0, "", "connected"), Nothing, Nothing)])
- where
- cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
-
-testGroupDirectUpdate :: HasCallStack => FilePath -> IO ()
-testGroupDirectUpdate =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
-
- alice `send` "#team @bob hi bob"
- alice <# "#team @bob (direct) hi bob"
- bob <# "#team alice (direct)> hi bob"
-
- msgItemId1 <- lastItemId alice
- alice ##> ("/_update item #1 " <> msgItemId1 <> " text hey 👋")
- alice <# "#team @bob (direct) [edited] hey 👋"
- bob <# "#team alice (direct)> [edited] hey 👋"
- cath / 50000
-
- alice ##> "! #team (hey 👋) hello there"
- alice <# "#team @bob (direct) [edited] hello there"
- bob <# "#team alice (direct)> [edited] hello there"
- cath / 50000
-
-testGroupDirectDelete :: HasCallStack => FilePath -> IO ()
-testGroupDirectDelete =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
-
- alice `send` "#team @bob hi bob"
- alice <# "#team @bob (direct) hi bob"
- bob <# "#team alice (direct)> hi bob"
-
- msgItemId1 <- lastItemId alice
- alice #$> ("/_delete item #1 " <> msgItemId1 <> " broadcast", id, "message marked deleted")
- bob <# "#team alice (direct)> [marked deleted] hi bob"
- cath / 50000
-
-testGroupDirectLiveMessage :: HasCallStack => FilePath -> IO ()
-testGroupDirectLiveMessage =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
-
- alice `send` "/live #team @bob hello"
- msgItemId1 <- lastItemId alice
- bob <#. "#team alice (direct)> [LIVE started]"
- alice ##> ("/_update item #1 " <> msgItemId1 <> " text hello there")
- alice <# "#team @bob (direct) [LIVE] hello there"
- bob <# "#team alice (direct)> [LIVE ended] hello there"
- cath / 50000
-
-testGroupDirectReactions :: HasCallStack => FilePath -> IO ()
-testGroupDirectReactions =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3 "team" alice bob cath
-
- alice `send` "#team @bob hi bob"
- alice <# "#team @bob (direct) hi bob"
- bob <# "#team alice (direct)> hi bob"
-
- bob ##> "+1 #team hi"
- bob <## "added 👍"
- alice <# "#team bob (direct)> > alice hi bob"
- alice <## " + 👍"
- cath / 50000
-
- alice ##> "+^ #team hi"
- alice <## "added 🚀"
- bob <# "#team alice (direct)> > alice hi bob"
- bob <## " + 🚀"
- cath / 50000
-
-testGroupDirectProhibitPreference :: HasCallStack => FilePath -> IO ()
-testGroupDirectProhibitPreference =
- testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
- createGroup3' "team" alice bob cath GRMember
-
- alice ##> "/set direct #team off"
- alice <## "updated group preferences:"
- alice <## "Direct messages: off"
- directProhibited bob
- directProhibited cath
-
- bob ##> "#team @cath hi cath"
- bob <## "bad chat command: direct messages not allowed"
-
- cath ##> "#team @bob hi cath"
- cath <## "bad chat command: direct messages not allowed"
-
- alice ##> "/mr team bob admin"
- alice <## "#team: you changed the role of bob from member to admin"
- concurrentlyN_
- [ bob <## "#team: alice changed your role from member to admin",
- cath <## "#team: alice changed the role of bob from member to admin"
- ]
-
- -- admin can send & can send to admin
-
- bob `send` "#team @cath hi cath, as admin"
- bob <# "#team @cath (direct) hi cath, as admin"
- cath <# "#team bob (direct)> hi cath, as admin"
-
- cath `send` "#team @bob hi bob, to admin"
- cath <# "#team @bob (direct) hi bob, to admin"
- bob <# "#team cath (direct)> hi bob, to admin"
- where
- directProhibited :: HasCallStack => TestCC -> IO ()
- directProhibited cc = do
- cc <## "alice updated group #team:"
- cc <## "updated group preferences:"
- cc <## "Direct messages: off"
-
-testGroupDirectProhibitNotSupported :: HasCallStack => FilePath -> IO ()
-testGroupDirectProhibitNotSupported tmp =
- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
- withNewTestChat tmp "bob" bobProfile $ \bob -> do
- withNewTestChatCfg tmp testCfg {chatVRange = mkVersionRange 1 1} "cath" cathProfile $ \cath -> do
- createGroup3 "team" alice bob cath
-
- bob ##> "#team @cath hi cath"
- bob <## "peer chat protocol version range incompatible"
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index 05075f5b5f..c120d661ff 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -181,12 +181,7 @@ chatF :: String -> [((Int, String), Maybe String)]
chatF = map (\(a, _, c) -> (a, c)) . chat''
chat'' :: String -> [((Int, String), Maybe (Int, String), Maybe String)]
-chat'' = map (\(a, b, c) -> (mapNoDirect a, mapNoDirect <$> b, c)) . chat'''
- where
- mapNoDirect (a1, _, a3) = (a1, a3)
-
-chat''' :: String -> [((Int, String, String), Maybe (Int, String, String), Maybe String)]
-chat''' = read
+chat'' = read
chatFeatures :: [(Int, String)]
chatFeatures = map (\(a, _, _) -> a) chatFeatures''
@@ -461,33 +456,27 @@ showName (TestCC ChatController {currentUser} _ _ _ _ _) = do
pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName
createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
-createGroup2 gName cc1 cc2 = createGroup2' gName cc1 cc2 GRAdmin
-
-createGroup2' :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
-createGroup2' gName cc1 cc2 memberRole = do
+createGroup2 gName cc1 cc2 = do
connectUsers cc1 cc2
name2 <- userName cc2
cc1 ##> ("/g " <> gName)
cc1 <## ("group #" <> gName <> " is created")
cc1 <## ("to add members use /a " <> gName <> " or /create link #" <> gName)
- addMember gName cc1 cc2 memberRole
+ addMember gName cc1 cc2 GRAdmin
cc2 ##> ("/j " <> gName)
concurrently_
(cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
(cc2 <## ("#" <> gName <> ": you joined the group"))
createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
-createGroup3 gName cc1 cc2 cc3 = createGroup3' gName cc1 cc2 cc3 GRAdmin
-
-createGroup3' :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> GroupMemberRole -> IO ()
-createGroup3' gName cc1 cc2 cc3 memberRole = do
- createGroup2' gName cc1 cc2 memberRole
+createGroup3 gName cc1 cc2 cc3 = do
+ createGroup2 gName cc1 cc2
connectUsers cc1 cc3
name1 <- userName cc1
name3 <- userName cc3
sName2 <- showName cc2
sName3 <- showName cc3
- addMember gName cc1 cc3 memberRole
+ addMember gName cc1 cc3 GRAdmin
cc3 ##> ("/j " <> gName)
concurrentlyN_
[ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"),
diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs
index f9421f6914..3acc78e7d8 100644
--- a/tests/ProtocolTests.hs
+++ b/tests/ProtocolTests.hs
@@ -57,7 +57,7 @@ testConnReq = CRInvitationUri connReqData testE2ERatchetParams
quotedMsg :: QuotedMsg
quotedMsg =
QuotedMsg
- (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing Nothing)
+ (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing)
$ MCText "hello there!"
(==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
@@ -105,13 +105,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 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) Nothing))
- it "x.msg.new simple text - direct message scope" $
- "{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"scope\":\"direct\"}}"
- #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing Nothing (Just MSDirect)))
+ #==# 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))
@@ -133,41 +130,27 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
chatInitialVRange
(Just $ SharedMsgId "\1\2\3\4")
(XMsgNew (MCQuote quotedMsg (extMsgContent (MCText "hello to you too") Nothing)))
- it "x.msg.new quote - direct referenced message scope" $
- "{\"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\",\"msgScope\":\"direct\"}}}}"
- ##==## ChatMessage
- chatInitialVRange
- (Just $ SharedMsgId "\1\2\3\4")
- ( XMsgNew
- ( MCQuote
- ( QuotedMsg
- (MsgRef (Just $ SharedMsgId "\5\6\7\8") (systemToUTCTime $ MkSystemTime 1 1) True Nothing (Just MSDirect))
- $ MCText "hello there!"
- )
- (extMsgContent (MCText "hello to you too") Nothing)
- )
- )
it "x.msg.new quote - timed message TTL" $
"{\"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\"}},\"ttl\":3600}}"
##==## ChatMessage
chatInitialVRange
(Just $ SharedMsgId "\1\2\3\4")
- (XMsgNew (MCQuote quotedMsg (ExtMsgContent (MCText "hello to you too") Nothing (Just 3600) Nothing 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) Nothing)))
+ (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 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) Nothing))
+ ##==## 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})))
From a1790d6ac007f90b5478438b1bb65c99568423d5 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 12 Sep 2023 17:59:09 +0400
Subject: [PATCH 06/17] core: use JVersionRange in UI facing types (#3048)
---
src/Simplex/Chat.hs | 24 +++++++++++++-----------
src/Simplex/Chat/Store/Groups.hs | 2 +-
src/Simplex/Chat/Store/Shared.hs | 6 +++---
src/Simplex/Chat/Types.hs | 14 ++++++++++----
src/Simplex/Chat/View.hs | 4 ++--
5 files changed, 29 insertions(+), 21 deletions(-)
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 49c5fc94ed..2e1d427af8 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1457,7 +1457,7 @@ processChatCommand = \case
dm <- directMessage $ XGrpAcpt (memberId (membership :: GroupMember))
agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode
withStore' $ \db -> do
- createMemberConnection db userId fromMember agentConnId peerChatVRange subMode
+ createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode
updateGroupMemberStatus db userId fromMember GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
updateCIGroupInvitationStatus user
@@ -2376,7 +2376,7 @@ acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId inv
let profileToSend = profileToSendOnAccept user incognitoProfile
dm <- directMessage $ XInfo profileToSend
acId <- withAgent $ \a -> acceptContact a True invId dm subMode
- withStore' $ \db -> createAcceptedContact db user acId cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode
+ withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode
acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
@@ -2384,7 +2384,7 @@ acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvI
let profileToSend = profileToSendOnAccept user incognitoProfile
(cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode
withStore' $ \db -> do
- ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode
+ ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode
setCommandConnId db user cmdId connId
pure ct
@@ -3025,7 +3025,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
subMode <- chatReadVar subscriptionMode
gVar <- asks idsDrg
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
- withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds peerChatVRange subMode
+ withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
_ -> pure ()
Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) ->
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
@@ -3093,7 +3093,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of
-- [async agent commands] XGrpMemIntro continuation on receiving INV
CFCreateConnGrpMemInv
- | isCompatibleRange (peerChatVRange conn) groupNoDirectVRange -> sendWithDirectCReq -- sendWithoutDirectCReq
+ | isCompatibleRange (fromJVersionRange $ peerChatVRange conn) groupNoDirectVRange -> sendWithDirectCReq -- sendWithoutDirectCReq
| otherwise -> sendWithDirectCReq
where
sendWithoutDirectCReq = do
@@ -4109,7 +4109,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
dm <- directMessage $ XGrpAcpt memberId
connIds <- joinAgentConnectionAsync user True connRequest dm subMode
withStore' $ \db -> do
- createMemberConnectionAsync db user hostId connIds peerChatVRange subMode
+ createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode
updateGroupMemberStatusById db userId hostId GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct)
@@ -4538,11 +4538,13 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> pure ()
updatePeerChatVRange :: ChatMonad m => Connection -> VersionRange -> m Connection
-updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange
- | msgChatVRange /= peerChatVRange = do
- withStore' $ \db -> setPeerChatVRange db connId msgChatVRange
- pure conn {peerChatVRange = msgChatVRange}
- | otherwise = pure conn
+updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do
+ let jMsgChatVRange = JVersionRange msgChatVRange
+ if jMsgChatVRange /= peerChatVRange
+ then do
+ withStore' $ \db -> setPeerChatVRange db connId msgChatVRange
+ pure conn {peerChatVRange = jMsgChatVRange}
+ else pure conn
parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p)
parseFileDescription =
diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs
index 81fc37cce0..89499e4486 100644
--- a/src/Simplex/Chat/Store/Groups.hs
+++ b/src/Simplex/Chat/Store/Groups.hs
@@ -620,7 +620,7 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
- void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
+ void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode
pure member
where
createMember_ memberId createdAt = do
diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs
index 1e9f2888af..0906159bb9 100644
--- a/src/Simplex/Chat/Store/Shared.hs
+++ b/src/Simplex/Chat/Store/Shared.hs
@@ -144,7 +144,7 @@ toConnection :: ConnectionRow -> Connection
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) =
let entityId = entityId_ connType
connectionCode = SecurityCode <$> code_ <*> verifiedAt_
- peerChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
+ peerChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias, entityId, connectionCode, authErrCounter, createdAt}
where
entityId_ :: ConnType -> Maybe Int64
@@ -178,7 +178,7 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
:. (minV, maxV, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
- pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
+ pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange = JVersionRange peerChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
where
ent ct = if connType == ct then entityId else Nothing
@@ -279,7 +279,7 @@ type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, In
toContactRequest :: ContactRequestRow -> UserContactRequest
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
let profile = Profile {displayName, fullName, image, contactLink, preferences}
- cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
+ cReqChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt}
userQuery :: Query
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 2d77cbe771..319142c08c 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -23,7 +23,7 @@
module Simplex.Chat.Types where
import Crypto.Number.Serialize (os2ip)
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (FromJSON (..), ToJSON (..), (.=))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.Types as JT
@@ -233,7 +233,7 @@ data UserContactRequest = UserContactRequest
agentInvitationId :: AgentInvId,
userContactLinkId :: Int64,
agentContactConnId :: AgentConnId, -- connection id of user contact
- cReqChatVRange :: VersionRange,
+ cReqChatVRange :: JVersionRange,
localDisplayName :: ContactName,
profileId :: Int64,
profile :: Profile,
@@ -564,7 +564,7 @@ memberInfo :: GroupMember -> MemberInfo
memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} =
MemberInfo memberId memberRole memberChatVRange (fromLocalProfile memberProfile)
where
- memberChatVRange = ChatVersionRange . peerChatVRange <$> activeConn
+ memberChatVRange = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn
data ReceivedGroupInvitation = ReceivedGroupInvitation
{ fromMember :: GroupMember,
@@ -1167,7 +1167,7 @@ type ConnReqContact = ConnectionRequestUri 'CMContact
data Connection = Connection
{ connId :: Int64,
agentConnId :: AgentConnId,
- peerChatVRange :: VersionRange,
+ peerChatVRange :: JVersionRange,
connLevel :: Int,
viaContact :: Maybe Int64, -- group member contact ID, if not direct connection
viaUserContactLink :: Maybe Int64, -- user contact link ID, if connected via "user address"
@@ -1490,3 +1490,9 @@ instance FromJSON ChatVersionRange where
instance ToJSON ChatVersionRange where
toJSON (ChatVersionRange vr) = strToJSON vr
toEncoding (ChatVersionRange vr) = strToJEncoding vr
+
+newtype JVersionRange = JVersionRange {fromJVersionRange :: VersionRange} deriving (Eq, Show)
+
+instance ToJSON JVersionRange where
+ toJSON (JVersionRange (VersionRange minV maxV)) = J.object ["minVersion" .= minV, "maxVersion" .= maxV]
+ toEncoding (JVersionRange (VersionRange minV maxV)) = J.pairs $ "minVersion" .= minV <> "maxVersion" .= maxV
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 1a740bef5f..ce3da51c84 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -985,8 +985,8 @@ viewConnectionVerified :: Maybe SecurityCode -> StyledString
viewConnectionVerified (Just _) = "connection verified" -- TODO show verification time?
viewConnectionVerified _ = "connection not verified, use " <> highlight' "/code" <> " command to see security code"
-viewPeerChatVRange :: VersionRange -> StyledString
-viewPeerChatVRange (VersionRange minVer maxVer) = "peer chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")"
+viewPeerChatVRange :: JVersionRange -> StyledString
+viewPeerChatVRange (JVersionRange (VersionRange minVer maxVer)) = "peer chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")"
viewConnectionStats :: ConnectionStats -> [StyledString]
viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
From 7c70577822831d6b995ca9ba4c66f4cdc1db0758 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Tue, 12 Sep 2023 18:29:14 +0400
Subject: [PATCH 07/17] ios, android: add new error types (#3050)
---
apps/ios/SimpleXChat/APITypes.swift | 2 ++
.../commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt | 4 ++++
2 files changed, 6 insertions(+)
diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index ad641810c2..635534fea0 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/apps/ios/SimpleXChat/APITypes.swift
@@ -1468,6 +1468,7 @@ public enum StoreError: Decodable {
case userNotFoundByContactRequestId(contactRequestId: Int64)
case contactNotFound(contactId: Int64)
case contactNotFoundByName(contactName: ContactName)
+ case contactNotFoundByMemberId(groupMemberId: Int64)
case contactNotReady(contactName: ContactName)
case duplicateContactLink
case userContactLinkNotFound
@@ -1495,6 +1496,7 @@ public enum StoreError: Decodable {
case rcvFileNotFoundXFTP(agentRcvFileId: String)
case connectionNotFound(agentConnId: String)
case connectionNotFoundById(connId: Int64)
+ case connectionNotFoundByMemberId(groupMemberId: Int64)
case pendingConnectionNotFound(connId: Int64)
case introNotFound
case uniqueID
diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
index 0a178ca2f7..3e2c79185f 100644
--- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
@@ -3911,6 +3911,7 @@ sealed class StoreError {
is UserNotFoundByContactRequestId -> "userNotFoundByContactRequestId"
is ContactNotFound -> "contactNotFound"
is ContactNotFoundByName -> "contactNotFoundByName"
+ is ContactNotFoundByMemberId -> "contactNotFoundByMemberId"
is ContactNotReady -> "contactNotReady"
is DuplicateContactLink -> "duplicateContactLink"
is UserContactLinkNotFound -> "userContactLinkNotFound"
@@ -3938,6 +3939,7 @@ sealed class StoreError {
is RcvFileNotFoundXFTP -> "rcvFileNotFoundXFTP"
is ConnectionNotFound -> "connectionNotFound"
is ConnectionNotFoundById -> "connectionNotFoundById"
+ is ConnectionNotFoundByMemberId -> "connectionNotFoundByMemberId"
is PendingConnectionNotFound -> "pendingConnectionNotFound"
is IntroNotFound -> "introNotFound"
is UniqueID -> "uniqueID"
@@ -3966,6 +3968,7 @@ sealed class StoreError {
@Serializable @SerialName("userNotFoundByContactRequestId") class UserNotFoundByContactRequestId(val contactRequestId: Long): StoreError()
@Serializable @SerialName("contactNotFound") class ContactNotFound(val contactId: Long): StoreError()
@Serializable @SerialName("contactNotFoundByName") class ContactNotFoundByName(val contactName: String): StoreError()
+ @Serializable @SerialName("contactNotFoundByMemberId") class ContactNotFoundByMemberId(val groupMemberId: Long): StoreError()
@Serializable @SerialName("contactNotReady") class ContactNotReady(val contactName: String): StoreError()
@Serializable @SerialName("duplicateContactLink") object DuplicateContactLink: StoreError()
@Serializable @SerialName("userContactLinkNotFound") object UserContactLinkNotFound: StoreError()
@@ -3993,6 +3996,7 @@ sealed class StoreError {
@Serializable @SerialName("rcvFileNotFoundXFTP") class RcvFileNotFoundXFTP(val agentRcvFileId: String): StoreError()
@Serializable @SerialName("connectionNotFound") class ConnectionNotFound(val agentConnId: String): StoreError()
@Serializable @SerialName("connectionNotFoundById") class ConnectionNotFoundById(val connId: Long): StoreError()
+ @Serializable @SerialName("connectionNotFoundByMemberId") class ConnectionNotFoundByMemberId(val groupMemberId: Long): StoreError()
@Serializable @SerialName("pendingConnectionNotFound") class PendingConnectionNotFound(val connId: Long): StoreError()
@Serializable @SerialName("introNotFound") object IntroNotFound: StoreError()
@Serializable @SerialName("uniqueID") object UniqueID: StoreError()
From c6dbbcc84e26e74069a948761ee1c7466998d09d Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 12 Sep 2023 18:01:38 +0100
Subject: [PATCH 08/17] website: add desktop app images
---
website/src/img/simplex-desktop-dark-1.png | Bin 0 -> 569319 bytes
website/src/img/simplex-desktop-dark-2.png | Bin 0 -> 563644 bytes
website/src/img/simplex-desktop-light.png | Bin 0 -> 558338 bytes
3 files changed, 0 insertions(+), 0 deletions(-)
create mode 100644 website/src/img/simplex-desktop-dark-1.png
create mode 100644 website/src/img/simplex-desktop-dark-2.png
create mode 100644 website/src/img/simplex-desktop-light.png
diff --git a/website/src/img/simplex-desktop-dark-1.png b/website/src/img/simplex-desktop-dark-1.png
new file mode 100644
index 0000000000000000000000000000000000000000..c0b441f623e9fdc811e519d2136ea5570956e7df
GIT binary patch
literal 569319
zcmaHT1z4O(%rH=Bad+3^P>MUnp}4yicVFCH7I%l@UYx~?6p9shcXx-M-u1rT-S^+O
zy!*VfGn0{ICdnijLgi${5MXg(!N9-}B*cXkz`&r0z`$PFLce~=DfmKQ_VR)>`5^rP
z46GUm_n;5;@|)ODTtONP%pM*Jv}fmu4FJUEZg*Ed7hU7
zYa=xYV`*tHnwK;*7z8*f*sGTm_{$$yuo)QSA89bKmzG{Wkg-8vZ(iQ0FJG-}@ZUAF
zA^xffMU?&OukF#BO&FOtIXM~M
zy=Q#?p8ll5IA+z$j~ng#N&qkMlP@^5r#y|M
z=PkH1(u}XR6A_wafn!$96@y0iV@_W(>c=D+cJ1C|E%WF&-%8D&KWtQHy&88^=O5YH
z4$Ie}HKW|+ZK7?MRJhg5-
zvLCl!I_RY`oIl-H-ox^FpWF&PODB8t-#&D1BR!^Nt6*ieOMb%Na%uFE8LCdX=HJ?$
zqPV~KqDiNiBPH^FmyfqM{Syiy2AuRb!JK?ZR+jF@xGXP6x
z=-HO#^Tx{p-$RpCWawTOm-IVZ@)EG#^0oeb-92TT=(AQ$+L$JQQ2
z&Pt8|ZgI`SG_HvY!Odu3_}dcK?mRW)vdglkVxV}C6b&D4R8+x@sS8&IQyitVTfR#c
z-*odLMO86Yo})M!I4bdfJ-%VkrYvDxJPbO`7u_giqC5^Aa0)_=yfl14{ph#nBg~mQ
zb4`PFHI`I~T!k@UFwy_@2q?qQX}2BZeHrH3wlk~LpV5)N!MlB69*N+)UT`4#5pC|2
zkpF)+-~?^jnt0RL$iOrp%$--ESkRa!r=TEV
zWyNS}YU+jd_xDF3AczbI2rv&%a%yciyrroXb$TST1{rLRxqq8YnhM8|3=#)2gr*y1}47x
za`^AdgoG$4?)ieus9BMdrK&=4qCtUyByZpLHd0ZiMb_4`kW*6T8TLg*Kg1|E&onRT
zCNTI#{zgzXBFbn|x5adYh?iHJjS}jSpY!1y&b8^*6$r$${4}T4KRnE)qg3j$8S}MI
zxm1OOmv<3c^?0c@(p@TPFp&TG0nH5*mPZr&<9C}rkb8{2*(=DNWQSE;8N*dIHt9%h
zjFwSg>GLXWrDER~G=_(5SbBaZNeo1~z41hicYaGV$QE
zYKV4MPv*(DGAZjRjffH~A1$_^U}Kvui0#4I@n$W#{|mF=<&5jc$M7+pFLx=C}7R9B81wuhV@x>_g
zNN6uNIZ$4B$=M)ZikzjgTEL&m_6Q+FPPI*ZziO^vtf*^Unl=mgzH0e+cNtVwbf{$e
z{rh(oQX_kN`-rW(E{&d#yujUz;Xn~(
zGUhV2td}*GGgTzDayi!19;*ce_&S~^&9hMszqdQF@10o3`qfT0@6~`{MX7^2jR2uU
zKTphE>2O`u-}n%|1q2OjiEWW9;g_14hQe)lb@E94H7d?oyUJ!q)5r&g@}ctwS^pS7JJ4sySXguZAXQPU
z6jtSvn_)3~MS?4T$xe~gMdVdXS;e(W{;321Z>BiG3PHnR&L@U}%=#v8Yh8uJezhx5
z^dfA_ri^}^DzT`DiVS`p6g+V+yl9VGaV6dL4&`>&Blr!VTh)YCd
zQ)Y3BgTY>EFI((6`j0)#;QI;@NZ8Uc0aeo#vzKO%031sj7?85zpmi^`Ce)n1XYTvP
z`L_{aLC{?7KBl@+@A0O%F_%;o7Wn03Iu_H91TSvT9F10CC&OA1gE)5Eolq*w5r}5pMi{uMP2RFVuGqd>ZAV
zXMM1Yg3H4Dnum|~*LeDqMna`d>XeIx65s0%{{vfKFFODw^UZvLh0S#Ima>>%apmrbBt;cN99``HYrqxa07)MbA8Zp2fGLs|UGCt4GN
z%=-HJqNmuc>^!l>>;+L`LY30KXX1Ufe_I#P0*{p0*Io#@hHe@^6cj){58jaDcw$2o
z`6SH7xwZ(qV-3rxE1+ifxEJ|Ewz6XVd(a%k(D4{VlZG+>R8taAIEeYK>hlXfyIGX3
zIT=xI@co8)**hNv!skqjYTbBCu*m)?F=@zb1w0O{r$IdEM6^OZo_}Y_C@3fa|I~$)
z-`Wz304Gaqs?7dg@!x4VO-Muz?zytbp-DB(S9<*aF8^Djly7}srRGh$8R!sJhW%|7
z{YyJo;XsQH0REkNe-pKTN`N8}hzpN0k>rE_s~JWJYoM5_rNTk#Fwk3n74`Sl_$}N1
zWXv7%XeVxU;i&HSQQ9%_@s1OZ)vx}*sqdXMF%=8A>+Azx(Q>;;ROY`&z4zKTAOMme
zq=yh^5x*yMrJ0E)%I}X#D~%|o6Ys!VoX_u98XqA527e>cAM@exg%u=#C{|jTkB&RQzkbtCil1gSV
zGufKJ?*;xZ68J#Mz(d5I$4CM(9#h{yC%nRp$kK5Beulf^VrHYez!-J7@T3Wf^RU
z&xk-Bm=->LhES~ko&vd?3$)tKt(uD$4nE9((kmSsQnI_E)p_DH9;kiPiZ(RN`{n}-
zO#es8u6m*Z!`s1inFw8o|6|lL!VsVJr&Zjw+v>mYc@i=4Hs1ynL44{GzI?ywq{kfq{h<&1MFJsYV#BbRcVN)vh);)cLMcg<{c=
zKhYk(74l2jUfCca&IEpDi0<2n&0FX(RgVo9mSr$7;_P4d?b#ENhl!?U$4I#XBcF$;
znj{QCPxEeKGA(j4D!8ZSQxOfh|Hs0}K0-Zl0ocvg35^viD#l=!ld@~*DRz#neURMq
zlFH)4)7K}#<~VVLywlWoDn-lZYXj&dO0>lVWl#wUl-$07Eo>kVx@1C34hVBHEy9~@3vlj?G;|l1Ge|J9D8ffde)%*+BolE
z@Z+lX>jTwybfSG_WRRS>4`-71gCiBxxEB@4*T_b{5(Grq>yC}5`GY`o>035Ju{}hC
z=_qR3(5$@$BvT2qF;}Y2bl3kn4dL@cu-VA~OcvB`I0aYgTvzQdI*k)f_PRVkTt|uz
zSA7QY@oL0rCu1i3Yin>LU7zzt{Cg_a^7`Z1q_r6DH@7>$A8qe&JWo2ezcAfjv-Tb5
zMs=nfx9z{x^6c5M=VcFp@ADbIH@KS^v74-OF&N2g-Mmt*KYL&Xu6!pcB;%&UdKIj-
zV}Xl-0psmWxwdBDG2i$X(-f2L(3}%057O>SL|^@W!1DD@{ltGd66eY|#B>Ixw4Oe2
zfxBbvs%u0uVrZE7LEmXLo(C)FHkfp3nJ9)r-83~VV%Uo_nE=@cJ*ikqZ(@!4Uu@NP
zj%1Xsq)?Pob@n}6Y;;U};lSZgkVq3X;53jM1$`1ZF&Dz)WEJbiY4})NdLDS>*;p7V<83jZO;F_f$v|8z21CbgGC|
z#aaU~2|AMP7NWL)F=B8ndK@!P&id^Wd`K^kETP
z`{%nr}yzHe<_2bC|d^Fm^hfU{I~&w~ev*u`?0lIHMR+UVERu*Dj%O?tXY{
z-`2FW){ldo1MkQ7tGx}Zu8*L1CikPmCDlRkw}ePJT?kITKFmD$(qix;9_?)*@oAkt
zMO21rP-bT0x((p&&&j~UWmzG4V`FV>hQ7ac!HZmc?VAb>bkjS3-C9D&hlypBD@U49
z0lE~mTx`NZ+YCvJUOsFYM<&K0VlUH*dY$tG9TwWLq)m;QNI#~CSjfY?^CbWw
zNy`^6gnOeZGntR3OI=E+-@)qeFyaA5vwX?w4lG69ghI*Z6=R90t-1X;;
zaTvbUF;KSq^DSf$0)b^&NnG&UjonC|MN(9+ef1#40sc=xPt^JhdzZl{2zm<_>A8i}
zFi)RzxW{~#l;JrgP}G-a26I{suy_c^_F78VdOQ4!PiOBzUPvc8O95@VMWp3~stBpo
zY`IA?9g~^qE6bmzCzaYR@4&Vf&j_*Jo(X{Ql;y@k;<<>oOAm|Yb$9Gcn2zWi`LcyO
zKao~5V%B}Sv(6a5uh}Y26`~4`kB6Mao`icmSUH~_o=kp`jlAA03)!arTWhCStv2PXTklh}f
zEQw)Wz!!Mjx1_f@675cDGTdHwID-_RqQS)m!<~SUcgLN5(RD@^1Rxs3-D7g(`O-IY
zI-X4-<5tM&$v*I>vC_Kj;QRbf3u;f?eO(T}SYihg$;vR>K)06Tu6RK3N3ZJz$L|^M
zF02M&gTT(~459zj0Qs6?n@*-(3<#;8nJRJ$qd}8rpOAHIJ{X5HC~1hKG3!
zV$kP*{%klAIE^D>D6>C}_YAsrzSvzHng*H0_1-wFzF&3|fx~0B>Xc{?Oll$YWYBy#__$eb_c;tw@{xd7!L}gm
z4SvDwC`c)Q^YPT!H$Y`x8&w8@!@isfGv}SGHDdjNI#e1ZH24zz%w<+5G@WGdq&A%n
z(D~aqsRO5;g*;1UW(`W5>XA^WH>7>|I0_vJ#&d#M88f!mkyZqiWH+~OXfO^qdrZeE
zMRwQv3ewWok_P^cJK46PA9_jw4?@Cy^{U#&_}u$<^Hc&Vp$nnY{jxt4)9w4{P2Gnu
zdV44sHT)tj@esgkdTzIK##VgQZtpaMpk3Frc`HNyI1*%6ppFW@U*FR5v5p+>dyy-5
zLB+QOaN3;M4!y$5^(Axx!B7V01x~S1FxZ~6%Hqpe5$TVyLZc($Sy+|Af|lfNPWyhw
zq|tTO6VMfY9vhpRq`II(T!|Z7i4P26unwEmJxCHM3>%V;31X1_wfJzkcr#y_e*~cd
zgOKjKt?a_tg~1cQrvw#U!i^R>V9}{nx6*W%DOzDNXc$8l?Vc<5U0GEd4+Yt;D^~W8
zj>@gBh*oU4PprMK1U;bNU30S-B@phE8`RDZzgmiN`(B~_ITP4y$%#ByKKKW-;D~`K
zIw=}C(0uD@qGcQoH!O56PbLF>DxaZq$9J7?r+wbX7qt->{#>E^*^O`NKx>hFp}7^>
z|JKWQ#uO%rk=%3LR3vmkSS^B)y}W9Ra?xa^E-iQ^P93k>P4%s$uww)al5pG&Rr)v+
zKKYMgv0RpVzoH+~)%O%TFrbQQdfBWc@WBVpcQlPOt~W^=-Ze(_@^yALZKE0EN8
zjv|{7IEg|yn7N2fTL(1D``A-hbKm5#hQ?v^y*#LIy+YmLo%cbzTzbZOi|M5w&t;Q$
zUSIb$o~~Dm7sI9C3F`{PuQLfg8N}0-+}GfG5f8OAdlS>CY|1O61gy>h)*?L$Dgi={
zjoWO+q~V>J@;48HT`_63c;9w8`_-HAtu!ffJPqIB$^UTX8_(-@zNi)XF*+2OI_pDRZA<<1esR
z>x2Pm-WnSjg(sO(RkZDqdRz|0+dF1GT?=vCe+TcaN7>dTgEGLq3+Pj}m@*u28LtMM
zzNq6j`c3PNe;&i+IKeRp9X_iiarqV%cZY};n+2p=SB^OEoj;4p34-ikXar>lc^+nT
zhrx%cS-9;GWTwSXMdwAd(n%)E>ue*uKJ4Y&OtQFEr@n&fr)KDII|4r(+Mz!uv4voz7m;C*M(N4TKEX2;CC^@h+0NznQX7_l
zzP1rQGmqKHW7@5qKPBrPnlIkHCwV3?Zves7HjUd>q;h(|iu*^{_-;qo=I2a|?M!bz
zKOw;gq1;@iR%u^lYOEoFq_L9AS4`FECj%b2_qjxYLSBoU^9sze|S?wACYP`B@IX&Dk!*&}c
zHq@LYGWNwOMBia@kW5@0G5UE5;+Tag>M(_M9O$}0oY-!-v-Wz^=6}h>(s#UU@Fut1
zLdo{+n0CMv={t=LcaOk);%c>5!T>r^6k!h~a0Nkzk@&_)NTTJ*(9F6{_=T2
zirj7EQ?1*FmAO*J&WmDQy%#5m7V)0)B#_o0_+Qu;w52i2x+sj;P|8`GSryy%f1qo+QEp|D^zH8
zkJY)1;xX}Jzw%+Mpnh+GMp#+r29lY{
z!r&`_b4v?P5Aw_Oq4_WD%+7>cX-?&GAd8=g8Y)QOGQ`S-A)aA6%Ho{vVT0)>)d{SG
zdOxDMEI4a7W#;DL>Fvz=SDD{hrn?UJ%v2jToU(BfXJ1G=3I~LYiv;dNS4Ls@s^cwD9lE`;-S&|PfwS`e+)|*Y
zIVboD{UGMufwL(QKQykJHo@S4l!`1=t<5|HJ$Eg0CK^ZqTNIT||6(&~ZU59JH@`>@
zRs|C`XZ8cQFBJowK+HyBtr|IRtMVB~GhCJKorKI{WSjQaAXSJ~w>BbFS
z$84v*tu^dbVSpOwA`Zc#IzT7U6Y
z-=xG}R$q64*(u9|`?#q&WaLB&og&VNio&GEOS~vbf>X-%3@SwYx{?U`5FeWBhHzPJb
zlrU+*yH{2ZTFLTctl4M%S>FeHdn#0+kKP{;nZ;?p?acwv*g?2zC1%aR5GPpxp
zTn}}rpx`GRq(``F@?R0O(Obn-dl^;QnPOe5avV=R!g*RDHblq8QTXNIkufyGM{3q4
z-gCf&)&uk#=BgZL-#0xo`Uxdo7ak=@d9&V={^$MW=yOd59NnzcGuch;m&W&jt3%
zld?z>_I=j;QANp&lz|GdiPPnmF^jXqYzxhIzrn5Laf%EG(}qSSQP3ho*1Hx`(|a7o
zd!AWm#5S#iaF%jJueYAJF^Ov43BUv010eXKcKmh&=WX4
z^=^^fd94qdBX^eW54xQ?t$tdAZM#tAM#ShLN?Zw9A*7R738rGwMP<~8#oYDROsU>l
zhrL;=EFISc$x9C-l=cJ>yKrGvJSw@-yc4V_S8(iooBIh+^a^DxCpL*3mtB_^(&k~?
zEa0Z8+U-&bo}-+Zlyn2ZXdTd$)8AdZs6j%{4F^Tawud(?L94KOu|d|&FCh39c7?i1
zFSt9jH_>koKF$jG%9q=^Ws1YX+L~}K%l-;VO&3&=R
zTw6p|J@~ry=ripR)mouW;*en~(Q8l9P1e()`5_Y@Fy41~BRjx{UR>^p;(%=O$!16P9^AVh#ul#4Zn~2rhz+
zE4(@kB{I72U}hBd@_O>klr-7n-KC-afL8o)z5ARHgt9BGk^|BP0)ai{?7ESccx>xm
zMko`xD@tg=<>mWjWjHO*ucmciFv1Z{Xo$<>_&>c#yZY?;LxvCnXP-U$wg_dkWa`ej
zoRrx?C^a;S*1YfVmn%gs4RWo!cFt*&vx!wKA2uN&MJyc?f}CqWGno>j!iBU#1kY6=
zy5BU#&3Qj`(OqGbq#kMwS2(AU7^|4OflT0NHMff_CLuHG!pGBesSIOb39M|s6<(S=
zK~~%jF%@bSh5oii@v~Kxu+eAhWq&2_03r7V=;_pniU_f*Uo%VODev=lV8E)T@k$A#~YT0n%vCvcHao)b1Ns15HZ1;$g
z-dB-K;C@qqu0KG^jzpO9;NKmyz3r>p24&Uix^|fihg8>x`%wSXCe-Z0-9t${oTjTW
zS#>b0sCaGoph<)iw`D|U!FkrJDO5dzn*Qgrguo9|xkasgiA*=AHRw
zQMWWM-$ycViYogB&C!wWVuf!Si?>K7G*X!_hiTE4@-wKvf~S0&1@*FcLT=B5Ro+t-
zd;2XFW`NsR<6=Ir$dl&RK14{pzy2~m)@)_*T^%H{#5W()Y=e|5o(ex)4p|-v{5)bm7#zvrE0wQ
z`9!$&5hA6=h&-45^w4lX0ekzBvfz~`N*yeuI*)*XMak+q$Z3gcTv;7lOY1SokNa^G
zdJ{YwYG_n=lGG>A0D#jnUK_mz&
zTFba`ShAVPs8Ri~1(~B3ru=$v@Yy}^K16n>9dgqA*;$CH8Y$&gor&5D7O
zFit)>Gpt{9sOMD;@73W9@$EWuwW}hy0jb~D!%o_3U&30`arE}*dM(nzht*>&a)|t|
z24=5`f)TnITM3X_PlOVB2StDJiEKy~E~`_AXQs^Q7fS{C7SI#4np9oqS|_~#a_uSuV>
zC7i()&bHobD$8nQP@K#kdrR(slz6Zz+pV>^Z@&sVbkLv&y;xI$0m9oME(YqFZ3cBV
ztY#y8%QXyN`+C;qLy59Q&I>l{(`em>!=!rpbhn55a0;(kzYgM6wBvJaZey*~(Aso^
zZo_G~YJVJRP?47?26u-6jgTVt7rTqt0Qu4ChovPwVgpwrn|IOz4xy${b&6T{?8AU{
z@7|uGep5HW5|ez`*vKIGuc2pws_ou}_`E-DA``L@rwUEY6U!%+r@?RDV(U-J+~*V<
zBp%VwmrV0{Rmop!02O5WA|80vXkH>UsHByL-a_f(3X72GEx-QSBfNgE&irD3fAS@X
z?fvH8K}>n@geZ0E#2J(^1y$U0D?UQorR_hbces^-ZNDWaEb>NziwH?$pmimxe19`g
z3;e2pg2YUf50@Pw@trlhpP}Jcp$p|f%&~HC7J6+A&9s+2Fj;dAI8l3couN$N?rDjI
zjr`)g^)_7j?gJx?X0s4iKahc`4vIm
z8+=0d6*fz)yNm@EOF@GOG~XO)yAd?tdf{=w0N&UWz-fVl+yq@x&@64k!!A!kj_)W;
z!iSzrNJpbN#vCC!EddukIrxDdl4Zm|RI~scC#)lx+q%P@$V2A{WYc;IF-)YaF{Mqr
zZ6t~9qu`(+c{7W$LoImr#FBqJM;8UBvmr6|EitsZKkf%L@U@OGGIpAL}kBh`?}TkZD9#p0wfmaA+il|i;T
z6`2kl>&ZVnA6CttiTGk-=!)gB3#-c2Pcu%wpSLjzcI=|h;(n0Y@wCnhf{BHY@SpQV
zZDN#_9r=nbp?onl|LoGG&CK|R#rBB-Vvl488m9QfRVr(eC8^!)?xA4BZjV*s9EB>z
z&jG_d@-~&AHd=AbuaBDZkX)-PAp_U}g80Oh7wO@RdpBCE-WZ@t9RzRFc1jb0%Q=DlFr3knqi71{
zdW6{4_49a{R&TRRk(J^extZnlaJFJB>Wj0u!^r71F{l9do#$!B6Weu(a}*z#Dywif
zII`5W^5GHX#dcFRz0r4dT$s}*^!)WqwNG{Du_!ZQys~jMWbute&pIaANKXLPN8aTq
z02p4nE#w89Q2k-hf12~71+*!UaWN@kWK#O)YEVe*k6G{Yl4AC;Le>@>
z14M;$l?#Wd24s3{T7EEH11C+<@d9@m0gxXnZptoLzCSxag?;57C&``5L@2EyV?~&X
z7UvLppitcqtu@7Y<4rA~NIrtSmse%%{ytSSC}cY?KNR)2FUvbQ1gCVvwGUT=On4iJ
zYrgQY-fXc;oV!k!2iD|!x_^?cYm4Y3frs39LF7pay4b_cdgbZSeHJ0;K4iaP$sWNv
zwkR{#0E^9X&JPMMQE$3}mt!*?ac4H~OZ9OXiOI@c+LQcl_%qV7J5;#_Tlb+0UqC|X
z6oLIx@v>(a-M3k2DBec
zP)Ot8s|(cxN%L#8>=?Gh#d}^oH%gwdNV;;mproI@R#>xIJ)4t@P9n=R`4D1?4@@W6
zRcrG=*?Kx7+p3&_X&}!;taXp3_1oy7_ghU$pqLjHkL^xsNj|COYA;+LyLx)lBlJsrXM>E8L_bj5Iz>uRNUF8HTjFP=>bflf?I+Wkw77bBJ18R!9(6A}H8DphX?$8+qz
znp@DT=8UOv$5S|8;NWGF>#F=BZ-69hYM@Bo+owM?wJ1IpLxTt%m|XW6Ib*7<4~OX#
zx(35wamq=JQBWhz*iNn0IAJ5y5ig;};r-P|oy@7mgWj|%mr22gYFp|qg4JHdA)@dG
z(kc_?nVyeE-Dh<(RlIMOItqI2CR;1gtQ%1qmOK*d)HGgrG@JM_S!Lq^#KqC%koamI
zV@s*|3tP@5fi{PXHuF+I?pt0CZEVDLP)yk7;=>?xIh5&w!dlb=0oajLfMRuc6)o@$
zi}v(7-iPX1u9pN`M?za;WAd@#<3yE@$2jnu+XnIC7^gLuI5>#GLg?Cm2(0vc$O~5~
zf(SQpou}2!;80Sg=mKQGNCVd#s)G#3-Nt0M|{t{dq9rp(5xuw_a%anloSLg6o
zX#`Kv6H&dI{q+h7!`5)o75Ha8M=W1^jtW_l*dw0KC`^4-2b4a(6);q=`PQ+546wok
zUF;CtSPgIl%*EQ?4;kt^-QY}C;c@dq(<}fJj||Ym8r4m&4G18rT8*h`o*9yPM!+Gk
zv>bWcQf@q(w3sOV0-kPU#ms}XvX!ui)1A1sH$#R`O*0%1|
zyw@ykDC#pOn!}2Oj1m@TpST#5UT#dWDT{K1{}p+i?g3eUq^ow6%Y5c?-&HhZYo1~8
z)LT=}Zs9pQsiDq5W4{U%*xUbnB#MtDk2-;IF917~BlWs=X9
zLO)~ACMmMV%oRu4(Z7W!Vt3^cX0^B@k&=6=cvh{e9nM+o&KUW)EVsp*J8%uD1h^l}
zLOXE1n_uf~k0mF{14Yu=x}zK>`D>@OeXZSfU~*gmv#X$ssWPLq%yn|xcx^bnBt>2y
z5;(M(AVdc^%zy#x>>}mQWq=S8Krz~naMidu$z!DOA__w?rKZo74Nu5RWA
z>8J!<(XweDzp+is>56r5_I)L~WFjz7y??F=ZgASNH&wc2tUv^Q%389MddwN#0xLY?
zLhAv<26s9pb0a~Lfc1P$Q^v%Ue7^3;g5DQAIiHx@uSss8hdOn<;IG^grhkfdib#0D
zzpaHrm$q`x__lk*)l@!%O#6pwR=bt(xt7x*c9~{-vDW!J*BsvcLYpdY?`9IoyR+talJzhFXa|K3PkTqsIb^2bw3-7Y`=q!2P6g7%RVKY|wLbyO6wNu~UU$LZtG
zqtQ@>nS5Q_#kZ4KHhG~Jc6+20EVOZhtp2ff=YaL>$$L&V^1afK~;KPkd4nD
z@l3vk;sOMMEFi92D~olyR7qOH$Jb=R-c=i?&$U)&ca4S|0p>2{nW=Yl#RXCH-eNO#
zZda8$eA^Sa?TPo=OQgezVH0q;+u6?qFt%7G65@3?d|?fSIv+4C-}7Hi==6%XQY_?-
z(sq4vCOqSTitQfreLM^LQbmP@Nv*_uwR`&Fhg&(t%$>-@pw(tSLGY_hm@>ffpdjnK{SN*@gT%U9l*eL
zSJ^$ydnbpfdN=sMzA!2~cO%G)aKXU7W-W>Gno|d&KaVlh6ne0cMkBd?8$aXLdcBBN
z2XxjEQ3&f&FRPIWo#2bjIA@w@5fFY_KfX+fVA-CzFm~HVg!2|2)lSA$t2Pf_Oyz{6xB&v`
zqzGRcdv-r4@Q8|tk{a1)L1b5iJ
zr(fcQQB01CkmhPrQTtA`-5JCFxH7>WOeK3vgIUHK+(N=YH6*`qee&yxO=Fq|xIPC3
zNUDC)5RgBVh2i8c*R>G>JRF2e1aZtvhp=cIaVrTG)!j&qzm4>mr_pFUjCvCp3pT>{
zX#4qgj8%1WzmhLJ=xojY+mD2q8mAT#jXgHcl;Ulvm&iuUp;TPK{LIQ{GtZR^2l1Qw
z#qGdi($6n}P&5NqJ4-l*M2(7>6y?cR8>-EVV1ch?Ce#R5*4GRoLd@XZ+Jj~Yj4nI-bnou}wehp>v9kJl{%}UA_h5V9B
zMB%wF(NXVUDi}WKgre!VL*jD4tzg>p&FXptM_ApDo~MS7mPzm^NY<0QXMj~Xb;Rd*
z(1=%KNy=NGito1&j1gM*d(a!AjeS&+KtJpWo}Kj8G>eLHK;@W%RPsq@yMuLXGl6G_
zU-+z9@Zhu9{t#BHY!RKMwWo}ajptt^Ll6NwtDz<8z{3EzIW^>Ex$=fUE0PBGp<$yj
z{^5|5(SX2JDPM|Q1&2{Kc&9(xt!%D3F8ZZlM6`$%CytzTL}=s@%e}$cZ()y&jse^*
zGT$_UgVa*J0TDA8PlSSyZiarc1TK7(c`T?184t5UC&)T*$hXU}Ea44EtJqjO{zyPc
z3V-ToA&TJJ?Pno06KEj0yGFBVOe6MGS${-WXln4OZP)s0#q#b2+L&!9y19Bd@adQ~
zFBH>ej5Js%zkl_s1pkV3F~_2MSVxiSs^SR9L!3P|x9GVeCJ3yMd(z?^3Ex$;^Hz`?
ziq#hfdxRL94xB>VG+p;cPY3pbk>p4n-j)mQMWof3;N#Bn27aGeho^UEhM7)VI5+ZL?R7K_
zw>z93J9-a177W9D4nC{YC03I`NO%U{v)uL58HauhvFn6_Nwf(6yrAXVEKckqt57bQ
zH`!xR7Re+r+_#67&Lj(B?Fn)z5Hm1zgKPt=Q@fTXAhZmU>Q1fhOnl~->=F|BSgYS*
zls8J7gR-@7M&9PO`HIC18{q~jM{Go24a7qbi(bRRm=9W|NgQ~O!d9$yu+3;gLx7z`
zDr=s|AtE$97)
z59i1zjQD>jGQR@|=yr3>0WAzokYk`MVB%^}wTuZ-(WXC)j=#NQW|ML$z})ENLLm{k*4_PmPQDZu
z>ADZB7l=Y|_llrptk_V~6#8OSs+FfM+OSk*C>x{G2^Q5?uBXTN4G&%WgL#eJPF2ol
zKZAyfLcJ_d@^taXq^QsLK?rPH#+vk)#aGz@4$E&7K&)EF1k^OQdltvI^S6IqiO9}G
z;W(MvEmCfswdk%k|Hzlws84an64kko!Jy^5hLjIgfQdebyonHjTbD{Bm)
zQSIix;WZKZm&@UWJN3o+Y`NgGZ$rRaJG^OTB~%`UQxNH^yEoR~+uP0-++5agvL7MB
zOCgR?u$BNSk{jgABNK^zb$4(vz(?0ZK7_yi7l3~DNfmPUy!>@!n;r)#8QCXY_q@n@*WX(B-F)
znC*;6yw9->GPprr$FF4ddcZ$Snf4RC;PK_T^cN`Z&Wi_5+3e=k*5(R$usOW3ZaZ*%
zxZ8ldokB_+uyD6~Qh&6)o@CcwP(98Trx}&LKV=7<^`nVf68NzVW%Lhz>&QNexiPn{
z_mFSt`KVB0Y1=H$+jqjM1g)>#gu2_rAH&+X6?)Uths^??9-mVCVfi^<{m4ebkVFA!xo5%muTc#
zeK{Q|4qr>kA{-V2c&HKy`*9N*th1ULDaxJ34FBYd;SQ&AnL5eMD1YWCCLBPZup`Wi
zQ0V#G6jONegVwsoX<93+&9fQLV19p{pXKbGv9YoK*u$jwivBLsq}+$36tvSX}xBJXf_~a_#w~3
z>B=O_8{^saR{9&N6?)!o3%1)$FgzJZJ0_{thQ_}VEIv_z3uW{&qya3I20_r?8R)jb<@ow4IDRGZLXGW~&s3YxRLFSyUL;^)gHnWX{H%)O3m6nC
zPeQ9%p`DhTI6j2G;rDU;$p?38*gV2WU9T&)?^VWMx(oA5oEr0!G(ev|R~LKUv-Ljc
z%7Q|&$ft8*fr~8}2KY9Fc@D?Eqs*5OJQ~cr__}~2`3)>|z3+=aVonN-7l$kfVNlMC
z;o1Eq05@&5)wQ!oU#-rVcggd4+&shi#|9BX<-prWG|$N|Lx@*LAKALf>HrZc8&eXc
z-plUSLpwj3{Aa&Y)#lM+WqMbH#EQ&NiI6z`*p%N!V4X8#A{=LE{e-ULdP@yM;-cS-
zp5F9w(?G5L!+7a0%}2MT-`9cP~zHcb6c+-Sg!<
z&yk+1Dxoz*g_F8++mEpd{`p&OqL9s#H`yiG&TXY&jh9C#kO|g)E?}Y}Q
zR}H_=c%Q|q?kkhOa^b&^`5*OLQ4dTK^J*wS*M*XMC|VtS^YihWe)WkfIu$j}5W_es
zVFRtn!o*7ozcb4U1;36&(bcC+U@=X=)`(zl`V>jA$_6zP6&xQ4>>I*fLNPOd{>3Ay
zw_gK5*J#4mJB0(RTc*=KhBn{g3bw|InlxtJUVob4T_xRW=GnOFm_V2`^cGqy(h+(P
zO$66$YuCE8E5m?}c?^4*ibKnrk*q8`$1-A^3Au9%)j~ReS8jLi-LAZ+PgXiW%4ZqWzFhj}TIv6_LW(^=QE3t7dj%a{Se>?yFMlAzCyQb1G)Wh5QW)mthZ&
zk+}TWv@ZhC`tXbvxe#NnzH(i)f6LMiq~ZoFz8`(Ga2K#_jS+q!Xmz2*Ukl|~2PSUf
z9|()te4=FSAo0X&z3mu?OG}P{J?(sp+2O8uA&hdaK8S*X!XExh&tdY@j2du874#Wm
zLh9Df>#=C{<8k?o1<=Vz86Ap>E*C`;V_-y*7DC=&+YB$2sDq%8dr6BhO%0Lx+2qf$LL#
z-oNFce!0{WMMnPTN=|jpXTX2vor}<47klfgr6V?$zH+G~lqYt4?yo3=cgLceVkZ{GDqz!D_NZ_%D{=9R5~qRcA43~3rDeBZ3$BQ
zsL0X1z-aj|Ox8I~R8J2{gEebBlek1*({v
z__ssj9PFE?tXwNY@qLQ=<TMH!&d
z12~vy`Fb#>A5!Jt>FfWNul{SF4~CJ+EnkJIUCBjA{_wE=HZ%YERC?_fBO56!y^3Gr9#}??=?!x%|b5e{%V~c
zW-wID$GKuN4(}+`hW3A2?6)mV#^3T<<1LHF)SBtha9
z?7y1xw~bErEzOgFWqoIE@qd5(&l#mh=;WFcR=xT3U#i*vTmZcp8BE)i=g!{$^v$1#
z8(L^pN}hr^T8p&*j%Nwrvr#9@r
zT5JKQMNGl_9;S<-`)^TybhvLvS!^;6&begW!f_SFul+H~H+h9*s3e+`%Fc#eT{z(}
z*s+^t|7VDxEOG-FCT;=ikJ(tnG4rgxd(?jMp}rj}6Q3nNxf*b{oqS(vbHBHe`m=V(
zzx$zx1E%c7uL?GZEw5$lNs1Q@gO?8uk0OtffZ9#_3=1?rCt1582Z%Ej`L8kgdlK5!
z!C3o|SHY?R1$CkYp<4Q%!7x;ux{&t=>p42?s6wPxVN|Wf>A#BN#L;mG{I4SAJRv=i
zLxl6)YoO7zFIVsOwwCFqtG-Ro>Fmep&v5%qOnlMvxTe;scNa1nzt3%G6{&dEF2_lq
z%BH@!K&<{Y%woc%&tLDKwLKxy-0b#FtJUa{d>a`aMWS_19%ZotaE&*;WkUE2G
zj-me{YB?@3!~9=l+`k6^8oNz|cjvp-GHFobl
zueYI!h;%y0ui7+{hd;jzh{{r_JUjDH!5uZrinBkCVsbW}V~a&Q8qR=WPwAgO%4|VdsP6tiNau9J_l@
z*}%!`r89W+x
zYbaj)u9Zr${c0+RN5Xjj
zgS#_dmgf~e0gnP_zvsMA%vR$%q)cxNg$8v@B>V|Xl9t6KlOPtw3k~4Ii9Tx6Jb7+c*`y*}I_kc1|?pBF-C9FG-AC#Nydhzd033tc8lJxvh
zAtqLImFj2T*GQrmXGb6rl=brKvz#b|yIHSKT0O8|Xa3Huounz;Q8^_mxb28)$Mh54
z=F8}y+;V8-%=N!8B0%ZDezo)J%yxBNp64vt^_R4}YmbiX&a;)=-9YKedEFB{Y`~h^
zCAFc4WA;Z=3BJwA74PF&+_Z?<)Xv8_pCR~|#l`NX$e#}PU-t+};-n9+=&5fQ~_ypAE^8c@d!XE>>{e_OF5u&&O@QL{ax)YqfxY@fm9
zzCyb1IE1tX@d3YxwO}pUCmiqjcOmB4?7V8EkwAum_=<*Kt5MJ0g9E)!lmZt%}?0i^^cM%6^jm!*NF(e1izwD56kVR=guC415v?tr&~ik6D?-k$tCy
z$-!l3NC7DlJWT!G0
zX-cC4P}qHi1q*i~QR7cyQK9&2;AXHadD`9vU5HwY4iu_a-iqh&fytxAf>FQ7&a=
z%Z);rZX(8G;B~?^vY}26P0^mCv(#u$K;Y_|ACktSWj*=4D
zOs>P@&6KA@%W*1#M1S@kQa58|qI>+e){@j4+a;)o_BUMe+}Y_O2Q9@1x?c;}&Sxe(ThcJS89V$dA(b?vQ%KmBwrBCNCVwhYGL3L38D)
zgyIWy_vBny2J-k>JX_Xv7IQF*&COag2FaJWO!Txcgvh8*7Svuyr2Ke&EV!UCeWep3
z^DMq!t}pKplanrWm_1&g&Z+TO<>ioz6;qaoWs$9}iw25Rx(}Bc(%kq+!e>%^a?sMo
zcUdXpr!><0r9*%B36yyIZ$&RxS!O1RQymVE!xa*el0#fb=y5y*J|ns?*J{j+Ny)py
zCQzOPv(dRF0|ILN_z#_$zya{7DDkWUf8ysABq
MoAOAfaWu6R#_g*EAGC1XFLFK#+ctL?|K4q2GEidd
z1yH=HUVLn_!;wjy<+sI7aaF+F>WsT(OzB0E*#G|J--a6crKlFB428C?o9QpO;*h~_
zieW(ksP`47$r9tpNuWU-z4rgWS)0Eh6G04pjc?>rd>=Qvll^J+eio+!%Wd)A7NEl@t{R2!dLxP
z7j_L3;~X?XOy(S=lIF)yN9=gHn6C76J;O{XY)l%Pf<$sfzchbES6>2cEf+@KA?zOg%%W+|2IK!6B)>Cu5t?hSvr~$!zr5oRtpb(b7
zCwfT#%5xRDL+bM5%|W!Lp|^~%xlhFME!EG^l3bS?NNWfV={k`360&YaX)r=Zay8+Y<<1xbM+$(fem_EiT4flt6B4F|{a
z9kGSCjAI%I?73C#^B@6^5xysYy`9aMm8Q)1b@R>upC4{En=Z;28n)O9;Ya48ZF=Bb{S;IVK7qg&niw3iZwNN{$4U1Gg(8cNYB$
zR1o@ko@h6heCwJ2=G{~LIUenb8bfxWCU0zHcB^
zP`f-XGtH(rWxGUE1#-@#@<6sqe|L;Br}A*Mkvog$>=3BM2u!a%Zg3Q7m6DGXoM~}8
zX$T3gyKld%<>Pm;h_J5|R#gCUx>|N(c6zU$$uN0%Uq5lkOB$#GX8`UmJ&QKyM4aVe
za2+Dv5PG!@HDztdZxwu^@@8#rw8LH$=(a_iZ+F~Z}Go@3f?J%>x@ZO+23JEEMeKem$y)B%FI
zz%Li>f-7iTPP&&u-q*)WCJ$$qq*0cOLM;tksilJ!wZsp!dXV-enUxUm_vJr>%R{`^
z5j!Q774zGuS)I|do$~xgi4qYUT@CruXPt$oJU50ueRNM3#~vv+yFkOoL`T{$=i`QV
zbBwy7F;U%f)FNUr*%^2+1fNHJgE)kHY8DM=hY@wo!8|EIxJfV;2V9Ad$E|T
z?$4%H0m<;z*4B_OlaR+zwzT$bmS(+#Gm@;~ld-XpG4E4{P48RNUH5uUwc5Gh%d>^Y
zqv@_8S&YP5@N9X7BH^-){u=kqW=06Y;2FxaMyVNgduhX}cGFUo%bILV6c|+fVejti
z`LJTHTH;qZ3^cS)+b?(0qkH?(v$!N-yr*&<(wBn27d%QK9;@XNY|_|qw~(@=IGcT2VdXB*bz)#1pR2|0ryso2nPlC5Y|suSnM
zt((0e*W_
zv$FP2n|!>02hYQWd!f?9tqg&NhSc@Mw?Kb|O!knD`x~B{1y8=K$6Un@we;&1G%wl2
za#`$Bt;}3!Fb`NYP{|qa&M@$L8`v-R2!WsW+U{;}aUNcp|ItQLU7-2tax$1e(G}VakXREJOqbfx
zC*$!m?YBY5$>8vs@lV7TdFE6ZwF>%ylxjzF^)Es9mpaj8w+iJ
zfU#NYkWH@8D_ngnr>rzc6p-yhQPt*s#v54!3$#6^@EpLl*jopvH>Rqu<(-Ql6(*!V
zSRNM;JEhh8)lf%F^h@4czboykT=Zi+)sCd2>+i0}67djKe6}gpi>kg}xf8inCy5R7
zoKhA$#j37}EQUOl1Tu%Jn6-}DzB=O$%r-t>^9oVZvb0B`pL;{yz~^X|TPfuu(YHo7
zvKG~euR6ny?Y!9F)o7W;4yZuy4-cP(TWtp(gtO7)2*4>y(UmvE9r?k3q-P39CPDHq
z>gcR`*j`yCIzd#PNJ8&z%pacX;C$-+%`wwHzmdE&ij0OyPIX9>c19IMYgS)^9ceRY
z1oxPJiinCQwn8{l*|i-`IR18NolZq*w{k{3buw5lLFdbJhNO1j+a49WkK}rgjV=?l
zk{QAhJ8Q@&s7C5$B|Pf-42e6?+Bz+Sn|C=RFfCy{!Rz->$MBBxu|rQ(Upn~Vqg
zxY;%qxP}Kef#J;;pnTT`TR2fHHSdb{vY)v0K?o^CDTMUN7Axw`DRha)WBafJebwb~
zDJ$0ISDYVu8`0?dQ(*um&1fFf-zyTw%JutXQ1nH(2aMHBZ!coMNXCLQlAIAuBr-rg
zJsz3gQcJd0Dy!=LBIxU+epGQxI91G%{B3zmyoB`O=fceDrRMDUeZ;&vp3Bk<{as9M
zA7h>A`BOiiiNhlLe3&+tLd`3dQVuR0&-crX0lXpFm^=Gb?ee(*?thJn!~at*C=Jt{DN0cgkj?
z2G+M-KH*nt{Vq>Uw#ej|QR~kiqLb{EID^x*T
zG@4PcUX69V@MyDuxoRzr{;bKCNUhrA%t3ZGf^8CWu~?_0>9}R&kHIY+tzZgHbLdc!6W1!tcEOyv$?ql)I61l;{py}wz7ky^_v1^GE>FQh08sgcAyGnUlhzroiXFS}};_AdgC55LYV%|Wd00}5~v
zHnIJ8GT+iV#Xqc;t7PM;vlvD??2X9jFLSB+46@x5e7g+xn~>xhSp4JMTFu=9Z|L-@IIP+fs5bvcE1LSE#(q(V9G&>b70JbfvStGwvT|}4i|bWEq$BS0eD@;`1zb4UGvlS
zNf)zwvv;2EkITd-BHc947&6a50!Qp!84{Fu_+>9dNZ7{{5?0Nfo^?0;>H3E{>VOvo
z%)0f%HP>OTt9q@O^`ra5@v1
z!B^X!rb3L|31qRVc&gzMv0#scl}e6yQBgl!?N^!-!u{%%JhqD;AvS9^fiSqtD!xkl
zZ{JtHUo#lI428XTEZ5^+9hAJo*;6IDoCdlNP%#)2wNai|an&ZT$K}$Nm9Q<}%nqEf
zqzOBhm86s{d*fY(sMi~<+Oz^@s-h>ck~Fg>5Bg97OO{xRAw$mCGavGg$-S%}vIYYl}i`
zuSSw+`%MYdlKN|ZKn
z0kxpY+?(=4x^wh_yI_a&aONjck%$n^%tjxxik~;kV5Nxu*@+;V)n>(MP=)g2h4?>>
z`d;%(}%_nu5Czv8X^ylZU&Ag>_Y|@Y`a9QvZr#FE*i{|&>j^!YC*Kd*{FKqIP
zeSMP6Dm>#NRj#lt<3Y5IRZ4Dts@nBdlfJ@)OS*0!E7tC^FcJ~=#^tTFsTkF&eF=h~clZ{G{u8qIo%AY+$hJQC^ab9?FXfVw?x4dufaj45KS+
zTdZeqhfA*>Vke@7ZvzBS@xYv?3l~4wT{t&&;CKw0y%|Le-xYr>m*I5nMxDt4lW}3)
z9snMYLZzM`#4Lp6I2yc!)I4jObS`lr;DIdd6Z*JHu^+~2l~R)3;G@Utc>S%)%1Xoa
zCX`;|HXIx#-OAn*c4~y_?%yIRiT(QUm27R9XAeK>?WhF+TEd-`OJAO~%XIpt)GD0V
zqUA34=Ka8vxd;f5Psu|UkFMY~%2m@w`7F7kW69AH+}t|)_^Bp7NJ;w3X=7hHG`f2wqU`Ucqan8vS@{kb%)tCwAviP<)m(#%Q{hGZkv%n+`2zYzI<{e;40$qmxLEucrk6&H1`WNRBM<@x(jKD$bL$sB
z32tl6$JObW`Y950D+%A2QF-IDmHlvqv8N%~uq{^fEnkujX
z#{y;T@S{)w;TTM6G(z`~%V?fUI)y3vB!x0QxUjBT4spD=`_1v-FoIQB=-KbHPa~(>
zpV>r`5DSS9I&XN-DjoPud_e+5!^b-m{x9eJp9Zi^3`UF2uJ7#Lbot^pE3z|H*$;vD
zwR^dM7RpPvcGNC(6x`Mu;_O`7F^0Gzui;>gt=yAV$QgXedO@Xd9x~#Kiixb6?P!(>
zvjX8+Uck?Hr;Q?oBRmg>8JLCRjOV3r^Map#OE;Y{&*^E$D(*SsC}oOh1lVp^C5m!N@O~b~NDP)4qFa~_l@ycS%I)Ys
zg^c9Ktv_d@blzK&IonL9=)6uj-yNUW`(i%AzOqAR{D~>vM>|ZG3wqp^uhBdf8gcY
zwE#4dIM^wo=ytaQDjb&x)n*mRZv$&Rn_sd@)K_H=3j8bsWkZ9Y>5UmKl%$#H!j
zStUfgX#y7mI7}!=T#o*ZLwXE#9XaylKLWr>1%*#;A71<5%w$F2S}#=gN~~5I?dCi!
zRprsk{$OGg0$!=PacZ*0XE~UEmX(DF<+X5|l4E$`0t7{)L357$_0Gpaj8r;UJiF(3
z13}Wr*jscGDp^>I#xrkK4A)%{6+eZBJiOxu4B0xpJW;FD<&o_*P8*HjHJTmMVDnp5
z%&pYkDkaKJ2%e4sh7%h}m(ctLj(S)}3Xe~=V-_#+r;%d#o&51sb9Jb%Cju&}2gta7A01$yZMnZPd(L=AKxm4r@g
z|Mt}eeDWP)^?vfLgFU;R{_;aX?~Ml?&pCAUXH(7UOFHGkMCyJsg*3ahR4Yz|g}zY?CDB%#vQscJ6i*%|;Nyaf-=GrQu`?
zvTi~$ZM2uy^FD=7YnWb+4p5@Cxd|is7@r|9R|!?nic!HPgmji?
zzSxm68C;O-+5una4Jog&Z3!MAAcT^{=!cLId)bSF!k@NuW0p2nIAixR>0Y6mfu!Vd
z^Ah%@lQ5~?QbpJ6Mf-|kfKq}LPWs*DuA1@2*R=f-dra}%ShAEZ@pCF48aCYGNfV{P
zp3J+@Ytavf!<$PPi_2%H-w+dc$d@3QEw2bmlp2~Io;dHOl{Vq-??BAEMdUXY0a|dC
zlA1^Sg}}p=Q_T7shFw|ZYKr?J>o5w-5;;~PpYGJ#`A##uLiB#bb7fqqZ%U;#{I2`^
z^t+2i0tPJ(;_yaItUJ?!gL|^rjCo?kgmV>T!m9q*DI0v+ZI+n%o9U+>&6&OprBC?C
zZrvrSQ1^#{l(>f@s=JdR}QGiOPUfHc4f&?FvuJSA}H%jjkr6`Oh**y=iOT
zG~yaa`K6ap(({*5pAyc1Cx^tdkdfWx1nPE4Sv$@~Hv6k%iI`SWvGVPjfm~)qYSD{S
zukYsdLfG2_Xm|Y(zC`!i!@LUQ>PaG<5?q*%4$r~moS;Yamd`<0xuId@*+BXGi+pv*
zK7^!n#|AI!n7G>s4W;hJcP(GSPYh#&h&;ATGWcha&H*tQTnFcD?UE$op^9Ph>Oq^=
zW-RHB_d{GL)njEz?@vF~hU6W)uX{l#p=5c6kDme;wB~k>!#dEwBP4EUwbqp}XAfs>
zNAHn|KSJd0KI^}o_X`aUStL92zJ2DMy;}2)ann~#m^LPqBJ$onek}kIG{kW9E$N`B9IIwfs4vY{0lKc|$;Ru>%o(uZm
z2tdRs|LJ#nI}>90cq=jdP(~mRTXa(Hw%I)JoU_Dp5z+0mnWe+U1fdswTn3~Kz@JY#
z5!NvNSJbr*SA{kR`5kknPi_v(WREf+fZeo(^ed5{<)f_l?$g7?8fmklR0e-c;jihV
zc%t^%6l5z>l?xjJoXf;yZ_WdRK(U*!}wPGB6()t9$(EO{KUw5}1tx`br~r
zlAZBDXSdek)q{(@-`PuhOgiPg11`*ms^tv33G>@Ur2VBzPH@c+ju;Q$z=PE>`&K3
zXYVuE&5IEprT2MAfGjO-JbG?thu+Z*vy8gwp=PW)*!kVtakcX^)T7fK{L1=#18i8`O-JoCY*nM^hPjx7z&NTyy5V^dGv&C}3&c
zQ(~0h_ss&ln+_ZZ&Aoj@F`KJsb3~Yu7TuR$y7>nnT#2R3G1(rsByDxpff{3Josmlo
zr{!bWc3}cZYCs+vX1{jw<56QBK7-HEaFX4rfQ
z0JYogvZcD<`N@;>+gjg#scVDvYPRdF3yVnB=3=(^K+&+kTR4)ahF}Qq(NcX@YWwW$
zAYs@_JhP6orknUExO-tZJs@8<=HsCVv3o_uDlD3VacZfKi9u-LsE$iMqb9Sh2Aax1
zbebtv%STe6nm6YYqfp{(Tg&8#O5=}4(4HMxAs)!%L6U)2C)xp1h78DaP06nTd$Jd%13_(Q`XpT-dR<4!?)w
zqg%AZbZlCUs?M(={+r06=a<#9*%iEGd)Q~
zY6+&wwclAP6^FV%Ke?Wj%{C7bHQi-m*Js9zX94KTiu>r6$Gwj8Bvr-Sw
zgq?9l;8aoxZuo^N83aCM?isqP33BW9G02aExZF0{EK5?$%r|(9DO0{oK#R({RZy@x
zz=`#KTpKzo`?!s=>0Hfk*sg(CYO)+qH5aX9B1p8z^bTD(9Q1fSTliE=Wi
zBvGWkoO#G8Rwu;EDz257G3s{z%lyTEH@cv~GUU}_jXdgXuwXhJN$NVBiNiOawBD8|T5&gw#7R%5
z%c{!TJZ$dst<*oh+Pr=>$)-7Wjmw$)!mht`ql+$(LP8>-Y;%V_VU)Si`Z$%+<@@
zZo9kIW0l$O;D_*`)jX|+e&jUocC{QLZNdxVhD$}0Qoes^>@+ViLq&D9oGePh*mddr
zlywAId}g_VI7E{C_(47>q399E#0?52-$L7HVQrk@kpo0aXP*55jW*?=fM
z(jn|bLK85DDnT{M?cqV+u=kt-^*h{R7;wh>+#W9p0m{^Z#xFXyIvzqfqnXd#R+!|1
zt=zY#Q+aI+dM1^I63b_qyZ-NVh1**{Ou4`@NQ+!Mp1{`-6DCL7qrziQk-Nsg*c)r3
zy>{;U!COs6i{qC=`&oP6U%$n3HVoaq7V+ha6zAT0pDYfpxrZyK@!gk_-pvk>oy!hE
z-L+gD&s+oYn^c@h>+wYa6j`MDV^ng52>XV;kpcAP4!88$N3_q%iTZ>NX)K29iJb>m
z+=0?nkN1t8&dGL-4OZSKr;w?3ehkN+3_bq8^Em&)O8ww4;83n;U1hMklq+1N6&|-C
z%ql^0o5aDE9St`(y4ULQEG@>ukjGv=nHe$OQp$7mXULD{l$Ls1sX|xg+#tp|)i0v4
zL(Xu81i-zZuhVSn}X99(J&Y=wv#@yNiiT
zXAX56S)f&S54xn6@co76Hv6!KZNZDsa`AStBa^bjf|zF@S=i+gnu=blrCa?8Pg6HH
z!nl*A3H-o%lXLP34hZL6&<1jZUOHow!%Z-AYY_%6p;$IPv~I_3rKG1`*KECVAYAs9
zEmui#CMmE;DpB$sWaP(`a(T(F1+u1k2%c_wMvjsj5qcg!5flW(JQT)x;s{PEU$jod
zRMDi8RzHf7f?%AK3*DmTX_wv>y~xp7Xu;x%UdGJmrdL4ed>bX$_?PP&ObNF6N(E7_>K)6nBZ!0PY#A7<8~TNpIH}{6OI7mlN!SaNXdt?Fj6lLr5qQ3s*%OsMC>
z6CWafCq{Q*4?C})MVCE1t`-}in6a`tp)Op|TX*N5NP0k6im6A^5buUVAyX`JPkws}
z+Y;UOH$vty-OUm6Ma4ww55fCk>3(M^66(jUOFV@pg}m)J()#a0vYi*Ui{>LeCN)YW
zSt~rfQrW+LDs({S1|cl**sSK85yKV)*_H
zK3)ANp?KMRTm?RVgCCzRV)My~P}OMt%F6G4QHB8~bLjXjM%6oYINCz!f0BnEkuuIg
z?Mu-}W58$#5mX)}y~;VP$(;|#bwQeY(%ZCsd*TLy=jncbaTjKL74t6)?oNB4w
zYq3rI3@|!?gz1w9t=z9pE1dQ28c7E_Hco&HsZ1Ovn}-nyG<5zE3wnLU-l0d5ZdZ=F
zn9WLP`hc--C+WR?-~OGc@b6lsH>?r22A(af&B+VozP3f6(HC9y0;!j-Su5_zbT?V`
z&Ey5`$x_!@lw%#Gv~NLwd8U#a@M1^#TVw?`84SJ|%MH5ze0STugSlp(78xGD6{C4fE`}tcQrICt4cpXXJ2s7-7I%1t
zkLLK=uaK4~QVD%oTekZkYbaskN|(0D!478b=;&!bgn||A@yIPx%9O-$eWqB&E_y^Q
zI3(*n{rIJx5`6H~2ZfN0%u7|_j9^{idUcfQ4u8Q8=Kn|)PpVw6%d4mnB3;}r+CpWW
zwo0cN$qbF=qBtVhYC87XctCTev_ylT82~C|q8fID!}f6yzoT=FykooE!zWAt!c`8;
zIm=Au^+6_AL!u4G>Eo#jH0ouG85WvA(|fP$zC3%kc+<{&8*s5PpT`+7OoDk>b8Kim
zO!n)$*$&~+jKnxUpA3*al6s~RLktCH2w_qc|(yr5X4Pn`^y~Y#6L4
z_zZsrXi$AN#%$#;*`JAXZ=Atw{=Ecwc<&%aaDSuH>E7@`n=Rfh`Qf16gsW-tE_#
z*rWpXbBtcBHFs6;WHbB>$fwHa*d+4vsG)UtcMO`1+
zDcDFNpxcLXQg7|-DDqMHisy?*6HzX?k~L^h&tw0&%Y?%C{T%4n$s}Wr)1{&bgB6eK
zM4K&Ew%1}hgeT(xWxkb$mo)1Q^qq#`b*5j-r7${)!yr}OBv|u1pS81X8fa3v=kIVx
zdc=4m_6z{Cg&TvxXC-*X*`74%@Ja^qZ
zo=>rYUf%}}oTYBJa4J{uR+E9{d(zjIg1v#F5^x*s@Tbru?4WwoO!S
z;uAKFUqh0VlD|UU6;TMae#fO%;?_Mei=wj{wFJ>D#-PHG3A!Ag)tp&)*gmx=JvVj!
z7lGnesU+FmA|`@6hEIlvLAklO1~i6#1-Bste<~kW7yHRgxZk`|8X4zyKZEz;w~yoQ
zh*-wDjSN0VfjV~L$@*=6J8aD4)#7lolUG%TUixYhy>?)Wt9OLUk+4L30dtPG(9#s4
z+%v6&;hgMy-&*Som1R+gz%dDpOXpd
zjJ6@b_-AUp*zUzG?5S&2lqti(`2po#b?163hVKAcnwf-i^t>bxMt8h3`-`8j&D&36
z6=hjvL@0l#-nz60u?lG)+Fp$wkI%#ReDIM#x()Skc65vx{7~BQRTewnTWI-$$VN~T
zPRQp(u~>z=aA|f}HTzBTflt=6>8uC~36)Vcr80%BOa?=cPA09U!iDLkxUN4;(zCCx
zlBS-mEvpy*%JF)qmx6&FsKe@1k&fqxjB2
z5;t}g@Bt4C>uJhU2dTcLYSa(5vL_So?(%dxDs!LXAVyh6%d2p`P^wi{fN6rC-Fz;h
z+5jFS)<@Jg_glBM>!sbE-g{+m*x^iilPyj`2HSXV*l$`#8h*CX7JlvM_s(}B^j%H>
zu#0&?oNy)FYjwT;y1DV;#Ge{&juV+_u5?yYR0SM!t$4T;Te)0Ve9&e4FH+GjMzL3<
z4{zT*{igiPUhMxIE@)mOM~+4c_p^j6d{}}Viqj#?BaXqm3wGCA9J9P#$Sd8sl7Ci7
zzWjYcu(fkcGUvu}bUgrr=LjYScYwkG1I1P;0=&&J9#N5ZDdg>agpR+%o@^BUai8B~~WLgmtE@-dif*IHz^X~(iT_Qd*r=P~hK9Zh||sC~70oDuu<
zlsQr2ylnA1JjyavWAsp|$6eiGcBx#g;fgSU#u-7U&HC-AVNEnx#WdHYoKR)#D4j6+
zT_qvYm#6D-!P0y3wJz0KyDq^Y!t=Rf4tY8^;#M+tLSt?^v*LTY@Jnq1oHhx>2_wjpUlCwULxbI)b3qZ}TM=-~D=hUlwKrP}z7M+x}
z{nd<{=QBhhL05zNP3buT^_iETM5`$7BhwPK%tw7Cl2i@aosC%<-;z0+G?y)=s3qsv
zjuI^fxpQUp9`2}k{XaGtI6ut@Uk0)53AKguf7Jr;h$;O-OLZ&pSt8K0K2un`91WNc
zC+dXc{gC4SHdA__<*j}+H3|X}vUBwQ&`SGif*l;2l1O)|_$`}lz-h{i9Bjbod{;*)
z&JT}1uDEq{?z{Fe8EZAzCzDe@6HfC@%NDzXRLc_m+%}B&T_zV$0aF6IB)jF*&lX|gZ07D-Oqx2B
z&VIJJWI8rPukp<3W<|c`BL?yYtk|cd2};?k4Rqq$27>wPwFXpC9WADTo|Okmp|o
z^dpxP)4;V>DIBLN-PiOLX`v%B&RXnAmx#Sf00IG*K2CcR=obo!-!0|wq|ZKF-CpPS
zqzkZ~EplA{dRe@WIG9^|c5>=A%Tr&`M&F9KdU2?
zM46V#@zr~{WfOVP^ngeviJ5WFLQlaQ#7vQ1%Hh`5!UCe_$`koosu~b};|&`U{Iyau
ztuqKNC$06C0019PTPX2udLj`yEs}dNj26b)K`0ZnzWd5t1#=-Xf|hfK`wyFawuJ7B
zhc-xI`m0?RYd=J3un?=8KASE@1TzFueOJFt&BFwR>+oRCGP_QRfv8;`@N23w9*CU-
z67grDeNCB{Y`lZc=WIww3Rx{Fdn5->(fpD8ZX&ksyxjgIKNR%XYHlCEcleyvqM9ox(e(q@qyJ>}R4?!&IC}VH7si_2=%KZR7{@2MqqcJ)=(VTM?N|L3-@Lw0IO^
zA;~iWiH=V|Sd`}-*j@F|wm4E0_Yli!AUvBYVRysk$Iy_50{gse|_;qb?vo+sNv3VT0s(INP(wBPzlc|XG*q{kR~
z3ap*M9A7F})vuK=-%e-6gGx%dzl`@cFoRXsPXI-yKb18Y7ux`+^64#uaI9H^UThw=
zpn?Et1)b|!*QzEX*&7AHLWSA8ZF6-te*NFZ41sQtm`>$2jnPDD@|$|%yIs@@-qolR
zB3?O=OS<$)AF|i`iCt$xbypx8x6X%vp{S=ojfMlc;s`8|?FY<>13tw4&KMC*uQ3)K
zsYOdoT2z~mEYRAiPj-$F>16ggL}l+fCUSRZs(ss2vEak;(Y0mq^!HO`)o^Luo1eRZ
zrRbgHk(mD#eunbE#KN)%_EZPZKc!!vg9>(~pfe#96-H1{zdd4OqpC-%CruMEq$LXn
z?Yi2{YI)w1g=+9ZU9rXn{x@@R+I_-OBXI=yCvzEiQ2}GoLsEEP?QO?~-Jye8rwjFs
zl-y^@MMu<_fDpwg)J`42eH=S2PLi`b@j<&JxdS>jkIAm7!aXJDXik<`kwX5pi**C>
zJb`|rl;;rd{H0M5ms0^~O+$-;wyFWWyc`1DGT-}ZX>um>h7n6$vaGK!#H}dwo9Izz
z{DR&WdQG$CvoOkcZw-D_eV!IWv@FxA4btH(FBc?kUktdw$330oHaS5M2TBk+SZ|?c
z3N~qmfMFzB8?vE0YqYTiVPazuiiVf)M1Mk_gM7j-{)vMOjD$0f4L&rjPgHhWtHi
z31_C99vsFa1-HR?j$dGnHVl5pPv(EdQC7_w(P(||Ba1HT>Sj<4l-fY>klGt1K2PiB
zW&3ky{kJbyE&J=*pQGs2aY+#EQ~o_O{Hoh+HJew;^D5Ko)JxnI^~cFcUg_ihcK{a(
z$4YkwwPu4>qgHn+P{|}*wRh=fW^7^oAjd|)T0^o-o3ii2m4z(YtTpns5uMsw0lWRc
zr9)Cw-nyl^6Gw}BZXoMn_>8^)=k#blj?r+HHPIYWYyak)nSk4aSY&vNd;8$5MOx)~
z_9-Rx256%#kyar?a~LLzR#ETL-ODB9GAb1*doHeifXAjotqC-lKb%0J$ddRL$`>bR
zN+P|c$3B>p6jE~b7%>nLt{6n;AI5S3>d~ng7`px^mE_2;CQL&b~qO9;CIPzl+Y5XpnovUL;
zoKheI)qJ^%HYD_pNPoI2TE(o%tzAOCEE9qoJErUlTrp42PFq-PGbAJX)qY|p&=d9H
zr2-*kCuRTIF4`g05pvks{v~c@&TsmFTMDt_I4k>^Mjr=1oX5`+rUs}oc
zQssAlV$yH>e{8*FSX|4tHJlI#lAyueT>`<~A-FUSO>lP)7F-*GyAz~wcL)~TEx5bW
zxPF~;?>=|${k=b-d-YSRs@7a{jyc9CuMCCEW?@~LpcO{F_<}KDL7)nzvk36B#(V#~
zBn=p_N)>zAYHa{1VORH5Ob#0tcV}hq{r6oAta1Zrm7#{!u3Yr%)ZurN!cSu2_-Nvw
zuM^+dhQNE?n#9u@2=@m(fRbDZ8BPFO9kfZUNUIo
zxqHgkQp(wH$=4KDefkZzJO&deB9@ix1?)5zr_5L!CzAN5Qy3Jv$~6*VsUT#bDfMr2
z&=X39wg(rXguDW}Pf6p`T0?-G%pKkL@K_~pxC;&1TY09(Qy}UK3g?sO4f^k^G4JpM
zI7NZEEb=|bs0vv*k&H;{xKDVV47T|UX`Cg55oe;qDs5~DgcpJuWx!ugj2mn_MH~i<
z$0U$6u#aA&6;vo|dg>-rydRUrYL<5&Uk*UzWj|q&NoIo!0lKN}GMCl3e@uKae5-9Xx^@S2
zQQSl`?DWFLx3+z_co-hqr`#CCHz5*TQzQM>0m*#q#U_SQJ}Ea&+a8~uW^kgPAGsv{
zfwu`G^r*owmsrN2Z*9=OmpTkTYKwY)W?5)?DM}^Asvr~ZB5gz_5Da#1|CQAzubMO9
z;b@Y_%R&D=B&3D@GMBgG_I!LUTJYt-jRQMpf+`#fV7PM9Cbc)_yHgA#gHmfVbF{Bd
zeaF;AX?`WrD{F>j6=8rr+H0cWh~S-Xb2pE!&!LG%V2zBCIJP#jHS`Wm0+S2dQ`?+;
z<&uru*>YuWMi$*HdJjepw0B&d1w7jCUnQ_xV1SkDN_nGY)-+l8ag_b|gmAk3`Y6CI
zhiI-d6P>7`37V>;t8ucyjk7rQPFq};kDYG@7w?(qpC-O6m(r`{Rl7_8mo;gvO=?$#
zJW`3P(X@8*$N+|~H1KxM&WR}60W&odhz2tczaC|P1F;z5zhVPcC{VG@>U};gArzx{
zDVK5YNrZYuy-oCr#?dJIR30#X0)T@|T@kg2E*i7=V0?SU<3k=~FGA_xUsj@JG}LF_
z=kdG^`fzjF34_Sr9CvP|8`#Hv9^X&CLH7F5cHQlLht+MyKa&(R7>Dn|p?|@zjeXO3
z4>+_RzeDCEy3izTSQxcKG_qtpl0=C^kc6Y|jS#O#=dGMfnldw2;@M45G=jB3BEQLc
zq_$Ya+eJMMiQWq1dX1{3*U?&VgzdkAWIJAi(%c9~O%819(zvU*s4lJxT5gCn>(Wry
z%HreSO_1vHRR=f0@W?TK{Af+~QQ{*1U?r=%-<&fv76D4(3iEh>J<>#NGuGr7`El=6
zIW|hPR1MWYd`za}j5TJgg|9o!U1p20Y+AkYOfh=7&FF+VamW)i9Y^b`&9aZd*MWSo
z6=Bh2*K7KY;rQc_2g?$Fc`}Jf{;EJRd*qE!He^U0iV{)4>XLoukfm-Wgj1_Ne>gFs
zA@XCeie-hqNVye%o}L?BQDs0V@(ceJoCIO;*z)uKV5iPJM+?gVVteFtg1pTFOwy(u
z$>GeV9lJ$3k#!}WApa7w9(+*)_W~#4;5pPg%=MhT@EkU0_nDk^lTax@at(wV14nOU
zu_$6myjS20iqo?MBt5!9kBbEVVKh)wsO|Wc11eIG!|ftYFEkzF+WDnWeWW!IUE%HV
zL|x*_g9cM2LCT8LBa=?6Y^?_@XMhD-!Js{zOYDAlj+OiOlZXyO#vBn%oXIFC31Z&<
z9^@&*HMmcp?ZR`bRfLn@Eiz#*x@^Th%%J*<*$+i3mj*B&;NIpWnm|EGOA*uND&Xl1av
z6|TpfIsFqR7CthfZg2SuAOnnQ(cR4osrrp}FGaz9u-mLbjK5lUksKDCLCj+
zS+~l!RikF7p4i<_+RWr}NPgUsuX1L!FGG!F3j3+1pM@X>yrQmRB}e^37h
zI10`3C1A=u1#@B8#hZShscDGBPgFOWTd}{*%NC
zdr^E3gz$$$Uyf)u2y1RrH!=E4I?1Kdf4`ZvI`TE*lot85?GGvI6+OS_)`|7QXhgB0
zvn-rWxt2is+QY*E<;$O}c!Lo7#BaC({=NFtuammVtIR6`Kkx5v>Qps7n|E-YDF5%b
zjy?#NOF_jCO^zmoUtLO^0K%m5nYPl0;7IscupyR<0c1#y}v+aJDM%=u&i
z53OD?xaRY9-f*Cor$uS~VyL4;t>e5i{&)vGGV%1H31r_fcke-#C2vasYY9TS0JDm{}6c`w!H
zcPr$wV>C{ZgLCy%+cq=lOY&rT#Sz#AqI$eav#B%Wo?+6_iu(2JSbO7~laQW0SX;Ah)@*eCRTl)zbp!@
z5J8rYAiujuiyezUj+i~DSaty
z$Y?LkqyUS{nlw3oo`OO
zsf4fgX9k$LP*HcEjd`ZVVuVd^x;Q~mJ0YR_hlf&5yDWJ|eTwsuj$V7_f{W+_ar26A
zHimDD4gxrME^^-?)dJK|-oLNaYvyft*i1x{fPY|JjsAE~DYqv%QDj{#f3AGQ9O1^jC)erxwbM6y6dbslq(%DbBT)a4^ZebyrmGt^e)W
zHUQG+C3rx|m$*t*Ui(n)KDr_Zx6nZ5dwr=jU+}5Sc9jXtygSJcO?T)~yGqg;f_MZi
z5{I|qs8o}or9r+M7_gNP5BEqJHe*tL{`IL`uaGY!iq~69K*~S=Ita0lW+Q6UF`_?x
zlIt1c%wELnXr?3&BW0ofu$wsA4VfF2m_Og`>wA@5UKeQAU{v_PcWi#x5wU+8!$dDf
zu)cuzTXoX9Smj4HPt9{a1w2==&tg4ej@v`~<90W^*u%sL5ySrPb>Eq8APJ=PD+$>Q
zEDgdlx*hcWK#c4sI}
zw(M#1rA?7wc2v!Z$HSVTOjj^tG9TsXfdtbUo#g51X=JE!;pN~^A7RV|sveaN(eQ=L
z*!#cYahfG>cHC}0$YL{bbjiBE>+u$?Xr(b$AcHlO+S3304hFiANc?{S
z<^L@tngpzWh7$$iuH_lprA#toI!3kw(yT4%Dg;Lj
z2X&NgduLq)ZOrzVPuNF;iG=hRG-qS0@RgNH+K?zSALyg
zndsw3#e-=th2a36F(@(wDVfb%ghxqXF*xFLVajWG%Bb8yh)8>y&*$JoFdj?wt2X(3
zdWNoQbz#5$P{NqM#*G1DmN>{1_o0Zl8W?(b8t1gK-
zRW9rUjmi_6O0)AhCOxq9qu%ySCMc~w2DQWP(zl`oOH_V^bM^DhL(L9j
zfz8WtfkXuK*cGU;2H>IIre&rU?Gsrb^*Rgjtle)Jx6|c37$`+0_wEDoSQn+2FWRRx
zu9C6!{yB?nFtTN-tyJ>;_K?PY|3q9osbAqn;J8V0ja>TrVdrVXm+2-|E140)&BQXk
z{qs$lcs>o365W)}PO^gqKNfz{8NUpYH*dWQw0)mE*tZ8V0uJU%%K0UwqVV$;*72IG
z&jIwxtq2)Bo|kOMM%ZAyzfN!_Ta7Tgi5-f2Rk(5E}>(aN6cEGA=y}UK7X+>hFbW
zeX!qloB8_o?`@brJB0azeROq?c35owk5|4z*V>4#9vlt^*=cEf>%iPW85EDKaOYFG
zAsv_emJp^D>)w@P33ozbp_uEJ+q7m(M=H*Az66w~=LRIBs4!M|AL5%y8$%*H$9`uh
z{y=*^5iRuFmiSSq+3Bp(((0pGIN75MZ&maOv4Dcc%d(8!<#Eo=;6x=e6ex~}db~nC
zeppXR+PT@N>>OP6{fxK5D4!YjVJa^oX@9SW&e`!7VV)i6yh8~e2p`xes<%*bC_kVt
zYQx|wl=`P_henyT+@jbb1(n3N6G-q$dVMZ59r?7=59~k*f`y;DI_3k_%Own|rbGv;
zTrBZ~=@&Ws%+t5PSZTh$G(J-=?YW7m(#3Njc}DfN7~?Y9yVR9MaGSK&D!xnYt$iu1
ziVv8JtriwULPS!@-AE)OnKHVztu;ev_=TUuZYu#TNU26(_#>_kKSKdII>o6BijD$k
zI<%N3T1R$7lvzYmFjkNTd4@)R+67@2SQ#5_nzAC0^uG$_lgfebaQ8zOeeWk
zLC|yEd^zJuDMgC{L*K2>;8Bl4EuI1@wM&iVT|z&aVZNi+{8%9A{
zfkh(~P8yYJ>3aXh??5&0tAwRe2R79fOE+6D9y!ZDMjMt&@=Ll$yZBa0QJW9R$B_J;~9`6myLO7G!Oo)s;D-!
zZ;E`5zPmmGPlk%EYBYSLEMD+D?8}|M0AeoJmI{LsOD|1i&|&*LjzI7^X#N&Cwu$2n
zMjr}ePkUu$C?Q`&a-_#>FV7y~nj0ON^p*{uI+5la%NV<+dpf&+j{WPqj)yZLFQE;m+?4cH@?Jz0!xs%ziGENsBdimly=}@*?;3l
z7@^tcghDn9Y`|8#b%cepN4STgu2^FHSyXS^WnUkWImb%;#JszppTP29-PNd2^ive8
zD5*G&8P^#(?UW$+k}9!}3O`ZS_TaJn9OzkcdnMf~;hA}G{yXu`9AP)oS_*+@u8Tr+
z`@9v}Sj-eq=Tg}j!~(EpLNT|Abs=ipZkr}N8e#qiI%~N*$ZihJV+&$*GxYQ@+%Agyk(3rn-E;IzH=D&P>Mh+;
z{ff8SV@YY2Gewc>@o54#odm-K60t&~edRB`CSa3JBH}QYo09PbiN{8GSr$y?O4d
z^qQzscJGRCmo(3QA*=qHuu*H;P3*|tkf~b#k9tOwwEROT+c`Q{>Np=99Gqa@t|HS4
zox{_P&0NUAY-30fd*GPp$3c}m`eQ>D0YI?AXpUv)kqFHBU^ib5#!B@pxcq+KelZ!}
zsC^DeAGCGlF&Qh#l#m_jlu`l!`2rIP-kMFt{
zF@WjE*LFq~6Q~Kd=9$huGtKlk)C=L)`wCR>ZBjwauK8k{&unh*oP1Z^gr;ITUX;DV
zZ%)OaULfwNL1O8Fg-koaw9Vz7LNg>nq!(R@?3O=(o)7IWT3B!Wzn6>
zNKi1sQM|8%KH7;SsMh^BCB%$%JIACaJmrobs*>GOn09?>-##s0d^f{DF4whLQsK8d
zX04c|>Fbv((U*;*f1muYa3W;9{$c&F|B3tlFsn?#%-i8b-%D^9tVbgJrOoROANl3d
z>OQpX%ldIxNQdvMr=M7LH1hS2%i~W*hH0VQU2aD_GEn|zVFSKapoQ+u0%*Lo0B`cg
zhUFTt)@B!7;obMp1@;Ps2b9bL0eFQ;sO^J{d#m$yqV`FUEElcO{j}xk#L_{2oX}Yd
zJ@w!7U1$?0On5p-?~p+HD9+D6fcrF|gDO(4q3_BDrh+oCPAWtMVKS%dj8Uu#JM{Ap
zL0oCA5)Cz=KiYV?^^&!&V8Jh3oUM%MAf)k{mK$1+QNn|qQ3qPwt|V0~dh?TmNx>5$
zr(*(02`h20Wt3uOPFH=L>DaH8grsSn%TFQ7X0&E>H!XE+HW
z94p@qX%sX02)71~7l^G+xSDKsSPJ}}+j$=lxy@wdF-me>GlzJk?T=#+8~KRO7L+T<
z@79S%>;UQ}RM$5Y7TQ*p*=oIYcT_L>{?+uEoJw#Zyu4TId(Yu}nB!FDHZ}96_6n<`
zuvG9DpY2|x&WnScvRcnexBJ?Kg-z2L5tI!~zrpQ@Dk%VcYJ+>8w#HDw%>HzWtTW{L
z30H@Pzmb2wn~OX+yf1~#1P~;1a`u31Jvco+=LU5n_}oCk>nxW6`|v0tDkZN%ubhNEm>&ENioz=>Qq
zi-q{rE&|J&N9EB81Tos15E772F{-1X#HUmBCwS8o9Vwx6OE;
zE;aQvQK?Sql&!FePF^*kVe66ccPXh6qGCQ;Og5r$*aFg?Zw!1<4uwQKuZgF{42?b4
zt9z|D4(7W7D`9uoG^wgfBv#KADWqb6cO$X8w9Zkoi3rB&<
zP|4Nex`clE_)6mXRUG7BVGbVwwo$4(Kb}&{6os!ka89D{QCWayHk?B$DMPOjAdjqA
zmkv6h8>^xCKwVNc7;`JiIQ2BHbt-j(>pey*>hI-`;8xD*Dz~@UKoYN+8Va$Km{r*t
z5qsTVW4h_*@Dkt4M`z<8i}0fvGfv1~PqMhGz#d7%9unc0f7qvrkEmVEGWH6?o^CrN!$?-QQ
zAOG8sZ#X>b;{#a&!SN~L3WQ?rfga?wGr_EmVdP8vE-|8kE)7DpaR(#GMP1D^q|XLJ
z@(n|rwiv(LPPxmL8y7W~Ce;@A#+8SxR?H)JGDxotBa4`HYgMpVw5r{!kpwuSNp2Q3
z=%ZKt-beu;DK$6%T06b#VDaQ?&Mi)HgsYtH#HARt^EJOP!bs?mm$3er{O#ALLZUQ0
zyX38K=**z1g*8^3Op}3F<+41_vCcuAQ@V~0c1ul$R)Yhtvk3nF&%gP!7mKHMr?tZ|
znT2tfbvcRAmV%M@hc;BVIuM+K!)m;)n!6XHo)2igmTdE_yS%%3^tsLsS@+$oLTkOrY!WI9&E1aBhShVoS^w#|YKcj`
zEf56Opf7KAzai!~abaeIht}7UJ73w<{|+|_BP1h;x9w6;OHCwF4%CcqhG=l>9;NJm
zb+FSwjBZsgN1Y7{{j7Q@jYt3m5Mufif9u)+8-(3Y>-vrn-|Rm)1fhF&4A%J42JIG;%?
z-S(94OYNa&%@t-~h+*veeY#MwHG^h-_xF$Gx~e%V5eFQ*t)N*F!gK!aHy8%v++hSQ;i
zm&n3xriBtZ>!y7V69PAc?C-;uO;*$XXtrfymC5infN|6=YCb=qwkot_@I*<>I%4uo-cJinwO`g9vG3TbLNyl~
z6Z41wz2&<5^4t53w#(QFaaF+OgQ#YmI*JaeF24vI7CC*;bExSkQ2cB!y)$QrXrUq7
zyJc>?dfV#G&gA=`T_|`4ddlF8C5i@0y2-|SeY1)VizgVhrxw|U*D`3%uIV;Ht&*u6
zWraP)p^;Xz&$1j~ja)-J%-knNxlR7AqxExcvmN)*Xr2(2A99_K_$9@OjCGGuzefqu
z`Vt1QsxH1d*Cq~p()iF-!;rur!;}V44zeP=0!j1vX#6h-{1;Fx%!s~ryK2tnHp}6y
zVoVYEsZXtYp;EGxgBSS@9on@fLCXJGbHa~9>1PnJDTg&w4B0DWqW(pB_Bq#4;lN7J
zSW#q4M%(}wVDxMA?&%@W9vFDkY}ijxbo|znj(m%dhoY{Nf%RpvEdCZhk<`uR5QT%%
zw`EpR^V5ad&ep+#scZ~a!^NYRpj6GDwh?#8xUCIsK|tWn9U8x5BA;mlf5f9(E
zEja@{0}AW;nNsQBnmPcoB95?UI_GY@qBB?8yVbh*G=l