From 98850917d7ee44ff4e4694d59193f50d65fd1d75 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 11 Aug 2026 07:18:59 +0000 Subject: [PATCH] directory: fix search cursor (#7361) --- .../src/Directory/Search.hs | 11 +++- .../src/Directory/Service.hs | 13 ++-- .../src/Directory/Store.hs | 43 +++++++------ tests/Bots/DirectoryTests.hs | 63 +++++++++++++++++++ 4 files changed, 103 insertions(+), 27 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Search.hs b/apps/simplex-directory-service/src/Directory/Search.hs index d71c128370..99e449d0ff 100644 --- a/apps/simplex-directory-service/src/Directory/Search.hs +++ b/apps/simplex-directory-service/src/Directory/Search.hs @@ -1,5 +1,6 @@ module Directory.Search where +import Data.Int (Int64) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Simplex.Chat.Types @@ -7,7 +8,15 @@ import Simplex.Chat.Types data SearchRequest = SearchRequest { searchType :: SearchType, searchTime :: UTCTime, - lastGroup :: GroupId -- cursor for search + searchCursor :: SearchCursor + } + +-- Position of the last sent row in the sort order of its search type. Each mode +-- reads the value it sorts by; the group ID breaks ties, as neither sort key is unique. +data SearchCursor = SearchCursor + { lastMembers :: Int64, + lastCreatedAt :: UTCTime, + lastGroupId :: GroupId } data SearchType = STAll | STRecent | STSearch Text diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 7dc165c4df..6b850e71c5 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -1126,14 +1126,14 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o isGroupLink _ = False DCSearchNext -> atomically (TM.lookup (contactId' ct) searchRequests) >>= \case - Just SearchRequest {searchType, searchTime, lastGroup} -> do + Just SearchRequest {searchType, searchTime, searchCursor} -> do currentTime <- getCurrentTime if diffUTCTime currentTime searchTime > 300 -- 5 minutes then do atomically $ TM.delete (contactId' ct) searchRequests showAllGroups else - sendFoundListedGroups searchType (Just lastGroup) "No more groups" $ \gs _ -> + sendFoundListedGroups searchType (Just searchCursor) "No more groups" $ \gs _ -> "Sending " <> tshow (length gs) <> " more group(s)." Nothing -> showAllGroups where @@ -1280,8 +1280,8 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o | maybe True (displayName ==) gName_ -> action g gr | otherwise -> sendReply $ "Group ID " <> tshow ugrId <> " has the display name " <> displayName sendReply = mkSendReply ct ciId - sendFoundListedGroups searchType lastGroup_ notFound replyStr = - searchListedGroups cc user searchType lastGroup_ searchResults >>= \case + sendFoundListedGroups searchType cursor_ notFound replyStr = + searchListedGroups cc user searchType cursor_ searchResults >>= \case Right ([], _) -> do atomically $ TM.delete (contactId' ct) searchRequests sendReply notFound @@ -1294,9 +1294,10 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o let more = if n > length gs then ", sending " <> sortName <> " " <> tshow (length gs) else "" in tshow n <> " group(s) listed" <> more <> "." updateSearchRequest :: SearchType -> (GroupInfo, GroupReg) -> IO () - updateSearchRequest searchType (GroupInfo {groupId}, _) = do + updateSearchRequest searchType (GroupInfo {groupId, groupSummary = GroupSummary {currentMembers}}, GroupReg {createdAt}) = do searchTime <- getCurrentTime - let search = SearchRequest {searchType, searchTime, lastGroup = groupId} + let searchCursor = SearchCursor {lastMembers = currentMembers, lastCreatedAt = createdAt, lastGroupId = groupId} + search = SearchRequest {searchType, searchTime, searchCursor} atomically $ TM.insert (contactId' ct) search searchRequests sendFoundGroups reply gs moreGroups = void . forkIO $ sendComposedMessages_ cc (SRDirect $ contactId' ct) msgs diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs index 94375eb025..0be86b6498 100644 --- a/apps/simplex-directory-service/src/Directory/Store.hs +++ b/apps/simplex-directory-service/src/Directory/Store.hs @@ -340,43 +340,41 @@ getAllListedGroups_ db cxt user@User {userId, userContactId} = do where withGroupLink (g, gr) = (g,gr,) . eitherToMaybe <$> runExceptT (getGroupLink db user g) -searchListedGroups :: ChatController -> User -> SearchType -> Maybe GroupId -> Int -> IO (Either String ([(GroupInfo, GroupReg)], Int)) -searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pageSize = +searchListedGroups :: ChatController -> User -> SearchType -> Maybe SearchCursor -> Int -> IO (Either String ([(GroupInfo, GroupReg)], Int)) +searchListedGroups cc user@User {userId, userContactId} searchType cursor_ pageSize = withDB' "searchListedGroups" cc $ \db -> do currentTs <- getCurrentTime case searchType of - STAll -> case lastGroup_ of + STAll -> case cursor_ of Nothing -> do - gs <- groups currentTs $ DB.query db (listedGroupQuery <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, pageSize) + gs <- groups currentTs $ DB.query db (listedGroupQuery <> membersOrderBy <> " LIMIT ?") (userId, userContactId, GRSActive, pageSize) n <- count $ DB.query db countQuery' (Only GRSActive) pure (gs, n) - Just gId -> do - gs <- groups currentTs $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, gId, pageSize) - n <- count $ DB.query db (countQuery' <> " AND r.group_id > ?") (GRSActive, gId) + Just SearchCursor {lastMembers, lastGroupId} -> do + gs <- groups currentTs $ DB.query db (listedGroupQuery <> membersCond <> membersOrderBy <> " LIMIT ?") (userId, userContactId, GRSActive, lastMembers, lastMembers, lastGroupId, pageSize) + n <- count $ DB.query db (countQuery' <> membersCond) (GRSActive, lastMembers, lastMembers, lastGroupId) pure (gs, n) where countQuery' = countQuery <> " WHERE r.group_reg_status = ? " - orderBy = " ORDER BY g.summary_current_members_count DESC, r.group_reg_id ASC " - STRecent -> case lastGroup_ of + STRecent -> case cursor_ of Nothing -> do - gs <- groups currentTs $ DB.query db (listedGroupQuery <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, pageSize) + gs <- groups currentTs $ DB.query db (listedGroupQuery <> recentOrderBy <> " LIMIT ?") (userId, userContactId, GRSActive, pageSize) n <- count $ DB.query db countQuery' (Only GRSActive) pure (gs, n) - Just gId -> do - gs <- groups currentTs $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, gId, pageSize) - n <- count $ DB.query db (countQuery' <> " AND r.group_id > ?") (GRSActive, gId) + Just SearchCursor {lastCreatedAt, lastGroupId} -> do + gs <- groups currentTs $ DB.query db (listedGroupQuery <> recentCond <> recentOrderBy <> " LIMIT ?") (userId, userContactId, GRSActive, lastCreatedAt, lastCreatedAt, lastGroupId, pageSize) + n <- count $ DB.query db (countQuery' <> recentCond) (GRSActive, lastCreatedAt, lastCreatedAt, lastGroupId) pure (gs, n) where countQuery' = countQuery <> " WHERE r.group_reg_status = ? " - orderBy = " ORDER BY r.created_at DESC, r.group_reg_id ASC " - STSearch search -> case lastGroup_ of + STSearch search -> case cursor_ of Nothing -> do - gs <- groups currentTs $ DB.query db (listedGroupQuery <> searchCond <> orderBy <> " LIMIT ?") ((userId, userContactId, GRSActive, s, s, s, s) :. (sDomain, pageSize)) + gs <- groups currentTs $ DB.query db (listedGroupQuery <> searchCond <> membersOrderBy <> " LIMIT ?") ((userId, userContactId, GRSActive, s, s, s, s) :. (sDomain, pageSize)) n <- count $ DB.query db (countQuery' <> searchCond) (GRSActive, s, s, s, s, sDomain) pure (gs, n) - Just gId -> do - gs <- groups currentTs $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> searchCond <> orderBy <> " LIMIT ?") ((userId, userContactId, GRSActive, gId, s, s, s, s) :. (sDomain, pageSize)) - n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> searchCond) (GRSActive, gId, s, s, s, s, sDomain) + Just SearchCursor {lastMembers, lastGroupId} -> do + gs <- groups currentTs $ DB.query db (listedGroupQuery <> membersCond <> searchCond <> membersOrderBy <> " LIMIT ?") ((userId, userContactId, GRSActive, lastMembers, lastMembers, lastGroupId) :. (s, s, s, s, sDomain, pageSize)) + n <- count $ DB.query db (countQuery' <> membersCond <> searchCond) ((GRSActive, lastMembers, lastMembers, lastGroupId) :. (s, s, s, s, sDomain)) pure (gs, n) where s = T.toLower search @@ -385,12 +383,17 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa Just (c, rest) | c == '#' || c == '@' -> if T.null rest then "#" else rest _ -> s countQuery' = countQuery <> " JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE r.group_reg_status = ? " - orderBy = " ORDER BY g.summary_current_members_count DESC, r.group_reg_id ASC " where groups currentTs = (map (toGroupInfoReg currentTs (storeCxt cc) user) <$>) count = maybeFirstRow' 0 fromOnly listedGroupQuery = groupReqQuery <> " AND r.group_reg_status = ? " countQuery = "SELECT COUNT(1) FROM groups g JOIN sx_directory_group_regs r ON g.group_id = r.group_id " + -- the cursor conditions must stay paired with the order by of the same sort key: + -- paging by any other column skips and repeats rows + membersOrderBy = " ORDER BY g.summary_current_members_count DESC, r.group_id ASC " + membersCond = " AND (g.summary_current_members_count < ? OR (g.summary_current_members_count = ? AND r.group_id > ?)) " + recentOrderBy = " ORDER BY r.created_at DESC, r.group_id ASC " + recentCond = " AND (r.created_at < ? OR (r.created_at = ? AND r.group_id > ?)) " searchCond = [sql| AND (LOWER(gp.display_name) LIKE '%' || ? || '%' diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index ad5fb6c8a4..eff5b4e0aa 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -44,6 +44,7 @@ directoryServiceTests = do it "should join found group via link" testJoinGroup it "should support group names with spaces" testGroupNameWithSpaces it "should return more groups in search, all and recent groups" testSearchGroups + it "should page from the sort key, not group ID" testSearchGroupsPaging it "should invite to owners' group if specified" testInviteToOwnersGroup it "should re-invite owner who left owners' group" testInviteOwnerAfterLeavingOwnersGroup describe "de-listing the group" $ do @@ -588,6 +589,68 @@ testSearchGroups ps = u <##. "Link to join the group " u <## (show count <> " members") +-- Paging must continue from the sort key, not from group_id: here the last registered +-- group has the most members, so it sorts first, and a group_id cursor would send it again. +testSearchGroupsPaging :: HasCallStack => TestParams -> IO () +testSearchGroupsPaging ps = + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> do + withNewTestChat ps "cath" cathProfile $ \cath -> do + bob `connectVia` dsLink + cath `connectVia` dsLink + forM_ [1 .. 4 :: Int] $ \i -> registerGroupId superUser bob (groups !! (i - 1)) "" i i + connectUsers bob cath + fullAddMember "groupD" "" bob cath GRMember + joinGroup "groupD" cath bob + cath <## "#groupD: member 'SimpleX Directory_1' is connected" + cath <## "contact and member are merged: 'SimpleX Directory', #groupD 'SimpleX Directory_1'" + cath <## "use @'SimpleX Directory' to send messages" + -- /all: members desc, so groupD (3) precedes the groups registered before it + cath #> "@'SimpleX Directory' /all" + cath <# "'SimpleX Directory'> > /all" + cath <## " 4 group(s) listed, sending top 3." + receivedGroup cath 3 3 + receivedGroup cath 0 2 + receivedGroup cath 1 2 + cath <# "'SimpleX Directory'> Send /next for 1 more result(s)." + cath #> "@'SimpleX Directory' /next" + cath <# "'SimpleX Directory'> > /next" + cath <## " Sending 1 more group(s)." + receivedGroup cath 2 2 + -- /new: created_at desc, in reverse registration order + cath #> "@'SimpleX Directory' /new" + cath <# "'SimpleX Directory'> > /new" + cath <## " 4 group(s) listed, sending the most recent 3." + receivedGroup cath 3 3 + receivedGroup cath 2 2 + receivedGroup cath 1 2 + cath <# "'SimpleX Directory'> Send /next for 1 more result(s)." + cath #> "@'SimpleX Directory' /next" + cath <# "'SimpleX Directory'> > /next" + cath <## " Sending 1 more group(s)." + receivedGroup cath 0 2 + -- text search sorts as /all does + cath #> "@'SimpleX Directory' group" + cath <# "'SimpleX Directory'> > group" + cath <## " Found 4 group(s), sending top 3." + receivedGroup cath 3 3 + receivedGroup cath 0 2 + receivedGroup cath 1 2 + cath <# "'SimpleX Directory'> Send /next for 1 more result(s)." + cath #> "@'SimpleX Directory' /next" + cath <# "'SimpleX Directory'> > /next" + cath <## " Sending 1 more group(s)." + receivedGroup cath 2 2 + where + groups :: [String] + groups = ["groupA", "groupB", "groupC", "groupD"] + receivedGroup :: TestCC -> Int -> Int -> IO () + receivedGroup u ix count = do + u <#. ("'SimpleX Directory'> " <> groups !! ix) + u <## "Welcome message:" + u <##. "Link to join the group " + u <## (show count <> " members") + testInviteToOwnersGroup :: HasCallStack => TestParams -> IO () testInviteToOwnersGroup ps = withDirectoryServiceCfgOwnersGroup ps testCfg True Nothing $ \superUser dsLink ->