diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 699f66f0e..d6635da38 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -305,7 +305,7 @@ processChatCommand user@User {userId, profile} = \case ListMembers gName -> do group <- withStore $ \st -> getGroup st user gName showGroupMembers group - ListGroups -> withStore (`getUserGroupNames` userId) >>= showGroupsList + ListGroups -> withStore (`getUserGroupDetails` userId) >>= showGroupsList SendGroupMessage gName msg -> do -- TODO save pending message delivery for members without connections Group {members, membership} <- withStore $ \st -> getGroup st user gName @@ -446,15 +446,18 @@ subscribeUserConnections = void . runExceptT $ do groups <- withStore (`getUserGroups` user) forM_ groups $ \Group {members, membership, localDisplayName = g} -> do let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members - if null connectedMembers - then - if memberActive membership - then showGroupEmpty g - else showGroupRemoved g - else do - forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) -> - subscribe cId `catchError` showMemberSubError g c - showGroupSubscribed g + if memberStatus membership == GSMemInvited + then pure () + else + if null connectedMembers + then + if memberActive membership + then showGroupEmpty g + else showGroupRemoved g + else do + forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) -> + subscribe cId `catchError` showMemberSubError g c + 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 4458c5e61..4a09acb2d 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -49,7 +49,7 @@ module Simplex.Chat.Store getGroup, deleteGroup, getUserGroups, - getUserGroupNames, + getUserGroupDetails, getGroupInvitation, createContactGroupMember, createMemberConnection, @@ -982,16 +982,17 @@ getUserGroups st user@User {userId} = groupNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM groups WHERE user_id = ?" (Only userId) map fst . rights <$> mapM (runExceptT . getGroup_ db user) groupNames -getUserGroupNames :: MonadUnliftIO m => SQLiteStore -> UserId -> m [(GroupName, Text)] -getUserGroupNames st userId = +getUserGroupDetails :: MonadUnliftIO m => SQLiteStore -> UserId -> m [(GroupName, Text, GroupMemberStatus)] +getUserGroupDetails st userId = liftIO . withTransaction st $ \db -> DB.query db [sql| - SELECT g.local_display_name, p.full_name + SELECT g.local_display_name, p.full_name, m.member_status FROM groups g JOIN group_profiles p USING (group_profile_id) - WHERE g.user_id = ? + JOIN group_members m USING (group_id) + WHERE g.user_id = ? AND m.member_category = 'user' |] (Only userId) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 3367d130d..0ee6fd8d3 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -297,7 +297,7 @@ showLeftMember = printToView .: leftMember showGroupMembers :: ChatReader m => Group -> m () showGroupMembers = printToView . groupMembers -showGroupsList :: ChatReader m => [(GroupName, Text)] -> m () +showGroupsList :: ChatReader m => [(GroupName, Text, GroupMemberStatus)] -> m () showGroupsList = printToView . groupsList showContactsMerged :: ChatReader m => Contact -> Contact -> m () @@ -492,11 +492,19 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov GSMemCreator -> "created group" _ -> "" -groupsList :: [(GroupName, Text)] -> [StyledString] +groupsList :: [(GroupName, Text, GroupMemberStatus)] -> [StyledString] groupsList [] = ["you have no groups!", "to create: " <> highlight' "/g "] groupsList gs = map groupNames $ sort gs where - groupNames (displayName, fullName) = ttyGroup displayName <> optFullName displayName fullName + groupNames (displayName, fullName, GSMemInvited) = + ttyGroup displayName + <> optFullName displayName fullName + <> " - you are invited (" + <> highlight' ("/j " <> T.unpack displayName) + <> " to join, " + <> highlight' ("/d #" <> T.unpack displayName) + <> " to delete invitation)" + groupNames (displayName, fullName, _) = ttyGroup displayName <> optFullName displayName fullName contactsMerged :: Contact -> Contact -> [StyledString] contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} = diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index cb3ae88a6..4a4300850 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -413,6 +413,36 @@ testGroupRemoveAdd = (alice <# "#team cath> hello") (bob <# "#team_1 cath> hello") +testGroupList :: IO () +testGroupList = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + createGroup2 "team" alice bob + alice ##> "/g tennis" + alice <## "group #tennis is created" + alice <## "use /a tennis to add members" + alice ##> "/a tennis bob" + concurrentlyN_ + [ alice <## "invitation to join the group #tennis sent to bob", + do + bob <## "#tennis: alice invites you to join the group as admin" + bob <## "use /j tennis to accept" + ] + -- alice sees both groups + alice ##> "/gs" + alice <### ["#team", "#tennis"] + -- bob sees #tennis as invitation + bob ##> "/gs" + bob + <### [ "#team", + "#tennis - you are invited (/j tennis to join, /d #tennis to delete invitation)" + ] + -- after deleting invitation bob sees only one group + bob ##> "/d #tennis" + bob <## "#tennis: you deleted the group" + bob ##> "/gs" + bob <## "#team" + testUpdateProfile :: IO () testUpdateProfile = testChat3 aliceProfile bobProfile cathProfile $ @@ -685,23 +715,27 @@ showName (TestCC ChatController {currentUser} _ _ _ _) = do User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")" -createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO () -createGroup3 gName cc1 cc2 cc3 = do +createGroup2 :: String -> TestCC -> TestCC -> IO () +createGroup2 gName cc1 cc2 = do connectUsers cc1 cc2 - connectUsers cc1 cc3 name2 <- userName cc2 - name3 <- userName cc3 - sName2 <- showName cc2 - sName3 <- showName cc3 cc1 ##> ("/g " <> gName) cc1 <## ("group #" <> gName <> " is created") cc1 <## ("use /a " <> gName <> " to add members") - addMember cc2 + addMember gName cc1 cc2 cc2 ##> ("/j " <> gName) concurrently_ (cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group")) (cc2 <## ("#" <> gName <> ": you joined the group")) - addMember cc3 + +createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO () +createGroup3 gName cc1 cc2 cc3 = do + createGroup2 gName cc1 cc2 + connectUsers cc1 cc3 + name3 <- userName cc3 + sName2 <- showName cc2 + sName3 <- showName cc3 + addMember gName cc1 cc3 cc3 ##> ("/j " <> gName) concurrentlyN_ [ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"), @@ -712,18 +746,18 @@ createGroup3 gName cc1 cc2 cc3 = do cc2 <## ("#" <> gName <> ": alice added " <> sName3 <> " to the group (connecting...)") cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected") ] - where - addMember :: TestCC -> IO () - addMember mem = do - name1 <- userName cc1 - memName <- userName mem - cc1 ##> ("/a " <> gName <> " " <> memName) - concurrentlyN_ - [ cc1 <## ("invitation to join the group #" <> gName <> " sent to " <> memName), - do - mem <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin") - mem <## ("use /j " <> gName <> " to accept") - ] + +addMember :: String -> TestCC -> TestCC -> IO () +addMember gName inviting invitee = do + name1 <- userName inviting + memName <- userName invitee + inviting ##> ("/a " <> gName <> " " <> memName) + concurrentlyN_ + [ inviting <## ("invitation to join the group #" <> gName <> " sent to " <> memName), + do + invitee <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin") + invitee <## ("use /j " <> gName <> " to accept") + ] -- | test sending direct messages (<##>) :: TestCC -> TestCC -> IO ()