wip

apps/ios/Shared/Model/DirectorySearch.swift

@@ -45,9 +45,11 @@ struct DirectorySearchEntry: Decodable, Hashable, Identifiable {
     var id: String { connectLink ?? displayName }
 }
 
+// entries stay as JSONValue so they can be decoded one by one: an entry the app cannot decode
+// must not fail the whole response, as it would on a future directory field
 private struct DirectorySearchResponse: Decodable {
     var type: String
-    var entries: [DirectorySearchEntry]?
+    var entries: [JSONValue]?
     var searchCursor: JSONValue?
 }
 
@@ -69,5 +71,8 @@ func parseDirectorySearchResponse(_ resp: JSONValue) -> DirectorySearchResults?
     guard let r: DirectorySearchResponse = decodeJSONValue(resp), r.type == "searchResults" else {
         return nil
     }
-    return DirectorySearchResults(entries: r.entries ?? [], cursor: r.searchCursor)
+    let entries = (r.entries ?? []).compactMap { (e: JSONValue) -> DirectorySearchEntry? in
+        decodeJSONValue(e)
+    }
+    return DirectorySearchResults(entries: entries, cursor: r.searchCursor)
 }

apps/simplex-directory-service/src/Directory/Rpc.hs

@@ -9,10 +9,12 @@ module Directory.Rpc where
 import qualified Data.Aeson.TH as JQ
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time.Clock (UTCTime)
 import Directory.Listing
 import Directory.Search
 import Directory.Store
+import Simplex.Chat.Library.Commands (maxProfileImageSize)
 import Simplex.Chat.Types
 import Simplex.Messaging.SimplexName (SimplexNameInfo (..), SimplexNameType (..), shortNameInfoStr)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON)
@@ -61,7 +63,9 @@ searchEntry now g@GroupInfo {groupProfile, chatTs, createdAt = groupCreatedAt, g
           simplexName = shortNameInfoStr . SimplexNameInfo NTPublicGroup <$> verifiedGroupDomain g,
           groupLink,
           shortDescr,
-          image,
+          -- a profile received from its owner is not size-checked, so bound what is relayed
+          -- rather than passing an arbitrarily large data URI on to the apps
+          image = image >>= \img@(ImageData t) -> if T.length t > maxProfileImageSize then Nothing else Just img,
           activeAt = recentRoundedTime 900 now $ fromMaybe groupCreatedAt chatTs,
           createdAt = recentRoundedTime 86400 now groupCreatedAt
         }

apps/simplex-directory-service/src/Directory/Service.hs

@@ -27,6 +27,7 @@ import Control.Monad.Except
 import Control.Monad.IO.Class
 import qualified Data.Attoparsec.Text as A
 import qualified Data.Aeson as J
+import qualified Data.Aeson.KeyMap as JM
 import qualified Data.Aeson.Types as JT
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -371,7 +372,8 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o
         else reject "service is busy"
       where
         releaseSlot = atomically $ modifyTVar' serviceRequestsInFlight (subtract 1)
-        -- rejecting is cheaper than answering and fails the caller immediately
+        -- runs on the shared event loop, so it must not block on the network: the reject
+        -- is enqueued, like the response is
         reject reason =
           sendChatCmd cc (APIRejectServiceRequest userId reqId $ Just reason) >>= \case
             Right _ -> pure ()
@@ -379,41 +381,54 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o
         requestResponse = case JT.parseMaybe JT.parseJSON (J.Object req) of
           Nothing -> pure $ DRError "unsupported request"
           Just DRSearch {searchText, searchCursor} -> directorySearch searchText searchCursor
-        respond resp = case J.toJSON resp of
-          J.Object o ->
-            sendChatCmd cc (APISendServiceResponse userId reqId o) >>= \case
-              Right _ -> pure ()
-              Left e -> logError $ "service response error: " <> tshow e
-          _ -> logError "service response is not an object"
+        respond resp =
+          sendChatCmd cc (APISendServiceResponse userId reqId $ responseObject resp) >>= \case
+            Right _ -> pure ()
+            Left e -> logError $ "service response error: " <> tshow e
+        responseObject resp = case J.toJSON resp of
+          J.Object o -> o
+          -- unreachable: DirectoryResponse encodes as a tagged object; kept for totality
+          _ -> JM.fromList [("type", J.String "error"), ("errorMessage", J.String "internal error")]
     directorySearch :: Text -> Maybe SearchCursor -> IO DirectoryResponse
     directorySearch searchText cursor_ =
       searchListedGroups cc user (STSearch searchText) cursor_ searchResults >>= \case
         Left e -> logError ("searchListedGroups error: " <> T.pack e) $> DRError "search failed"
-        Right (gs, _) ->
+        Right (gs, n) ->
           getGroupLinks cc user (map fst gs) >>= \case
             Left e -> logError ("getGroupLinks error: " <> T.pack e) $> DRError "search failed"
             Right links -> do
               now <- getCurrentTime
-              -- rows without a link are dropped, so entries and their cursors must stay paired
-              let rows = [(gr, e) | (gr, Just e) <- zipWith (\gr@(g, _) l -> (gr, searchEntry now g l)) gs links]
-              pure $ searchResults_ $ fitRows rows
+              let rows = zipWith (\gr@(g, _) l -> (gr, searchEntry now g l)) gs links
+                  -- rows with no link cannot be connected to, so they are not sent
+                  entryRows = [(gr, e) | (gr, Just e) <- rows]
+                  (sent, lastFitted) = fitPage entryRows
+                  fittedAll = length sent == length entryRows
+                  -- when the whole page fitted, the cursor covers every row read, including
+                  -- rows dropped for having no link; otherwise it stops where sending stopped
+                  cursorRow = if fittedAll then fst <$> lastMaybe rows else lastFitted
+                  more = not fittedAll || n > length gs
+              pure
+                DRSearchResults
+                  { entries = map snd sent,
+                    searchCursor = if more then rowCursor <$> cursorRow else Nothing
+                  }
       where
-        -- send as many entries as the padded envelope allows; a lone entry that does not fit
-        -- is sent without its image, so paging always makes progress
-        fitRows [] = []
-        fitRows rows
-          | fits rows = rows
-          | [(gr, e)] <- rows = [(gr, dropImage e)]
-          | otherwise = fitRows $ init rows
+        -- Send as many entries as the padded envelope allows, and report the last row consumed
+        -- so the cursor can move past rows that were read but not sent. A lone entry that does
+        -- not fit is retried without its image; if it still does not fit it is skipped rather
+        -- than sent, or every retry would land on it again and paging would stall there.
+        fitPage [] = ([], Nothing)
+        fitPage rows
+          | fits rows = (rows, fst <$> lastMaybe rows)
+          | [(gr, _)] <- rows = (if fits noImage then noImage else [], Just gr)
+          | otherwise = fitPage $ init rows
+          where
+            noImage = [(gr, dropImage e) | (gr, e) <- rows]
         dropImage :: DirectorySearchEntry -> DirectorySearchEntry
         dropImage e = e {image = Nothing}
-        fits = isRight . compressServiceBody . LB.toStrict . J.encode . searchResults_
-        searchResults_ rows =
-          DRSearchResults
-            { entries = map snd rows,
-              -- the cursor is the last row actually sent, so truncated rows are not skipped
-              searchCursor = rowCursor . fst <$> lastMaybe rows
-            }
+        fits rows = isRight $ compressServiceBody $ LB.toStrict $ J.encode $ page rows
+        page rows =
+          DRSearchResults {entries = map snd rows, searchCursor = rowCursor . fst <$> lastMaybe rows}
         lastMaybe = foldl' (\_ x -> Just x) Nothing
         rowCursor (GroupInfo {groupId, groupSummary = GroupSummary {currentMembers}}, GroupReg {createdAt}) =
           SearchCursor {lastMembers = currentMembers, lastCreatedAt = createdAt, lastGroupId = groupId}

plans/2026-08-04-directory-search-in-app.md

@@ -142,7 +142,7 @@ The slot still needs widening, and it is wider than it looks. `TagsOrConnectByNa
 
 **Keyboard.** Kotlin already sets `ImeAction.Search` (SearchTextField.kt:105) with no `keyboardActions`; add `onSearch: (() -> Unit)? = null` feeding `KeyboardActions`, defaulting to `KeyboardActions.Default`. `SearchTextField` has five call sites: pass the handler from **ChatListView.kt:760** (the chat list bar — the primary surface) and from `ContactsSearchBar` (NewChatSheet.kt:494), wired only from the New-chat callers (:312, :403) and not from the Deleted-chats ones (:715, :725) that share it; leave DefaultTopAppBar.kt:84, AddGroupMembersView.kt:217 and GroupChatInfoView.kt:1386 untouched. iOS has the same sharing hazard with `ContactsListSearchBar` (NewChatMenuButton.swift:333, used at :87 and :469). iOS also needs `.submitLabel(.search)` and `.onSubmit` (ChatListView.swift:665 and the New chat equivalent). Desktop shares `SearchTextField` with no soft keyboard — confirm Enter reaches the handler.
 
-**Actions.** The keyboard key runs the local filter, resolves the typed name online when it is ≥5 characters, and runs the directory search; the row runs the directory search only. Name resolution must be silent — pass a false `inProgress` as the typing path does (ChatListView.kt:818), or `apiConnectPlan` pops "SimpleX name not found" (SimpleXAPI.kt:1540); iOS calls the alert unconditionally (SimpleXAPI.swift:1046) and needs the same guard.
+**Actions.** The keyboard key runs the local filter, resolves the typed name online when it is ≥5 characters, and runs the directory search; the row runs the directory search only. Both triggers MUST be inert on empty or whitespace-only text: an empty `searchText` reaches the directory as `LIKE '%%'` and returns the whole listing ordered by member count, which is a browse, not a search. The directory does not reject it — the results are public either way — so the guard belongs in the UI, and the Search key is disabled while the field is empty. Name resolution must be silent — pass a false `inProgress` as the typing path does (ChatListView.kt:818), or `apiConnectPlan` pops "SimpleX name not found" (SimpleXAPI.kt:1540); iOS calls the alert unconditionally (SimpleXAPI.swift:1046) and needs the same guard.
 
 ## 5. Results
 

src/Simplex/Chat/Library/Commands.hs

@@ -1477,9 +1477,10 @@ processChatCommand cxt nm = \case
     pure $ CRServiceReplyAccepted user (AgentConnId connId)
   APIRejectServiceRequest userId requestId reason -> withUserId userId $ \user -> do
     let AgentInvId invId = requestId
-    -- a reason is required for the requester to fail fast; without it the request is
-    -- dropped silently and the caller waits out its timeout
-    withAgent $ \a -> rejectServiceRequest a NRMInteractive (aUserId user) invId (encodeUtf8 <$> reason)
+    -- A reason is required for the requester to fail fast; without it the request is dropped
+    -- silently and the caller waits out its timeout. Async, so a service shedding load does
+    -- not block on a network round trip per rejected request.
+    withAgent $ \a -> rejectServiceRequestAsync a "" (aUserId user) invId (encodeUtf8 <$> reason)
     ok user
   APISendCallInvitation contactId callType -> withUser $ \user -> do
     -- party initiating call

src/Simplex/Chat/Library/Subscriber.hs

@@ -1368,8 +1368,10 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
         chatReadVar processServiceRequests >>= \case
           True -> case J.eitherDecodeStrict' =<< decompressServiceBody payload of
             Right request -> toView $ CEvtServiceRequest user (AgentInvId invId) sigKey_ request
-            Left _ -> dropSReq
-          False -> dropSReq
+            Left e -> logError ("service request dropped, invalid payload: " <> tshow e) >> dropSReq
+          -- the requester gets no reply and waits out its timeout, so this must be visible
+          -- to whoever deployed the service without enabling service requests
+          False -> logError "service request dropped: service requests are not enabled" >> dropSReq
         where
           dropSReq = withAgent $ \a -> rejectServiceRequest a NRMBackground (aUserId user) invId Nothing
       LINK _link auData ->

tests/Bots/DirectoryTests.hs

@@ -663,7 +663,10 @@ testDirectorySearchRpc ps =
       withNewTestChat ps "cath" cathProfile $ \cath -> do
         -- cath never connects to the directory: the request goes to the address
         cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"search\",\"searchText\":\"privacy\"}")
-        cath <##. "service response: {\"entries\":[{"
+        resp <- getTermLine cath
+        resp `shouldStartWith` "service response: {\"entries\":[{"
+        -- 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_request 1 " <> dsShortLink <> " {\"type\":\"nonsense\"}")