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>
2026-08-04 15:20:19 +00:00 · 2022-01-06 23:39:58 +04:00
parent 79658b3d8d
commit 1bfa7f1104
5 changed files with 133 additions and 55 deletions
@@ -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);
@@ -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
@@ -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))
@@ -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 <name>"]
 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 ("
@@ -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 <name> 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 $