diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 292e4dffde..8e402a21d5 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -41,6 +41,7 @@ library Simplex.Chat.Migrations.M20220514_profiles_user_id Simplex.Chat.Migrations.M20220626_auto_reply Simplex.Chat.Migrations.M20220702_calls + Simplex.Chat.Migrations.M20220715_groups_chat_item_id Simplex.Chat.Mobile Simplex.Chat.Options Simplex.Chat.Protocol diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 9979983933..dca3c291c9 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -672,27 +672,30 @@ processChatCommand = \case APIAddMember groupId contactId memRole -> withUser $ \user@User {userId} -> withChatLock $ do -- TODO for large groups: no need to load all members to determine if contact is a member (group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db userId contactId - let Group gInfo@GroupInfo {localDisplayName = gName, groupProfile, membership} members = group + let Group gInfo@GroupInfo {localDisplayName, groupProfile, membership} members = group GroupMember {memberRole = userRole, memberId = userMemberId} = membership Contact {localDisplayName = cName} = contact when (userRole < GRAdmin || userRole < memRole) $ throwChatError CEGroupUserRole when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined gInfo) unless (memberActive membership) $ throwChatError CEGroupMemberNotActive - let sendInvitation memberId cReq = do - void . sendDirectContactMessage contact $ - XGrpInv $ GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile - setActive $ ActiveG gName + let sendInvitation groupMemberId memberId cReq = do + let groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile + msg <- sendDirectContactMessage contact $ XGrpInv groupInv + let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole + ci <- saveSndChatItem user (CDDirectSnd contact) msg content Nothing Nothing + toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci + setActive $ ActiveG localDisplayName pure $ CRSentGroupInvitation gInfo contact case contactMember contact members of Nothing -> do gVar <- asks idsDrg (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation) - GroupMember {memberId} <- withStore $ \db -> createContactMember db gVar user groupId contact memRole agentConnId cReq - sendInvitation memberId cReq + GroupMember {memberId, groupMemberId} <- withStore $ \db -> createContactMember db gVar user groupId contact memRole agentConnId cReq + sendInvitation groupMemberId memberId cReq Just GroupMember {groupMemberId, memberId, memberStatus} | memberStatus == GSMemInvited -> withStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case - Just cReq -> sendInvitation memberId cReq + Just cReq -> sendInvitation groupMemberId memberId cReq Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName | otherwise -> throwChatError $ CEGroupDuplicateMember cName APIJoinGroup groupId -> withUser $ \user@User {userId} -> do @@ -703,11 +706,20 @@ processChatCommand = \case createMemberConnection db userId fromMember agentConnId updateGroupMemberStatus db userId fromMember GSMemAccepted updateGroupMemberStatus db userId (membership g) GSMemAccepted + updateCIGroupInvitationStatus user pure $ CRUserAcceptedGroupSent g + where + updateCIGroupInvitationStatus user@User {userId} = do + AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId + case (cInfo, content) of + (DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do + let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = CIGISAccepted} memRole + updateDirectChatItemView userId ct itemId aciContent Nothing + _ -> pure () -- prohibited APIMemberRole _groupId _groupMemberId _memRole -> throwChatError $ CECommandError "unsupported" APIRemoveMember groupId memberId -> withUser $ \user@User {userId} -> do Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId - case find ((== memberId) . groupMemberId) members of + case find ((== memberId) . groupMemberId') members of Nothing -> throwChatError CEGroupMemberNotFound Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus} -> do let userRole = memberRole (membership :: GroupMember) @@ -1714,10 +1726,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage checkIntegrityCreateItem (CDDirectRcv ct) msgMeta when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId - GroupInfo {groupId, localDisplayName, groupProfile} <- withStore $ \db -> createGroupInvitation db user ct inv - let content = CIGroupInvitation (CIGroupInfo {groupId, localDisplayName, groupProfile}) memRole + gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv + let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing + withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci + toView $ CRReceivedGroupInvitation gInfo ct memRole showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group" checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m () diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 7f920c9041..d9b6bc3f83 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -259,6 +259,7 @@ data ChatResponse | CRContactSubError {contact :: Contact, chatError :: ChatError} | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]} | CRGroupInvitation {groupInfo :: GroupInfo} + | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole} | CRUserJoinedGroup {groupInfo :: GroupInfo} | CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember} | CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 5941deabb6..299ea87928 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -495,8 +495,8 @@ ciDeleteModeToText = \case CIDMBroadcast -> "this item is deleted (broadcast)" CIDMInternal -> "this item is deleted (internal)" -ciGroupInvitationToText :: CIGroupInfo -> GroupMemberRole -> Text -ciGroupInvitationToText CIGroupInfo {groupProfile = GroupProfile {displayName, fullName}} role = +ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text +ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role = "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role) -- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API @@ -508,21 +508,38 @@ data CIContent (d :: MsgDirection) where CISndCall :: CICallStatus -> Int -> CIContent 'MDSnd CIRcvCall :: CICallStatus -> Int -> CIContent 'MDRcv CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv - CIGroupInvitation :: CIGroupInfo -> GroupMemberRole -> CIContent 'MDRcv + CIRcvGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv + CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd deriving instance Show (CIContent d) -data CIGroupInfo = CIGroupInfo +data CIGroupInvitation = CIGroupInvitation { groupId :: GroupId, + groupMemberId :: GroupMemberId, localDisplayName :: GroupName, - groupProfile :: GroupProfile + groupProfile :: GroupProfile, + status :: CIGroupInvitationStatus } deriving (Eq, Show, Generic, FromJSON) -instance ToJSON CIGroupInfo where +instance ToJSON CIGroupInvitation where toJSON = J.genericToJSON J.defaultOptions toEncoding = J.genericToEncoding J.defaultOptions +data CIGroupInvitationStatus + = CIGISPending + | CIGISAccepted + | CIGISRejected + | CIGISExpired + deriving (Eq, Show, Generic) + +instance FromJSON CIGroupInvitationStatus where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIGIS" + +instance ToJSON CIGroupInvitationStatus where + toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIGIS" + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIGIS" + ciContentToText :: CIContent d -> Text ciContentToText = \case CISndMsgContent mc -> msgContentText mc @@ -532,7 +549,8 @@ ciContentToText = \case CISndCall status duration -> "outgoing call: " <> ciCallInfoText status duration CIRcvCall status duration -> "incoming call: " <> ciCallInfoText status duration CIRcvIntegrityError err -> msgIntegrityError err - CIGroupInvitation groupInfo memberRole -> ciGroupInvitationToText groupInfo memberRole + CIRcvGroupInvitation groupInvitation memberRole -> "received " <> ciGroupInvitationToText groupInvitation memberRole + CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole msgIntegrityError :: MsgErrorType -> Text msgIntegrityError = \case @@ -577,7 +595,8 @@ data JSONCIContent | JCISndCall {status :: CICallStatus, duration :: Int} -- duration in seconds | JCIRcvCall {status :: CICallStatus, duration :: Int} | JCIRcvIntegrityError {msgError :: MsgErrorType} - | JCIGroupInvitation {groupInfo :: CIGroupInfo, memberRole :: GroupMemberRole} + | JCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} deriving (Generic) instance FromJSON JSONCIContent where @@ -596,7 +615,8 @@ jsonCIContent = \case CISndCall status duration -> JCISndCall {status, duration} CIRcvCall status duration -> JCIRcvCall {status, duration} CIRcvIntegrityError err -> JCIRcvIntegrityError err - CIGroupInvitation groupInfo memberRole -> JCIGroupInvitation {groupInfo, memberRole} + CIRcvGroupInvitation groupInvitation memberRole -> JCIRcvGroupInvitation {groupInvitation, memberRole} + CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole} aciContentJSON :: JSONCIContent -> ACIContent aciContentJSON = \case @@ -607,7 +627,8 @@ aciContentJSON = \case JCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration JCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err - JCIGroupInvitation {groupInfo, memberRole} -> ACIContent SMDRcv $ CIGroupInvitation groupInfo memberRole + JCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole + JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole -- platform independent data DBJSONCIContent @@ -618,7 +639,8 @@ data DBJSONCIContent | DBJCISndCall {status :: CICallStatus, duration :: Int} | DBJCIRcvCall {status :: CICallStatus, duration :: Int} | DBJCIRcvIntegrityError {msgError :: MsgErrorType} - | DBJCIGroupInvitation {groupInfo :: CIGroupInfo, memberRole :: GroupMemberRole} + | DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} deriving (Generic) instance FromJSON DBJSONCIContent where @@ -637,7 +659,8 @@ dbJsonCIContent = \case CISndCall status duration -> DBJCISndCall {status, duration} CIRcvCall status duration -> DBJCIRcvCall {status, duration} CIRcvIntegrityError err -> DBJCIRcvIntegrityError err - CIGroupInvitation groupInfo memberRole -> DBJCIGroupInvitation {groupInfo, memberRole} + CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole} + CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole} aciContentDBJSON :: DBJSONCIContent -> ACIContent aciContentDBJSON = \case @@ -648,7 +671,8 @@ aciContentDBJSON = \case DBJCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration DBJCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration DBJCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err - DBJCIGroupInvitation {groupInfo, memberRole} -> ACIContent SMDRcv $ CIGroupInvitation groupInfo memberRole + DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole + DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole data CICallStatus = CISCallPending diff --git a/src/Simplex/Chat/Migrations/M20220715_groups_chat_item_id.hs b/src/Simplex/Chat/Migrations/M20220715_groups_chat_item_id.hs new file mode 100644 index 0000000000..0fa5310bfb --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20220715_groups_chat_item_id.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20220715_groups_chat_item_id where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20220715_groups_chat_item_id :: Query +m20220715_groups_chat_item_id = + [sql| +ALTER TABLE groups ADD COLUMN chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE SET NULL; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index b99291d104..33b5441efa 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -117,7 +117,8 @@ CREATE TABLE groups( group_profile_id INTEGER REFERENCES group_profiles ON DELETE SET NULL, -- shared group profile inv_queue_info BLOB, created_at TEXT CHECK(created_at NOT NULL), - updated_at TEXT CHECK(updated_at NOT NULL), -- received + updated_at TEXT CHECK(updated_at NOT NULL), + chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE SET NULL, -- received FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 71cdcd873b..a4a5ebf032 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -60,6 +60,7 @@ module Simplex.Chat.Store updateConnectionStatus, createNewGroup, createGroupInvitation, + setGroupInvitationChatItemId, getGroup, getGroupInfo, getGroupIdByName, @@ -147,6 +148,7 @@ module Simplex.Chat.Store getDirectChatItemIdByText, getGroupChatItemIdByText, getChatItemByFileId, + getChatItemByGroupId, updateDirectChatItemStatus, updateDirectCIFileStatus, updateDirectChatItem, @@ -212,6 +214,7 @@ import Simplex.Chat.Migrations.M20220404_files_status_fields import Simplex.Chat.Migrations.M20220514_profiles_user_id import Simplex.Chat.Migrations.M20220626_auto_reply import Simplex.Chat.Migrations.M20220702_calls +import Simplex.Chat.Migrations.M20220715_groups_chat_item_id import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..)) @@ -238,7 +241,8 @@ schemaMigrations = ("20220404_files_status_fields", m20220404_files_status_fields), ("20220514_profiles_user_id", m20220514_profiles_user_id), ("20220626_auto_reply", m20220626_auto_reply), - ("20220702_calls", m20220702_calls) + ("20220702_calls", m20220702_calls), + ("20220715_groups_chat_item_id", m20220715_groups_chat_item_id) ] -- | The list of migrations in ascending order by date @@ -1325,6 +1329,11 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId} GroupInv membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) currentTs pure $ GroupInfo {groupId, localDisplayName, groupProfile, membership, createdAt = currentTs, updatedAt = currentTs} +setGroupInvitationChatItemId :: DB.Connection -> User -> GroupId -> ChatItemId -> IO () +setGroupInvitationChatItemId db User {userId} groupId chatItemId = do + currentTs <- getCurrentTime + DB.execute db "UPDATE groups SET chat_item_id = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (chatItemId, currentTs, userId, groupId) + -- TODO return the last connection that is ready, not any last connection -- requires updating connection status getGroup :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO Group @@ -1335,7 +1344,7 @@ getGroup db user groupId = do deleteGroup :: DB.Connection -> User -> Group -> IO () deleteGroup db User {userId} (Group GroupInfo {groupId, localDisplayName} members) = do - forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId m) + forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId' m) DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId) DB.execute db @@ -1538,7 +1547,7 @@ deleteGroupMemberConnection db userId GroupMember {groupMemberId} = createIntroductions :: DB.Connection -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro] createIntroductions db members toMember = do - let reMembers = filter (\m -> memberCurrent m && groupMemberId m /= groupMemberId toMember) members + let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members if null reMembers then pure [] else do @@ -1554,7 +1563,7 @@ createIntroductions db members toMember = do (re_group_member_id, to_group_member_id, intro_status, created_at, updated_at) VALUES (?,?,?,?,?) |] - (groupMemberId reMember, groupMemberId toMember, GMIntroPending, ts, ts) + (groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, ts, ts) introId <- insertedRowId db pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing} @@ -1623,7 +1632,7 @@ getIntroduction_ db reMember toMember = ExceptT $ do FROM group_member_intros WHERE re_group_member_id = ? AND to_group_member_id = ? |] - (groupMemberId reMember, groupMemberId toMember) + (groupMemberId' reMember, groupMemberId' toMember) where toIntro :: [(Int64, Maybe ConnReqInvitation, Maybe ConnReqInvitation, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro toIntro [(introId, groupConnReq, directConnReq, introStatus)] = @@ -1649,7 +1658,7 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM memProfileId } member <- createNewMember_ db user gInfo newMember currentTs - conn <- createMemberConnection_ db userId (groupMemberId member) groupAgentConnId memberContactId cLevel currentTs + conn <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId memberContactId cLevel currentTs pure (member :: GroupMember) {activeConn = Just conn} createIntroToMemberContact :: DB.Connection -> UserId -> GroupMember -> GroupMember -> ConnId -> ConnId -> IO () @@ -2572,6 +2581,7 @@ getDirectChatPreviews_ db User {userId} = do ) ChatStats ON ChatStats.contact_id = ct.contact_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE ct.user_id = ? + AND (c.conn_level = 0 OR i.chat_item_id IS NOT NULL) AND c.connection_id = ( SELECT cc_connection_id FROM ( SELECT @@ -3470,6 +3480,22 @@ getChatItemByFileId db user@User {userId} fileId = do (userId, fileId) getAChatItem_ db user itemId chatRef +getChatItemByGroupId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO AChatItem +getChatItemByGroupId db user@User {userId} groupId = do + (itemId, chatRef) <- + ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $ + DB.query + db + [sql| + SELECT i.chat_item_id, i.contact_id, i.group_id + FROM chat_items i + JOIN groups g ON g.chat_item_id = i.chat_item_id + WHERE g.user_id = ? AND g.group_id = ? + LIMIT 1 + |] + (userId, groupId) + getAChatItem_ db user itemId chatRef + getAChatItem_ :: DB.Connection -> User -> ChatItemId -> ChatRef -> ExceptT StoreError IO AChatItem getAChatItem_ db user@User {userId} itemId = \case ChatRef CTDirect contactId -> do @@ -3794,6 +3820,7 @@ data StoreError | SEQuotedChatItemNotFound | SEChatItemSharedMsgIdNotFound {sharedMsgId :: SharedMsgId} | SEChatItemNotFoundByFileId {fileId :: FileTransferId} + | SEChatItemNotFoundByGroupId {groupId :: GroupId} deriving (Show, Exception, Generic) instance ToJSON StoreError where diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 97fdbc8d01..00b934c136 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -303,6 +303,9 @@ memberConn = activeConn memberConnId :: GroupMember -> Maybe ConnId memberConnId GroupMember {activeConn} = aConnId <$> activeConn +groupMemberId' :: GroupMember -> GroupMemberId +groupMemberId' GroupMember {groupMemberId} = groupMemberId + data NewGroupMember = NewGroupMember { memInfo :: MemberInfo, memCategory :: GroupMemberCategory, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index be2248ce9d..8ec8c882c1 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -132,7 +132,8 @@ responseToView testView = \case where (errors, subscribed) = partition (isJust . contactError) summary CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} -> - [groupInvitation ldn fullName] + [groupInvitation' ldn fullName] + CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role CRUserJoinedGroup g -> [ttyGroup' g <> ": you joined the group"] CRJoinedGroupMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "] CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] @@ -206,6 +207,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc CISndDeleted _ -> [] CISndCall {} -> [] + CISndGroupInvitation {} -> [] where to = ttyToContact' c CIDirectRcv -> case content of @@ -213,7 +215,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CIRcvDeleted _ -> [] CIRcvCall {} -> [] CIRcvIntegrityError err -> viewRcvIntegrityError from err meta - CIGroupInvitation g role -> viewReceivedGroupInvitation g c role + CIRcvGroupInvitation {} -> [] where from = ttyFromContact' c where @@ -223,6 +225,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc CISndDeleted _ -> [] CISndCall {} -> [] + CISndGroupInvitation {} -> [] -- prohibited where to = ttyToGroup g CIGroupRcv m -> case content of @@ -230,7 +233,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CIRcvDeleted _ -> [] CIRcvCall {} -> [] CIRcvIntegrityError err -> viewRcvIntegrityError from err meta - CIGroupInvitation {} -> [] -- should be not possible + CIRcvGroupInvitation {} -> [] -- prohibited where from = ttyFromGroup' g m where @@ -387,10 +390,10 @@ viewCannotResendInvitation GroupInfo {localDisplayName = gn} c = "to re-send invitation: " <> highlight ("/rm " <> gn <> " " <> c) <> ", " <> highlight ("/a " <> gn <> " " <> c) ] -viewReceivedGroupInvitation :: CIGroupInfo -> Contact -> GroupMemberRole -> [StyledString] -viewReceivedGroupInvitation CIGroupInfo {localDisplayName = g, groupProfile = GroupProfile {fullName}} c role = - [ ttyGroup g <> optFullName g fullName <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role), - "use " <> highlight ("/j " <> g) <> " to accept" +viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString] +viewReceivedGroupInvitation g c role = + [ ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role), + "use " <> highlight ("/j " <> groupName' g) <> " to accept" ] groupPreserved :: GroupInfo -> [StyledString] @@ -429,11 +432,11 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) groupSS GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership} = case memberStatus membership of - GSMemInvited -> groupInvitation ldn fullName + GSMemInvited -> groupInvitation' ldn fullName _ -> ttyGroup ldn <> optFullName ldn fullName -groupInvitation :: GroupName -> Text -> StyledString -groupInvitation displayName fullName = +groupInvitation' :: GroupName -> Text -> StyledString +groupInvitation' displayName fullName = highlight ("#" <> displayName) <> optFullName displayName fullName <> " - you are invited (" diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index afcdadab42..06cc8dee13 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -455,13 +455,15 @@ testGroup = versionTestMatrix3 runTestGroup cath #$> ("/_get chat #1 count=100", chat, []) getReadChats :: TestCC -> TestCC -> TestCC -> IO () getReadChats alice bob cath = do - alice @@@ [("#team", "hey team"), ("@cath", ""), ("@bob", "")] + alice @@@ [("#team", "hey team"), ("@cath", "sent invitation to join group team as admin"), ("@bob", "sent invitation to join group team as admin")] alice #$> ("/_get chat #1 count=100", chat, [(1, "hello"), (0, "hi there"), (0, "hey team")]) - alice #$> ("/_get chat #1 after=1 count=100", chat, [(0, "hi there"), (0, "hey team")]) - alice #$> ("/_get chat #1 before=3 count=100", chat, [(1, "hello"), (0, "hi there")]) - bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "invitation to join group team as admin")] + -- "before" and "after" define a chat item id across all chats, + -- so we take into account sent group invitations in direct chats + alice #$> ("/_get chat #1 after=3 count=100", chat, [(0, "hi there"), (0, "hey team")]) + alice #$> ("/_get chat #1 before=5 count=100", chat, [(1, "hello"), (0, "hi there")]) + bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] bob #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (1, "hi there"), (0, "hey team")]) - cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "invitation to join group team as admin")] + cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] cath #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (0, "hi there"), (1, "hey team")]) alice #$> ("/_read chat #1 from=1 to=100", id, "ok") bob #$> ("/_read chat #1 from=1 to=100", id, "ok") @@ -576,7 +578,7 @@ testGroup2 = <##? [ "dan> hi", "@dan hey" ] - alice ##> "/t 6" + alice ##> "/t 8" alice <##? [ "#club hello", "#club bob> hi there", @@ -878,13 +880,13 @@ testGroupMessageUpdate = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath - -- msg id 1 + -- alice: msg id 3, bob, cath: msg id 2 (after group invitations) alice #> "#team hello!" concurrently_ (bob <# "#team alice> hello!") (cath <# "#team alice> hello!") - alice #$> ("/_update item #1 1 text hey 👋", id, "message updated") + alice #$> ("/_update item #1 3 text hey 👋", id, "message updated") concurrently_ (bob <# "#team alice> [edited] hey 👋") (cath <# "#team alice> [edited] hey 👋") @@ -894,7 +896,7 @@ testGroupMessageUpdate = cath #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing)]) threadDelay 1000000 - -- msg id 2 + -- alice: msg id 4, bob, cath: msg id 3 bob `send` "> #team @alice (hey) hi alice" bob <# "#team > alice hey 👋" bob <## " hi alice" @@ -912,12 +914,12 @@ testGroupMessageUpdate = bob #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing), ((1, "hi alice"), Just (0, "hey 👋"))]) cath #$> ("/_get chat #1 count=100", chat', [((0, "hey 👋"), Nothing), ((0, "hi alice"), Just (0, "hey 👋"))]) - alice #$> ("/_update item #1 1 text greetings 🤝", id, "message updated") + alice #$> ("/_update item #1 3 text greetings 🤝", id, "message updated") concurrently_ (bob <# "#team alice> [edited] greetings 🤝") (cath <# "#team alice> [edited] greetings 🤝") - alice #$> ("/_update item #1 2 text updating bob's message", id, "cannot update this item") + alice #$> ("/_update item #1 4 text updating bob's message", id, "cannot update this item") threadDelay 1000000 cath `send` "> #team @alice (greetings) greetings!" @@ -942,23 +944,23 @@ testGroupMessageDelete = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath - -- alice: msg id 1, bob, cath: msg id 2 (1 is group invitation) + -- alice: msg id 3, bob, cath: msg id 2 (after group invitations) alice #> "#team hello!" concurrently_ (bob <# "#team alice> hello!") (cath <# "#team alice> hello!") - alice #$> ("/_delete item #1 1 internal", id, "message deleted") + alice #$> ("/_delete item #1 3 internal", id, "message deleted") alice #$> ("/_get chat #1 count=100", chat, []) bob #$> ("/_get chat #1 count=100", chat, [(0, "hello!")]) cath #$> ("/_get chat #1 count=100", chat, [(0, "hello!")]) - alice #$> ("/_update item #1 1 text updating deleted message", id, "cannot update this item") - alice #$> ("/_send #1 json {\"quotedItemId\": 1, \"msgContent\": {\"type\": \"text\", \"text\": \"quoting deleted message\"}}", id, "cannot reply to this message") + alice #$> ("/_update item #1 3 text updating deleted message", id, "cannot update this item") + alice #$> ("/_send #1 json {\"quotedItemId\": 3, \"msgContent\": {\"type\": \"text\", \"text\": \"quoting deleted message\"}}", id, "cannot reply to this message") threadDelay 1000000 - -- alice: msg id 2, bob, cath: msg id 3 + -- alice: msg id 4, bob, cath: msg id 3 bob `send` "> #team @alice (hello) hi alic" bob <# "#team > alice hello!" bob <## " hi alic" @@ -976,12 +978,12 @@ testGroupMessageDelete = bob #$> ("/_get chat #1 count=100", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))]) cath #$> ("/_get chat #1 count=100", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))]) - alice #$> ("/_delete item #1 1 broadcast", id, "message deleted") + alice #$> ("/_delete item #1 3 broadcast", id, "message deleted") concurrently_ (bob <# "#team alice> [deleted] hello!") (cath <# "#team alice> [deleted] hello!") - alice #$> ("/_delete item #1 2 internal", id, "message deleted") + alice #$> ("/_delete item #1 4 internal", id, "message deleted") alice #$> ("/_get chat #1 count=100", chat', []) bob #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alic"), Just (0, "hello!"))]) @@ -1000,7 +1002,7 @@ testGroupMessageDelete = cath #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))]) threadDelay 1000000 - -- alice: msg id 3, bob, cath: msg id 4 + -- alice: msg id 5, bob, cath: msg id 4 cath #> "#team how are you?" concurrently_ (alice <# "#team cath> how are you?") @@ -1011,8 +1013,8 @@ testGroupMessageDelete = (alice <# "#team cath> [deleted] how are you?") (bob <# "#team cath> [deleted] how are you?") - alice #$> ("/_delete item #1 2 broadcast", id, "cannot delete this item") - alice #$> ("/_delete item #1 2 internal", id, "message deleted") + alice #$> ("/_delete item #1 4 broadcast", id, "cannot delete this item") + alice #$> ("/_delete item #1 4 internal", id, "message deleted") alice #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing)]) bob #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "this item is deleted (broadcast)"), Nothing)]) @@ -1020,6 +1022,7 @@ testGroupMessageDelete = testGroupAsync :: IO () testGroupAsync = withTmpFiles $ do + print (0 :: Integer) withNewTestChat "alice" aliceProfile $ \alice -> do withNewTestChat "bob" bobProfile $ \bob -> do connectUsers alice bob @@ -1039,6 +1042,7 @@ testGroupAsync = withTmpFiles $ do (bob <## "#team: you joined the group") alice #> "#team hello bob" bob <# "#team alice> hello bob" + print (1 :: Integer) withTestChat "alice" $ \alice -> do withNewTestChat "cath" cathProfile $ \cath -> do alice <## "1 contacts connected (use /cs for the list)" @@ -1058,6 +1062,7 @@ testGroupAsync = withTmpFiles $ do ] alice #> "#team hello cath" cath <# "#team alice> hello cath" + print (2 :: Integer) withTestChat "bob" $ \bob -> do withTestChat "cath" $ \cath -> do concurrentlyN_ @@ -1072,6 +1077,7 @@ testGroupAsync = withTmpFiles $ do cath <## "#team: connected to server(s)" cath <## "#team: member bob (Bob) is connected" ] + print (3 :: Integer) withTestChat "bob" $ \bob -> do withNewTestChat "dan" danProfile $ \dan -> do bob <## "2 contacts connected (use /cs for the list)" @@ -1089,6 +1095,7 @@ testGroupAsync = withTmpFiles $ do [ bob <## "#team: dan joined the group", dan <## "#team: you joined the group" ] + print (4 :: Integer) withTestChat "alice" $ \alice -> do withTestChat "cath" $ \cath -> do withTestChat "dan" $ \dan -> do @@ -1109,6 +1116,7 @@ testGroupAsync = withTmpFiles $ do dan <## "#team: member alice (Alice) is connected" dan <## "#team: member cath (Catherine) is connected" ] + print (5 :: Integer) withTestChat "alice" $ \alice -> do withTestChat "bob" $ \bob -> do withTestChat "cath" $ \cath -> do @@ -1653,7 +1661,7 @@ testGroupSendImageWithTextAndQuote = (alice <# "#team bob> hi team") (cath <# "#team bob> hi team") threadDelay 1000000 - alice ##> "/_send #1 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": 1, \"msgContent\": {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}" + alice ##> "/_send #1 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": 3, \"msgContent\": {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}" alice <# "#team > bob hi team" alice <## " hey bob" alice <# "/f #team ./tests/fixtures/test.jpg" @@ -1696,11 +1704,11 @@ testGroupSendImageWithTextAndQuote = dest2 <- B.readFile "./tests/tmp/test_1.jpg" dest2 `shouldBe` src alice #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")]) - alice @@@ [("#team", "hey bob"), ("@bob", ""), ("@cath", "")] + alice @@@ [("#team", "hey bob"), ("@bob", "sent invitation to join group team as admin"), ("@cath", "sent invitation to join group team as admin")] bob #$> ("/_get chat #1 count=100", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")]) - bob @@@ [("#team", "hey bob"), ("@cath",""), ("@alice","invitation to join group team as admin")] + bob @@@ [("#team", "hey bob"), ("@alice","received invitation to join group team as admin")] cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")]) - cath @@@ [("#team", "hey bob"), ("@bob",""), ("@alice","invitation to join group team as admin")] + cath @@@ [("#team", "hey bob"), ("@alice","received invitation to join group team as admin")] testUserContactLink :: Spec testUserContactLink = versionTestMatrix3 $ \alice bob cath -> do