lovely-projects/simplex-chat
lovely-projects/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-03-14 09:45:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

directory: better search, allow both simplex:/ and simplex.chat links in description (#3546)

Browse source 
* directory: new commands

* better search

* search test

* return group links in simplex.chat domain, allow both simplex:/ and simplex.chat links in group description
This commit is contained in:
Evgeny Poberezkin 2023-12-18 10:41:08 +00:00 • committed by GitHub
parent 6fa0001ea7
commit f0338a03d1
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 250 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
apps/simplex-directory-service/src/Directory/Events.hs
View file

@ -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

2
apps/simplex-directory-service/src/Directory/Options.hs
View file

@ -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
}

32
apps/simplex-directory-service/src/Directory/Search.hs Normal file
View file

@ -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)

128
apps/simplex-directory-service/src/Directory/Service.hs
View file

@ -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

2
simplex-chat.cabal
View file

@ -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

95
tests/Bots/DirectoryTests.hs
View file

@ -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 <message> 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 "