From 148b89d613ae025eabad8e5c2815c9bbfb6d0a7a Mon Sep 17 00:00:00 2001 From: spacedandy-agents-simplex <342056592+spacedandy-agents-simplex@users.noreply.github.com> Date: Tue, 20 Oct 2026 22:36:45 +0000 Subject: [PATCH] directory: send the number of matches left and the page size in search responses The apps' load row says how many results are left. The store already counts the matches from the cursor on; the response now carries moreCount (matches after this page) and pageSize. Old apps ignore the fields. Run: 011-search-redesign, slice 1 --- .../src/Directory/Rpc.hs | 27 ++++++++---- .../src/Directory/Service.hs | 2 +- tests/Bots/DirectoryTests.hs | 43 ++++++++++++------- 3 files changed, 47 insertions(+), 25 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Rpc.hs b/apps/simplex-directory-service/src/Directory/Rpc.hs index b7b11c3563..809f4d78d7 100644 --- a/apps/simplex-directory-service/src/Directory/Rpc.hs +++ b/apps/simplex-directory-service/src/Directory/Rpc.hs @@ -44,7 +44,9 @@ data DirectorySearchEntry = DirectorySearchEntry data DirectoryResponse = DRSearchResults { entries :: [DirectorySearchEntry], - searchCursor :: Maybe SearchCursor -- Nothing when there are no more results + searchCursor :: Maybe SearchCursor, -- Nothing when there are no more results + moreCount :: Int, -- matches after the cursor: they can include listings without a public link, which are not sent + pageSize :: Int } | DRError {errorMessage :: Text} @@ -61,10 +63,11 @@ responseObject resp = case J.toJSON resp of -- Entries are dropped from the end until the response fits, so the cursor must point at the last row -- included, not the last one read. A single entry that still does not fit is skipped, or paging stalls on it. -searchResultsPage :: (row -> SearchCursor) -> Bool -> [(row, Maybe DirectorySearchEntry)] -> DirectoryResponse -searchResultsPage rowCursor storeHasMore rows = fit entryRows +searchResultsPage :: (row -> SearchCursor) -> Int -> Int -> [(row, Maybe DirectorySearchEntry)] -> DirectoryResponse +searchResultsPage rowCursor pageSize matched rows = fit entryRows where - entryRows = [(row, e) | (row, Just e) <- rows] + numbered = [((n, row), e) | (n, (row, e)) <- zip [1 ..] rows] + entryRows = [(row, e) | (row, Just e) <- numbered] fit sent = case page sent of Just resp -> resp Nothing -> case sent of @@ -75,10 +78,18 @@ searchResultsPage rowCursor storeHasMore rows = fit entryRows | otherwise = Nothing where fittedAll = length sent == length entryRows - cursorRow = if fittedAll then fst <$> lastMaybe rows else fst <$> lastMaybe sent - more = not fittedAll || storeHasMore - resp = DRSearchResults {entries = map snd sent, searchCursor = if more then rowCursor <$> cursorRow else Nothing} - skipped row = DRSearchResults {entries = [], searchCursor = Just $ rowCursor row} + cursorRow = if fittedAll then fst <$> lastMaybe numbered else fst <$> lastMaybe sent + more = not fittedAll || matched > length rows + resp = results sent $ if more then cursorRow else Nothing + skipped row = results [] (Just row) + results sent cursorRow = + DRSearchResults + { entries = map snd sent, + searchCursor = rowCursor . snd <$> cursorRow, + -- the count query lacks the listing query's joins, so it can be below the rows read + moreCount = maybe 0 (\(consumed, _) -> max 0 (matched - consumed)) cursorRow, + pageSize + } fits = isRight . compressServiceBody . LB.toStrict . J.encode . responseObject dropImage :: DirectorySearchEntry -> DirectorySearchEntry dropImage e = e {image = Nothing} diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 85ac65b8df..1bad8e4c9a 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -387,7 +387,7 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o Left e -> logError ("searchListedGroups error: " <> T.pack e) $> DRError "search failed" Right (gs, n) -> do now <- getCurrentTime - pure $ searchResultsPage rowCursor (n > length gs) [(row, searchEntry now g gLink_) | row@(g, _, gLink_) <- gs] + pure $ searchResultsPage rowCursor searchResults n [(row, searchEntry now g gLink_) | row@(g, _, gLink_) <- gs] where rowCursor (GroupInfo {groupId, groupSummary = GroupSummary {currentMembers}}, _, _) = SCMembers currentMembers groupId groupLinkText (CCLink cReq sLnk_) = maybe (strEncodeTxt $ simplexChatContact cReq) strEncodeTxt sLnk_ diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index f0ad4b16e7..f2db475d09 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -708,7 +708,7 @@ testDirectorySearchRpc ps = -- the last page carries no cursor, so the client does not spend a round trip finding out resp `shouldNotContain` "searchCursor" cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"search\",\"searchText\":\"nothing matches this\"}") - cath <## "service response: {\"entries\":[],\"type\":\"searchResults\"}" + cath <## "service response: {\"entries\":[],\"moreCount\":0,\"pageSize\":3,\"type\":\"searchResults\"}" cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"nonsense\"}") cath <## "service response: {\"errorMessage\":\"unsupported request\",\"type\":\"error\"}" @@ -720,13 +720,16 @@ testDirectorySearchRpcPaging ps = bob `connectVia` dsShortLink forM_ [1 .. 4 :: Int] $ \i -> registerGroupId superUser bob ("group" <> show i) "" i i withNewTestChat ps "cath" cathProfile $ \cath -> do - (page1, cursor) <- searchNames cath dsShortLink "group" Nothing + (page1, cursor, moreCount1, pageSize1) <- searchNamesCounts cath dsShortLink "group" Nothing page1 `shouldBe` ["group1", "group2", "group3"] + moreCount1 `shouldBe` 1 + pageSize1 `shouldBe` 3 -- anyone can send this request, so the cursor must not reveal when a group was registered maybe "" (LB.unpack . J.encode) cursor `shouldNotContain` "lastCreatedAt" - (page2, cursor') <- searchNames cath dsShortLink "group" cursor + (page2, cursor', moreCount2, _) <- searchNamesCounts cath dsShortLink "group" cursor page2 `shouldBe` ["group4"] cursor' `shouldBe` Nothing + moreCount2 `shouldBe` 0 -- only a forged request pairs text search with a creation-time cursor, and it must not restart from the first page cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"search\",\"searchText\":\"group\",\"searchCursor\":{\"type\":\"recent\",\"lastCreatedAt\":\"2026-01-01T00:00:00Z\",\"lastGroupId\":1}}") cath <## "service response: {\"errorMessage\":\"search failed\",\"type\":\"error\"}" @@ -767,8 +770,8 @@ testDirectorySearchRpcBusy ps = -- Read from the controller, not the terminal: an entry with an image is longer than a terminal -- row, and the test terminal only queues the last row of a line that wrapped. -searchDirectory :: TestCC -> String -> String -> Maybe J.Value -> IO ([DirectorySearchEntry], Maybe J.Value) -searchDirectory TestCC {chatController = cc} dsLink text cursor_ = do +searchDirectoryCounts :: TestCC -> String -> String -> Maybe J.Value -> IO ([DirectorySearchEntry], Maybe J.Value, Int, Int) +searchDirectoryCounts TestCC {chatController = cc} dsLink text cursor_ = do let req = J.object $ ["type" .= ("search" :: String), "searchText" .= text] <> maybe [] (\c -> ["searchCursor" .= c]) cursor_ r <- sendChatCmdStr cc ("/_service_request 1 " <> dsLink <> " " <> LB.unpack (J.encode req)) case r of @@ -776,11 +779,18 @@ searchDirectory TestCC {chatController = cc} dsLink text cursor_ = do maybe (fail $ "unexpected response: " <> LB.unpack (J.encode responseData)) pure $ JT.parseMaybe searchResults responseData _ -> fail $ "service request failed: " <> show r where - searchResults o = (,) <$> o .: "entries" <*> o .:? "searchCursor" + searchResults o = (,,,) <$> o .: "entries" <*> o .:? "searchCursor" <*> o .: "moreCount" <*> o .: "pageSize" + +searchDirectory :: TestCC -> String -> String -> Maybe J.Value -> IO ([DirectorySearchEntry], Maybe J.Value) +searchDirectory u dsLink text cursor_ = (\(es, c, _, _) -> (es, c)) <$> searchDirectoryCounts u dsLink text cursor_ searchNames :: HasCallStack => TestCC -> String -> String -> Maybe J.Value -> IO ([Text], Maybe J.Value) searchNames u dsLink text cursor_ = first (map entryName) <$> searchDirectory u dsLink text cursor_ +-- the page's names and cursor, then its moreCount and pageSize +searchNamesCounts :: TestCC -> String -> String -> Maybe J.Value -> IO ([Text], Maybe J.Value, Int, Int) +searchNamesCounts u dsLink text cursor_ = (\(es, c, m, s) -> (map entryName es, c, m, s)) <$> searchDirectoryCounts u dsLink text cursor_ + entryName :: DirectorySearchEntry -> Text entryName DirectorySearchEntry {displayName} = displayName @@ -869,9 +879,10 @@ testDirectorySearchImagePaging ps = registerGroupWithImage superUser bob "photos1" "Photo group" 1 registerGroupWithImage superUser bob "photos2" "Photo group" 2 withNewTestChat ps "cath" cathProfile $ \cath -> do - (page1, cursor) <- searchNames cath dsShortLink "photo" Nothing + (page1, cursor, moreCount1, _) <- searchNamesCounts cath dsShortLink "photo" Nothing length page1 `shouldBe` 1 isJust cursor `shouldBe` True + moreCount1 `shouldBe` 1 (page2, _) <- searchNames cath dsShortLink "photo" cursor page2 `shouldSatisfy` notElem (head page1) sort (page1 <> page2) `shouldBe` ["photos1", "photos2"] @@ -973,8 +984,8 @@ testSearchResultsPage _ps = do -- base64 of random bytes does not compress, so the envelope decides what fits let randomText n = safeDecodeUtf8 . strEncode <$> atomically (C.randomBytes n g) cursor gId = SCMembers {lastMembers = 1, lastGroupId = gId} - page r = case r of - DRSearchResults {entries, searchCursor} -> (map (\DirectorySearchEntry {displayName} -> displayName) entries, lastGroupId <$> searchCursor) + page matched rows = case searchResultsPage cursor (length rows) matched rows of + DRSearchResults {entries, searchCursor, moreCount} -> (map (\DirectorySearchEntry {displayName} -> displayName) entries, lastGroupId <$> searchCursor, moreCount) DRError e -> error $ T.unpack e entry name descr img = DirectorySearchEntry @@ -992,15 +1003,15 @@ testSearchResultsPage _ps = do a <- sized "a" b <- sized "b" c <- sized "c" - page (searchResultsPage cursor False [(1, Just a), (2, Just b), (3, Just c)]) `shouldBe` (["a", "b"], Just 2) - page (searchResultsPage cursor False [(1, Just a), (2, Just b)]) `shouldBe` (["a", "b"], Nothing) - page (searchResultsPage cursor True [(1, Just a), (2, Just b)]) `shouldBe` (["a", "b"], Just 2) + page 3 [(1, Just a), (2, Just b), (3, Just c)] `shouldBe` (["a", "b"], Just 2, 1) + page 2 [(1, Just a), (2, Just b)] `shouldBe` (["a", "b"], Nothing, 0) + page 5 [(1, Just a), (2, Just b)] `shouldBe` (["a", "b"], Just 2, 3) -- a row without a link is consumed by the cursor, not sent - page (searchResultsPage cursor True [(1, Just a), (2, Nothing)]) `shouldBe` (["a"], Just 2) - page (searchResultsPage cursor False [(1, Just a), (2, Nothing)]) `shouldBe` (["a"], Nothing) + page 4 [(1, Just a), (2, Nothing)] `shouldBe` (["a"], Just 2, 2) + page 2 [(1, Just a), (2, Nothing)] `shouldBe` (["a"], Nothing, 0) big <- randomText 12000 - page (searchResultsPage cursor False [(1, Just $ entry "d" "" (Just big))]) `shouldBe` (["d"], Nothing) - page (searchResultsPage cursor False [(1, Just $ entry "e" big Nothing)]) `shouldBe` ([], Just 1) + page 1 [(1, Just $ entry "d" "" (Just big))] `shouldBe` (["d"], Nothing, 0) + page 2 [(1, Just $ entry "e" big Nothing), (2, Just a)] `shouldBe` ([], Just 1, 1) testInviteToOwnersGroup :: HasCallStack => TestParams -> IO () testInviteToOwnersGroup ps =