From f0338a03d1c986c33fb91711a58ea12e5ee21836 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 18 Dec 2023 10:41:08 +0000 Subject: [PATCH] directory: better search, allow both simplex:/ and simplex.chat links in description (#3546) * directory: new commands * better search * search test * return group links in simplex.chat domain, allow both simplex:/ and simplex.chat links in group description --- .../src/Directory/Events.hs | 24 +++- .../src/Directory/Options.hs | 2 + .../src/Directory/Search.hs | 32 +++++ .../src/Directory/Service.hs | 128 ++++++++++++++---- simplex-chat.cabal | 2 + tests/Bots/DirectoryTests.hs | 95 ++++++++++++- 6 files changed, 250 insertions(+), 33 deletions(-) create mode 100644 apps/simplex-directory-service/src/Directory/Search.hs diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs index 89231e4db..a187ac3e8 100644 --- a/apps/simplex-directory-service/src/Directory/Events.hs +++ b/apps/simplex-directory-service/src/Directory/Events.hs @@ -21,14 +21,18 @@ where import Control.Applicative ((<|>)) import Data.Attoparsec.Text (Parser) import qualified Data.Attoparsec.Text as A +import Data.Functor (($>)) import Data.Text (Text) import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) import Directory.Store import Simplex.Chat.Controller import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol (MsgContent (..)) import Simplex.Chat.Types +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Util ((<$?>)) import Data.Char (isSpace) import Data.Either (fromRight) @@ -83,6 +87,10 @@ deriving instance Show (SDirectoryRole r) data DirectoryCmdTag (r :: DirectoryRole) where DCHelp_ :: DirectoryCmdTag 'DRUser + DCSearchNext_ :: DirectoryCmdTag 'DRUser + DCAllGroups_ :: DirectoryCmdTag 'DRUser + DCRecentGroups_ :: DirectoryCmdTag 'DRUser + DCSubmitGroup_ :: DirectoryCmdTag 'DRUser DCConfirmDuplicateGroup_ :: DirectoryCmdTag 'DRUser DCListUserGroups_ :: DirectoryCmdTag 'DRUser DCDeleteGroup_ :: DirectoryCmdTag 'DRUser @@ -100,6 +108,10 @@ data ADirectoryCmdTag = forall r. ADCT (SDirectoryRole r) (DirectoryCmdTag r) data DirectoryCmd (r :: DirectoryRole) where DCHelp :: DirectoryCmd 'DRUser DCSearchGroup :: Text -> DirectoryCmd 'DRUser + DCSearchNext :: DirectoryCmd 'DRUser + DCAllGroups :: DirectoryCmd 'DRUser + DCRecentGroups :: DirectoryCmd 'DRUser + DCSubmitGroup :: ConnReqContact -> DirectoryCmd 'DRUser DCConfirmDuplicateGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser DCListUserGroups :: DirectoryCmd 'DRUser DCDeleteGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser @@ -120,7 +132,9 @@ deriving instance Show ADirectoryCmd directoryCmdP :: Parser ADirectoryCmd directoryCmdP = - (A.char '/' *> cmdStrP) <|> (ADC SDRUser . DCSearchGroup <$> A.takeText) + (A.char '/' *> cmdStrP) + <|> (A.char '.' $> ADC SDRUser DCSearchNext) + <|> (ADC SDRUser . DCSearchGroup <$> A.takeText) where cmdStrP = (tagP >>= \(ADCT u t) -> ADC u <$> (cmdP t <|> pure (DCCommandError t))) @@ -128,6 +142,10 @@ directoryCmdP = tagP = A.takeTill (== ' ') >>= \case "help" -> u DCHelp_ "h" -> u DCHelp_ + "next" -> u DCSearchNext_ + "all" -> u DCAllGroups_ + "new" -> u DCRecentGroups_ + "submit" -> u DCSubmitGroup_ "confirm" -> u DCConfirmDuplicateGroup_ "list" -> u DCListUserGroups_ "ls" -> u DCListUserGroups_ @@ -146,6 +164,10 @@ directoryCmdP = cmdP :: DirectoryCmdTag r -> Parser (DirectoryCmd r) cmdP = \case DCHelp_ -> pure DCHelp + DCSearchNext_ -> pure DCSearchNext + DCAllGroups_ -> pure DCAllGroups + DCRecentGroups_ -> pure DCRecentGroups + DCSubmitGroup_ -> fmap DCSubmitGroup . strDecode . encodeUtf8 <$?> (A.takeWhile1 isSpace *> A.takeText) DCConfirmDuplicateGroup_ -> gc DCConfirmDuplicateGroup DCListUserGroups_ -> pure DCListUserGroups DCDeleteGroup_ -> gc DCDeleteGroup diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs index 0ca8cee78..6d4e1296f 100644 --- a/apps/simplex-directory-service/src/Directory/Options.hs +++ b/apps/simplex-directory-service/src/Directory/Options.hs @@ -21,6 +21,7 @@ data DirectoryOpts = DirectoryOpts superUsers :: [KnownContact], directoryLog :: Maybe FilePath, serviceName :: String, + searchResults :: Int, testing :: Bool } @@ -54,6 +55,7 @@ directoryOpts appDir defaultDbFileName = do superUsers, directoryLog, serviceName, + searchResults = 10, testing = False } diff --git a/apps/simplex-directory-service/src/Directory/Search.hs b/apps/simplex-directory-service/src/Directory/Search.hs new file mode 100644 index 000000000..822182b05 --- /dev/null +++ b/apps/simplex-directory-service/src/Directory/Search.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Directory.Search where + +import Data.List (sortOn) +import Data.Ord (Down (..)) +import Data.Set (Set) +import qualified Data.Set as S +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Simplex.Chat.Types + +data SearchRequest = SearchRequest + { searchType :: SearchType, + searchTime :: UTCTime, + sentGroups :: Set GroupId + } + +data SearchType = STAll | STRecent | STSearch Text + +takeTop :: Int -> [(GroupInfo, GroupSummary)] -> [(GroupInfo, GroupSummary)] +takeTop n = take n . sortOn (Down . currentMembers . snd) + +takeRecent :: Int -> [(GroupInfo, GroupSummary)] -> [(GroupInfo, GroupSummary)] +takeRecent n = take n . sortOn (Down . (\GroupInfo {createdAt} -> createdAt) . fst) + +groupIds :: [(GroupInfo, GroupSummary)] -> Set GroupId +groupIds = S.fromList . map (\(GroupInfo {groupId}, _) -> groupId) + +filterNotSent :: Set GroupId -> [(GroupInfo, GroupSummary)] -> [(GroupInfo, GroupSummary)] +filterNotSent sentGroups = filter (\(GroupInfo {groupId}, _) -> groupId `S.notMember` sentGroups) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index fb187bbeb..ea79dabb1 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -17,16 +17,16 @@ import Control.Concurrent.Async import Control.Concurrent.STM import Control.Monad import qualified Data.ByteString.Char8 as B -import Data.List (sortOn) import Data.Maybe (fromMaybe, maybeToList) -import Data.Ord (Down(..)) +import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Clock (getCurrentTime) +import Data.Time.Clock (diffUTCTime, getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) import Directory.Events import Directory.Options +import Directory.Search import Directory.Store import Simplex.Chat.Bot import Simplex.Chat.Bot.KnownContacts @@ -36,8 +36,10 @@ import Simplex.Chat.Messages import Simplex.Chat.Options import Simplex.Chat.Protocol (MsgContent (..)) import Simplex.Chat.Types -import Simplex.Chat.View (serializeChatResponse) +import Simplex.Chat.View (serializeChatResponse, simplexChatContact) import Simplex.Messaging.Encoding.String +import Simplex.Messaging.TMap (TMap) +import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Util (safeDecodeUtf8, tshow, ($>>=), (<$$>)) import System.Directory (getAppUserDataDirectory) @@ -55,6 +57,15 @@ data GroupRolesStatus | GRSBadRoles deriving (Eq) +data ServiceState = ServiceState + { searchRequests :: TMap ContactId SearchRequest + } + +newServiceState :: IO ServiceState +newServiceState = do + searchRequests <- atomically TM.empty + pure ServiceState {searchRequests} + welcomeGetOpts :: IO DirectoryOpts welcomeGetOpts = do appDir <- getAppUserDataDirectory "simplex" @@ -65,8 +76,9 @@ welcomeGetOpts = do pure opts directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController -> IO () -directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User {userId} cc = do +directoryService st DirectoryOpts {superUsers, serviceName, searchResults, testing} user@User {userId} cc = do initializeBotAddress' (not testing) cc + env <- newServiceState race_ (forever $ void getLine) . forever $ do (_, _, resp) <- atomically . readTBQueue $ outputQ cc forM_ (crDirectoryEvent resp) $ \case @@ -84,7 +96,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { DEItemEditIgnored _ct -> pure () DEItemDeleteIgnored _ct -> pure () DEContactCommand ct ciId aCmd -> case aCmd of - ADC SDRUser cmd -> deUserCommand ct ciId cmd + ADC SDRUser cmd -> deUserCommand env ct ciId cmd ADC SDRSuperUser cmd -> deSuperUserCommand ct ciId cmd where withSuperUsers action = void . forkIO $ forM_ superUsers $ \KnownContact {contactId} -> action contactId @@ -105,8 +117,11 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already listed in the directory, please choose another name." getGroups :: Text -> IO (Maybe [(GroupInfo, GroupSummary)]) - getGroups search = - sendChatCmd cc (APIListGroups userId Nothing $ Just $ T.unpack search) >>= \case + getGroups = getGroups_ . Just + + getGroups_ :: Maybe Text -> IO (Maybe [(GroupInfo, GroupSummary)]) + getGroups_ search_ = + sendChatCmd cc (APIListGroups userId Nothing $ T.unpack <$> search_) >>= \case CRGroupsList {groups} -> pure $ Just groups _ -> pure Nothing @@ -140,7 +155,8 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { sendMessage cc ct $ "Welcome to " <> serviceName <> " service!\n\ \Send a search string to find groups or */help* to learn how to add groups to directory.\n\n\ - \For example, send _privacy_ to find groups about privacy.\n\n\ + \For example, send _privacy_ to find groups about privacy.\n\ + \Or send */all* or */new* to list groups.\n\n\ \Content and privacy policy: https://simplex.chat/docs/directory.html" deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO () @@ -201,7 +217,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { "Created the public link to join the group via this directory service that is always online.\n\n\ \Please add it to the group welcome message.\n\ \For example, add:" - notifyOwner gr $ "Link to join the group " <> T.unpack displayName <> ": " <> B.unpack (strEncode connReqContact) + notifyOwner gr $ "Link to join the group " <> T.unpack displayName <> ": " <> B.unpack (strEncode $ simplexChatContact connReqContact) CRChatCmdError _ (ChatError e) -> case e of CEGroupUserRole {} -> notifyOwner gr "Failed creating group link, as service is no longer an admin." CEGroupMemberUserRemoved -> notifyOwner gr "Failed creating group link, as service is removed from the group." @@ -276,9 +292,10 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { where profileUpdate = \case CRGroupLink {connReqContact} -> - let groupLink = safeDecodeUtf8 $ strEncode connReqContact - hadLinkBefore = groupLink `isInfix` description p - hasLinkNow = groupLink `isInfix` description p' + let groupLink1 = safeDecodeUtf8 $ strEncode connReqContact + groupLink2 = safeDecodeUtf8 $ strEncode $ simplexChatContact connReqContact + hadLinkBefore = groupLink1 `isInfix` description p || groupLink2 `isInfix` description p + hasLinkNow = groupLink1 `isInfix` description p' || groupLink2 `isInfix` description p' in if | hadLinkBefore && hasLinkNow -> GPHasServiceLink | hadLinkBefore -> GPServiceLinkRemoved @@ -379,8 +396,8 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory." notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)." - deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO () - deUserCommand ct ciId = \case + deUserCommand :: ServiceState -> Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO () + deUserCommand env@ServiceState {searchRequests} ct ciId = \case DCHelp -> sendMessage cc ct $ "You must be the owner to add the group to the directory:\n\ @@ -389,20 +406,25 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { \3. You will then need to add this link to the group welcome message.\n\ \4. Once the link is added, service admins will approve the group (it can take up to 24 hours), and everybody will be able to find it in directory.\n\n\ \Start from inviting the bot to your group as admin - it will guide you through the process" - DCSearchGroup s -> - getGroups s >>= \case - Just groups -> - atomically (filterListedGroups st groups) >>= \case - [] -> sendReply "No groups found" - gs -> do - sendReply $ "Found " <> show (length gs) <> " group(s)" <> if length gs > 10 then ", sending 10." else "" - void . forkIO $ forM_ (take 10 $ sortOn (Down . currentMembers . snd) gs) $ - \(GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do - let membersStr = "_" <> tshow currentMembers <> " members_" - text = groupInfoText p <> "\n" <> membersStr - msg = maybe (MCText text) (\image -> MCImage {text, image}) image_ - sendComposedMessage cc ct Nothing msg - Nothing -> sendReply "Error: getGroups. Please notify the developers." + DCSearchGroup s -> withFoundListedGroups (Just s) $ sendSearchResults s + DCSearchNext -> + atomically (TM.lookup (contactId' ct) searchRequests) >>= \case + Just search@SearchRequest {searchType, searchTime} -> do + currentTime <- getCurrentTime + if diffUTCTime currentTime searchTime > 300 -- 5 minutes + then do + atomically $ TM.delete (contactId' ct) searchRequests + showAllGroups + else case searchType of + STSearch s -> withFoundListedGroups (Just s) $ sendNextSearchResults takeTop search + STAll -> withFoundListedGroups Nothing $ sendNextSearchResults takeTop search + STRecent -> withFoundListedGroups Nothing $ sendNextSearchResults takeRecent search + Nothing -> showAllGroups + where + showAllGroups = deUserCommand env ct ciId DCAllGroups + DCAllGroups -> withFoundListedGroups Nothing $ sendAllGroups takeTop "top" STAll + DCRecentGroups -> withFoundListedGroups Nothing $ sendAllGroups takeRecent "the most recent" STRecent + DCSubmitGroup _link -> pure () DCConfirmDuplicateGroup ugrId gName -> atomically (getUserGroupReg st (contactId' ct) ugrId) >>= \case Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found" @@ -429,6 +451,54 @@ directoryService st DirectoryOpts {superUsers, serviceName, testing} user@User { DCCommandError tag -> sendReply $ "Command error: " <> show tag where sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent + withFoundListedGroups s_ action = + getGroups_ s_ >>= \case + Just groups -> atomically (filterListedGroups st groups) >>= action + Nothing -> sendReply "Error: getGroups. Please notify the developers." + sendSearchResults s = \case + [] -> sendReply "No groups found" + gs -> do + let gs' = takeTop searchResults gs + moreGroups = length gs - length gs' + more = if moreGroups > 0 then ", sending top " <> show (length gs') else "" + sendReply $ "Found " <> show (length gs) <> " group(s)" <> more <> "." + updateSearchRequest (STSearch s) $ groupIds gs' + sendFoundGroups gs' moreGroups + sendAllGroups takeFirst sortName searchType = \case + [] -> sendReply "No groups listed" + gs -> do + let gs' = takeFirst searchResults gs + moreGroups = length gs - length gs' + more = if moreGroups > 0 then ", sending " <> sortName <> " " <> show (length gs') else "" + sendReply $ show (length gs) <> " group(s) listed" <> more <> "." + updateSearchRequest searchType $ groupIds gs' + sendFoundGroups gs' moreGroups + sendNextSearchResults takeFirst SearchRequest {searchType, sentGroups} = \case + [] -> do + sendReply "Sorry, no more groups" + atomically $ TM.delete (contactId' ct) searchRequests + gs -> do + let gs' = takeFirst searchResults $ filterNotSent sentGroups gs + sentGroups' = sentGroups <> groupIds gs' + moreGroups = length gs - S.size sentGroups' + sendReply $ "Sending " <> show (length gs') <> " more group(s)." + updateSearchRequest searchType sentGroups' + sendFoundGroups gs' moreGroups + updateSearchRequest :: SearchType -> Set GroupId -> IO () + updateSearchRequest searchType sentGroups = do + searchTime <- getCurrentTime + let search = SearchRequest {searchType, searchTime, sentGroups} + atomically $ TM.insert (contactId' ct) search searchRequests + sendFoundGroups gs moreGroups = + void . forkIO $ do + forM_ gs $ + \(GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do + let membersStr = "_" <> tshow currentMembers <> " members_" + text = groupInfoText p <> "\n" <> membersStr + msg = maybe (MCText text) (\image -> MCImage {text, image}) image_ + sendComposedMessage cc ct Nothing msg + when (moreGroups > 0) $ + sendComposedMessage cc ct Nothing $ MCText $ "Send */next* or just *.* for " <> tshow moreGroups <> " more result(s)." deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO () deSuperUserCommand ct ciId cmd diff --git a/simplex-chat.cabal b/simplex-chat.cabal index ce066bc3c..f3918dfec 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -467,6 +467,7 @@ executable simplex-directory-service other-modules: Directory.Events Directory.Options + Directory.Search Directory.Service Directory.Store Paths_simplex_chat @@ -553,6 +554,7 @@ test-suite simplex-chat-test Broadcast.Options Directory.Events Directory.Options + Directory.Search Directory.Service Directory.Store Paths_simplex_chat diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index b31d6f36f..3c6991bb5 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -30,6 +30,7 @@ directoryServiceTests = do it "should suspend and resume group" testSuspendResume 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 describe "de-listing the group" $ do it "should de-list if owner leaves the group" testDelistedOwnerLeaves it "should de-list if owner is removed from the group" testDelistedOwnerRemoved @@ -67,6 +68,7 @@ mkDirectoryOpts tmp superUsers = superUsers, directoryLog = Just $ tmp "directory_service.log", serviceName = "SimpleX-Directory", + searchResults = 3, testing = True } @@ -158,7 +160,7 @@ testDirectoryService tmp = search u s welcome = do u #> ("@SimpleX-Directory " <> s) u <# ("SimpleX-Directory> > " <> s) - u <## " Found 1 group(s)" + u <## " Found 1 group(s)." u <# "SimpleX-Directory> PSA (Privacy, Security & Anonymity)" u <## "Welcome message:" u <## welcome @@ -206,7 +208,7 @@ testJoinGroup tmp = cath `connectVia` dsLink cath #> "@SimpleX-Directory privacy" cath <# "SimpleX-Directory> > privacy" - cath <## " Found 1 group(s)" + cath <## " Found 1 group(s)." cath <# "SimpleX-Directory> privacy (Privacy)" cath <## "Welcome message:" welcomeMsg <- getTermLine cath @@ -263,6 +265,92 @@ testGroupNameWithSpaces tmp = bob <# "SimpleX-Directory> The group ID 1 (Privacy & Security) is listed in the directory again!" groupFound bob "Privacy & Security" +testSearchGroups :: HasCallStack => FilePath -> IO () +testSearchGroups tmp = + withDirectoryService tmp $ \superUser dsLink -> + withNewTestChat tmp "bob" bobProfile $ \bob -> do + withNewTestChat tmp "cath" cathProfile $ \cath -> do + bob `connectVia` dsLink + cath `connectVia` dsLink + forM_ [1..8 :: Int] $ \i -> registerGroupId superUser bob (groups !! (i - 1)) "" i i + connectUsers bob cath + fullAddMember "MyGroup" "" bob cath GRMember + joinGroup "MyGroup" cath bob + cath <## "#MyGroup: member SimpleX-Directory_1 is connected" + cath <## "contact and member are merged: SimpleX-Directory, #MyGroup SimpleX-Directory_1" + cath <## "use @SimpleX-Directory to send messages" + cath #> "@SimpleX-Directory MyGroup" + cath <# "SimpleX-Directory> > MyGroup" + cath <## " Found 7 group(s), sending top 3." + receivedGroup cath 0 3 + receivedGroup cath 1 2 + receivedGroup cath 2 2 + cath <# "SimpleX-Directory> Send /next or just . for 4 more result(s)." + cath #> "@SimpleX-Directory /next" + cath <# "SimpleX-Directory> > /next" + cath <## " Sending 3 more group(s)." + receivedGroup cath 3 2 + receivedGroup cath 4 2 + receivedGroup cath 5 2 + cath <# "SimpleX-Directory> Send /next or just . for 1 more result(s)." + -- search of another user does not affect the search of the first user + groupFound bob "Another" + cath #> "@SimpleX-Directory ." + cath <# "SimpleX-Directory> > ." + cath <## " Sending 1 more group(s)." + receivedGroup cath 6 2 + cath #> "@SimpleX-Directory /all" + cath <# "SimpleX-Directory> > /all" + cath <## " 8 group(s) listed, sending top 3." + receivedGroup cath 0 3 + receivedGroup cath 1 2 + receivedGroup cath 2 2 + cath <# "SimpleX-Directory> Send /next or just . for 5 more result(s)." + cath #> "@SimpleX-Directory /new" + cath <# "SimpleX-Directory> > /new" + cath <## " 8 group(s) listed, sending the most recent 3." + receivedGroup cath 7 2 + receivedGroup cath 6 2 + receivedGroup cath 5 2 + cath <# "SimpleX-Directory> Send /next or just . for 5 more result(s)." + cath #> "@SimpleX-Directory term3" + cath <# "SimpleX-Directory> > term3" + cath <## " Found 3 group(s)." + receivedGroup cath 4 2 + receivedGroup cath 5 2 + receivedGroup cath 6 2 + cath #> "@SimpleX-Directory term1" + cath <# "SimpleX-Directory> > term1" + cath <## " Found 6 group(s), sending top 3." + receivedGroup cath 1 2 + receivedGroup cath 2 2 + receivedGroup cath 3 2 + cath <# "SimpleX-Directory> Send /next or just . for 3 more result(s)." + cath #> "@SimpleX-Directory ." + cath <# "SimpleX-Directory> > ." + cath <## " Sending 3 more group(s)." + receivedGroup cath 4 2 + receivedGroup cath 5 2 + receivedGroup cath 6 2 + where + groups :: [String] + groups = + [ "MyGroup", + "MyGroup term1 1", + "MyGroup term1 2", + "MyGroup term1 term2", + "MyGroup term1 term2 term3", + "MyGroup term1 term2 term3 term4", + "MyGroup term1 term2 term3 term4 term5", + "Another" + ] + 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") + testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO () testDelistedOwnerLeaves tmp = withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink -> @@ -930,6 +1018,7 @@ u `connectVia` dsLink = do u <## "Send a search string to find groups or /help to learn how to add groups to directory." u <## "" u <## "For example, send privacy to find groups about privacy." + u <## "Or send /all or /new to list groups." u <## "" u <## "Content and privacy policy: https://simplex.chat/docs/directory.html" @@ -967,7 +1056,7 @@ groupFoundN :: Int -> TestCC -> String -> IO () groupFoundN count u name = do u #> ("@SimpleX-Directory " <> name) u <# ("SimpleX-Directory> > " <> name) - u <## " Found 1 group(s)" + u <## " Found 1 group(s)." u <#. ("SimpleX-Directory> " <> name) u <## "Welcome message:" u <##. "Link to join the group "