From 1bfa7f1104f88e0deb601c96281e294c075634b3 Mon Sep 17 00:00:00 2001 From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Date: Thu, 6 Jan 2022 23:39:58 +0400 Subject: [PATCH] allow to repeat group invitation using saved queue info; recognize it's the same group at invitee (#176) * naming; full names on start for groups * allow to re-add member * save and reuse connection request * TODO * wording * index * user id * revert to listToMaybe . map fromOnly * add to test * fix null conversion * Update src/Simplex/Chat.hs Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> * Update src/Simplex/Chat.hs * fix Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> --- .../20220106_group_members_inv_queue_info.sql | 3 + src/Simplex/Chat.hs | 34 ++++++---- src/Simplex/Chat/Store.hs | 64 +++++++++++++------ src/Simplex/Chat/View.hs | 42 +++++++----- tests/ChatTests.hs | 45 +++++++++++-- 5 files changed, 133 insertions(+), 55 deletions(-) create mode 100644 migrations/20220106_group_members_inv_queue_info.sql diff --git a/migrations/20220106_group_members_inv_queue_info.sql b/migrations/20220106_group_members_inv_queue_info.sql new file mode 100644 index 000000000..17f4f88f5 --- /dev/null +++ b/migrations/20220106_group_members_inv_queue_info.sql @@ -0,0 +1,3 @@ +ALTER TABLE group_members ADD inv_queue_info BLOB; + +CREATE INDEX idx_groups_inv_queue_info ON groups (inv_queue_info); diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 14b8b5eb6..3e897fdbd 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -258,14 +258,24 @@ processChatCommand user@User {userId, profile} = \case when (userRole < GRAdmin || userRole < memRole) $ chatError CEGroupUserRole when (memberStatus membership == GSMemInvited) $ chatError (CEGroupNotJoined gName) unless (memberActive membership) $ chatError CEGroupMemberNotActive - when (isJust $ contactMember contact members) $ chatError (CEGroupDuplicateMember cName) - gVar <- asks idsDrg - (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation) - GroupMember {memberId} <- withStore $ \st -> createContactGroupMember st gVar user groupId contact memRole agentConnId - let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile - sendDirectMessage (contactConn contact) msg - showSentGroupInvitation gName cName - setActive $ ActiveG gName + case contactMember contact members of + Nothing -> do + gVar <- asks idsDrg + (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation) + GroupMember {memberId} <- withStore $ \st -> createContactGroupMemberWithInvitation st gVar user groupId contact memRole agentConnId cReq + sendInvitation contact userMemberId userRole memberId groupProfile cReq + Just GroupMember {groupMemberId, memberId, memberStatus} + | memberStatus == GSMemInvited -> + withStore (\st -> getContactGroupMemberInvitation st user groupMemberId) >>= \case + Just cReq -> sendInvitation contact userMemberId userRole memberId groupProfile cReq + Nothing -> showCannotResendInvitation gName cName + | otherwise -> chatError (CEGroupDuplicateMember cName) + where + sendInvitation contact userMemberId userRole memberId groupProfile cReq = do + let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile + sendDirectMessage (contactConn contact) msg + showSentGroupInvitation gName cName + setActive $ ActiveG gName JoinGroup gName -> do ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember @@ -447,17 +457,17 @@ subscribeUserConnections = void . runExceptT $ do forM_ groups $ \g@Group {members, membership, localDisplayName = gn} -> do let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members if memberStatus membership == GSMemInvited - then showUnprocessedGroupInvitation g + then showGroupInvitation g else if null connectedMembers then if memberActive membership - then showGroupEmpty gn - else showGroupRemoved gn + then showGroupEmpty g + else showGroupRemoved g else do forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) -> subscribe cId `catchError` showMemberSubError gn c - showGroupSubscribed gn + showGroupSubscribed g subscribeFiles user = do withStore (`getLiveSndFileTransfers` user) >>= mapM_ subscribeSndFile withStore (`getLiveRcvFileTransfers` user) >>= mapM_ subscribeRcvFile diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 4a09acb2d..3454154cf 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -51,7 +51,8 @@ module Simplex.Chat.Store getUserGroups, getUserGroupDetails, getGroupInvitation, - createContactGroupMember, + createContactGroupMemberWithInvitation, + getContactGroupMemberInvitation, createMemberConnection, updateGroupMemberStatus, createNewGroupMember, @@ -891,21 +892,31 @@ createNewGroup st gVar user groupProfile = membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership} --- | creates a new group record for the group the current user was invited to +-- | creates a new group record for the group the current user was invited to, or returns an existing one createGroupInvitation :: StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m Group -createGroupInvitation st user contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} = +createGroupInvitation st user@User {userId} contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} = liftIOEither . withTransaction st $ \db -> do - let GroupProfile {displayName, fullName} = groupProfile - uId = userId user - withLocalDisplayName db uId displayName $ \localDisplayName -> do - DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName) - profileId <- insertedRowId db - DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, uId) - groupId <- insertedRowId db - member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown - membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact) - pure Group {groupId, localDisplayName, groupProfile, members = [member], membership} + getGroupInvitationLdn_ db >>= \case + Nothing -> createGroupInvitation_ db + -- TODO treat the case that the invitation details could've changed + Just localDisplayName -> runExceptT $ fst <$> getGroup_ db user localDisplayName + where + getGroupInvitationLdn_ :: DB.Connection -> IO (Maybe GroupName) + getGroupInvitationLdn_ db = + listToMaybe . map fromOnly + <$> DB.query db "SELECT local_display_name FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1;" (connRequest, userId) + createGroupInvitation_ :: DB.Connection -> IO (Either StoreError Group) + createGroupInvitation_ db = do + let GroupProfile {displayName, fullName} = groupProfile + withLocalDisplayName db userId displayName $ \localDisplayName -> do + DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName) + profileId <- insertedRowId db + DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, userId) + groupId <- insertedRowId db + member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown + membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact) + pure Group {groupId, localDisplayName, groupProfile, members = [member], membership} -- TODO return the last connection that is ready, not any last connection -- requires updating connection status @@ -974,6 +985,7 @@ deleteGroup st User {userId} Group {groupId, members, localDisplayName} = 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 "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId) + -- TODO ? delete group profile DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) getUserGroups :: MonadUnliftIO m => SQLiteStore -> User -> m [Group] @@ -1019,15 +1031,20 @@ toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, membe activeConn = Nothing in GroupMember {..} -createContactGroupMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> m GroupMember -createContactGroupMember st gVar user groupId contact memberRole agentConnId = +createContactGroupMemberWithInvitation :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User -> Int64 -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> m GroupMember +createContactGroupMemberWithInvitation st gVar user groupId contact memberRole agentConnId connRequest = liftIOEither . withTransaction st $ \db -> createWithRandomId gVar $ \memId -> do - member <- createContactMember_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser - groupMemberId <- insertedRowId db + member@GroupMember {groupMemberId} <- createContactMemberWithInvitation_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest) void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0 pure member +getContactGroupMemberInvitation :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Maybe ConnReqInvitation) +getContactGroupMemberInvitation st User {userId} groupMemberId = + liftIO . withTransaction st $ \db -> + join . listToMaybe . map fromOnly + <$> DB.query db "SELECT inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId) + createMemberConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> ConnId -> m () createMemberConnection st userId GroupMember {groupMemberId} agentConnId = liftIO . withTransaction st $ \db -> @@ -1253,7 +1270,11 @@ createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe I createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId) createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember -createContactMember_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = do +createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = + createContactMemberWithInvitation_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing + +createContactMemberWithInvitation_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember +createContactMemberWithInvitation_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do insertMember_ groupMemberId <- insertedRowId db let memberProfile = profile' userOrContact @@ -1268,12 +1289,12 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb [sql| INSERT INTO group_members ( group_id, member_id, member_role, member_category, member_status, invited_by, - user_id, local_display_name, contact_profile_id, contact_id) + user_id, local_display_name, contact_profile_id, contact_id, inv_queue_info) VALUES (:group_id,:member_id,:member_role,:member_category,:member_status,:invited_by, :user_id,:local_display_name, (SELECT contact_profile_id FROM contacts WHERE contact_id = :contact_id), - :contact_id) + :contact_id, :inv_queue_info) |] [ ":group_id" := groupId, ":member_id" := memberId, @@ -1283,7 +1304,8 @@ createContactMember_ db User {userId, userContactId} groupId userOrContact (memb ":invited_by" := fromInvitedBy userContactId invitedBy, ":user_id" := userId, ":local_display_name" := localDisplayName' userOrContact, - ":contact_id" := contactId' userOrContact + ":contact_id" := contactId' userOrContact, + ":inv_queue_info" := connRequest ] getViaGroupMember :: MonadUnliftIO m => SQLiteStore -> User -> Contact -> m (Maybe (GroupName, GroupMember)) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 68cf7bc22..fa2220f82 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -31,7 +31,7 @@ module Simplex.Chat.View showGroupSubscribed, showGroupEmpty, showGroupRemoved, - showUnprocessedGroupInvitation, + showGroupInvitation, showMemberSubError, showReceivedMessage, showReceivedGroupMessage, @@ -58,6 +58,7 @@ module Simplex.Chat.View showGroupDeletedUser, showGroupDeleted, showSentGroupInvitation, + showCannotResendInvitation, showReceivedGroupInvitation, showJoinedGroupMember, showUserJoinedGroup, @@ -175,18 +176,18 @@ showUserContactLinkSubscribed = printToView ["Your address is active! To show: " showUserContactLinkSubError :: ChatReader m => ChatError -> m () showUserContactLinkSubError = printToView . userContactLinkSubError -showGroupSubscribed :: ChatReader m => GroupName -> m () +showGroupSubscribed :: ChatReader m => Group -> m () showGroupSubscribed = printToView . groupSubscribed -showGroupEmpty :: ChatReader m => GroupName -> m () +showGroupEmpty :: ChatReader m => Group -> m () showGroupEmpty = printToView . groupEmpty -showGroupRemoved :: ChatReader m => GroupName -> m () +showGroupRemoved :: ChatReader m => Group -> m () showGroupRemoved = printToView . groupRemoved -showUnprocessedGroupInvitation :: ChatReader m => Group -> m () -showUnprocessedGroupInvitation Group {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} = - printToView [unprocessedGroupInvitation ldn fullName] +showGroupInvitation :: ChatReader m => Group -> m () +showGroupInvitation Group {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} = + printToView [groupInvitation ldn fullName] showMemberSubError :: ChatReader m => GroupName -> ContactName -> ChatError -> m () showMemberSubError = printToView .:. memberSubError @@ -272,6 +273,9 @@ showGroupDeleted = printToView .: groupDeleted showSentGroupInvitation :: ChatReader m => GroupName -> ContactName -> m () showSentGroupInvitation = printToView .: sentGroupInvitation +showCannotResendInvitation :: ChatReader m => GroupName -> ContactName -> m () +showCannotResendInvitation = printToView .: cannotResendInvitation + showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> GroupMemberRole -> m () showReceivedGroupInvitation = printToView .:. receivedGroupInvitation @@ -402,14 +406,14 @@ userContactLinkSubError e = "to delete your address: " <> highlight' "/da" ] -groupSubscribed :: GroupName -> [StyledString] -groupSubscribed g = [ttyGroup g <> ": connected to server(s)"] +groupSubscribed :: Group -> [StyledString] +groupSubscribed g = [ttyFullGroup g <> ": connected to server(s)"] -groupEmpty :: GroupName -> [StyledString] -groupEmpty g = [ttyGroup g <> ": group is empty"] +groupEmpty :: Group -> [StyledString] +groupEmpty g = [ttyFullGroup g <> ": group is empty"] -groupRemoved :: GroupName -> [StyledString] -groupRemoved g = [ttyGroup g <> ": you are no longer a member or group deleted"] +groupRemoved :: Group -> [StyledString] +groupRemoved g = [ttyFullGroup g <> ": you are no longer a member or group deleted"] memberSubError :: GroupName -> ContactName -> ChatError -> [StyledString] memberSubError g c e = [ttyGroup g <> " member " <> ttyContact c <> " error: " <> sShow e] @@ -432,6 +436,12 @@ groupDeleted_ g m = [ttyGroup g <> ": " <> memberOrUser m <> " deleted the group sentGroupInvitation :: GroupName -> ContactName -> [StyledString] sentGroupInvitation g c = ["invitation to join the group " <> ttyGroup g <> " sent to " <> ttyContact c] +cannotResendInvitation :: GroupName -> ContactName -> [StyledString] +cannotResendInvitation g c = + [ ttyContact c <> " is already invited to group " <> ttyGroup g, + "to re-send invitation: " <> highlight ("/rm " <> g <> " " <> c) <> ", " <> highlight ("/a " <> g <> " " <> c) + ] + receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString] receivedGroupInvitation g@Group {localDisplayName} c role = [ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (serializeMemberRole role), @@ -501,11 +511,11 @@ groupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString] groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g "] groupsList gs = map groupSS $ sort gs where - groupSS (displayName, fullName, GSMemInvited) = unprocessedGroupInvitation displayName fullName + groupSS (displayName, fullName, GSMemInvited) = groupInvitation displayName fullName groupSS (displayName, fullName, _) = ttyGroup displayName <> optFullName displayName fullName -unprocessedGroupInvitation :: GroupName -> Text -> StyledString -unprocessedGroupInvitation 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 4a4300850..dfbc9ebcc 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -38,7 +38,9 @@ chatTests = do it "create and join group with 4 members" testGroup2 it "create and delete group" testGroupDelete it "invitee delete group when in status invited" testGroupDeleteWhenInvited + it "re-add member in status invited" testGroupReAddInvited it "remove contact from group and add again" testGroupRemoveAdd + it "list groups containing group invitations" testGroupList describe "user profiles" $ it "update user profiles and notify contacts" testUpdateProfile describe "sending and receiving files" $ do @@ -354,12 +356,8 @@ testGroupDeleteWhenInvited = ] bob ##> "/d #team" bob <## "#team: you deleted the group" - -- alice shouldn't receive notification that bob deleted group, - -- but she should be able to remove and re-add bob - alice ##> "/a team bob" - alice <## "contact bob is already in the group" - alice ##> "/rm team bob" - alice <## "#team: you removed bob from the group" + -- alice doesn't receive notification that bob deleted group, + -- but she can re-add bob alice ##> "/a team bob" concurrentlyN_ [ alice <## "invitation to join the group #team sent to bob", @@ -368,6 +366,41 @@ testGroupDeleteWhenInvited = bob <## "use /j team to accept" ] +testGroupReAddInvited :: IO () +testGroupReAddInvited = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice ##> "/g team" + alice <## "group #team is created" + alice <## "use /a team to add members" + alice ##> "/a team bob" + concurrentlyN_ + [ alice <## "invitation to join the group #team sent to bob", + do + bob <## "#team: alice invites you to join the group as admin" + bob <## "use /j team to accept" + ] + -- alice re-adds bob, he sees it as the same group + alice ##> "/a team bob" + concurrentlyN_ + [ alice <## "invitation to join the group #team sent to bob", + do + bob <## "#team: alice invites you to join the group as admin" + bob <## "use /j team to accept" + ] + -- if alice removes bob and then re-adds him, she uses a new connection request + -- and he sees it as a new group with a different local display name + alice ##> "/rm team bob" + alice <## "#team: you removed bob from the group" + alice ##> "/a team bob" + concurrentlyN_ + [ alice <## "invitation to join the group #team sent to bob", + do + bob <## "#team_1 (team): alice invites you to join the group as admin" + bob <## "use /j team_1 to accept" + ] + testGroupRemoveAdd :: IO () testGroupRemoveAdd = testChat3 aliceProfile bobProfile cathProfile $