directory: use bot commands and menu in SimpleX Directory (#6219)

* directory: use bot commands and menu in SimpleX Directory

* rename (remove hyphen), fix test

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

@@ -116,8 +116,8 @@ directoryOpts appDir defaultDbName = do
     strOption
       ( long "service-name"
           <> metavar "SERVICE_NAME"
-          <> help "The display name of the directory service bot, without *'s and spaces (SimpleX-Directory)"
-          <> value "SimpleX-Directory"
+          <> help "The display name of the directory service bot, without *'s and spaces (SimpleX Directory)"
+          <> value "SimpleX Directory"
       )
   runCLI <-
     switch

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

@@ -8,6 +8,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Directory.Service
   ( welcomeGetOpts,
@@ -59,6 +60,7 @@ import Simplex.Chat.Store.Shared (StoreError (..))
 import Simplex.Chat.Terminal (terminalChatConfig)
 import Simplex.Chat.Terminal.Main (simplexChatCLI')
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.View (serializeChatError, serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
 import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnectionLink (..), CreatedConnLink (..))
@@ -70,6 +72,7 @@ import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow, ($>>=), (<$$>))
 import System.Directory (getAppUserDataDirectory)
+import System.Exit (exitFailure)
 import System.Process (readProcess)
 
 data GroupProfileUpdate
@@ -144,7 +147,7 @@ directoryServiceCLI st opts = do
   env <- newServiceState opts
   eventQ <- newTQueueIO
   let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
-      chatHooks = defaultChatHooks {eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env}
+      chatHooks = defaultChatHooks {postStartHook = Just postStartHook, eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env}
   race_
     (simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing)
     (processEvents eventQ env)
@@ -153,6 +156,34 @@ directoryServiceCLI st opts = do
       (cc, resp) <- atomically $ readTQueue eventQ
       u_ <- readTVarIO (currentUser cc)
       forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp
+    postStartHook cc =
+      readTVarIO (currentUser cc) >>= \case
+        Nothing -> putStrLn "No current user" >> exitFailure
+        Just User {userId, profile = p@LocalProfile {preferences}} -> do
+          let cmds = fromMaybe [] $ preferences >>= commands_
+          unless (cmds == directoryCommands) $ do
+            let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences
+                p' = (fromLocalProfile p) {displayName = serviceName opts, peerType = Just CPTBot, preferences = Just prefs} :: Profile
+            liftIO $ sendChatCmd cc (APIUpdateProfile userId p') >>= \case
+              Right CRUserProfileUpdated {} -> putStrLn "Updated directory commands"
+              Right r -> putStrLn ("Error: unexpected response " <> show r) >> exitFailure
+              Left e -> putStrLn ("Error: " <> show e) >> exitFailure
+
+directoryCommands :: [ChatBotCommand]
+directoryCommands =
+  [ CBCCommand "new" "New groups" Nothing,
+    CBCCommand "help" "How to submit your group" Nothing,
+    CBCCommand "list" "Your own groups" Nothing,
+    CBCMenu
+      "Group settings"
+      [ CBCCommand "role" "View new member role" idParam,
+        CBCCommand "filter" "Anti-spam filter" idParam,
+        CBCCommand "link" "View and upgrade group link" idParam,
+        CBCCommand "delete" "Remove a group from directory" (Just "<ID>:'<NAME>'")
+      ]
+  ]
+  where
+    idParam = Just "<ID>"
 
 directoryService :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> IO ()
 directoryService st opts@DirectoryOpts {testing} env user cc = do
@@ -299,11 +330,11 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deContactConnected ct = when (contactDirect ct) $ do
       logInfo $ (viewContactName ct) <> " connected"
       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\
-             \Or send */all* or */new* to list groups.\n\n\
-             \Content and privacy policy: https://simplex.chat/docs/directory.html"
+        ("Welcome to " <> serviceName <> "!\n\n")
+          <> "🔍 Send search string to find groups - try _security_.\n\
+             \/help - how to submit your group.\n\
+             \/new - recent groups.\n\n\
+             \[Directory rules](https://simplex.chat/docs/directory.html)."
 
     deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO ()
     deGroupInvitation ct g@GroupInfo {groupProfile = p@GroupProfile {displayName}} fromMemberRole memberRole = do
@@ -674,24 +705,22 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deUserCommand ct ciId = \case
       DCHelp DHSRegistration ->
         sendMessage cc ct $
-          "You must be the owner to add the group to the directory:\n\
-          \1. Invite "
+          "You must be the group owner to add it to the directory:\n\n\
+          \1️⃣ *Invite* "
             <> serviceName
-            <> " bot to your group as *admin* (you can send `/list` to see all groups you submitted).\n\
-               \2. "
-            <> serviceName
-            <> " bot will create a public group link for the new members to join even when you are offline.\n\
-               \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 48 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."
+            <> " bot to your group as *admin* - it will create a link for new members to join.\n\
+               \2️⃣ *Add* this link to the group's welcome message.\n\
+               \3️⃣ We *review* your group. Once *approved*, anybody can find it.\n\n\
+               \_We usually approve within a day, except holidays_. [More details](https://simplex.chat/docs/directory.html#adding-groups-to-the-directory)."
       DCHelp DHSCommands ->
         sendMessage cc ct $
-          "*/help commands* - receive this help message.\n\
-          \*/help* - how to register your group to be added to directory.\n\
-          \*/list* - list the groups you registered.\n\
-          \*/delete <ID>:<NAME>* - remove the group you submitted from directory, with _ID_ and _name_ as shown by */list* command.\n\
-          \*/role <ID>* - view and set default member role for your group.\n\
-          \*/filter <ID>* - view and set spam filter settings for group.\n\n\
+          "/'help commands' - receive this help message.\n\
+          \/help - how to register your group to be added to directory.\n\
+          \/list - list the groups you registered.\n\
+          \`/role <ID>` - view and set default member role for your group.\n\
+          \`/filter <ID>` - view and set spam filter settings for group.\n\
+          \`/link <ID>` - view and upgrade group link.\n\
+          \`/delete <ID>:<NAME>` - remove the group you submitted from directory, with _ID_ and _name_ as shown by /list command.\n\n\
           \To search for groups, send the search text."
       DCSearchGroup s -> withFoundListedGroups (Just s) $ sendSearchResults s
       DCSearchNext ->
@@ -741,7 +770,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                   let anotherRole = case acceptMemberRole of GRObserver -> GRMember; _ -> GRObserver
                   sendReply $
                     initialRole n acceptMemberRole
-                      <> ("Send */role " <> tshow gId <> " " <> strEncodeTxt anotherRole <> "* to change it.\n\n")
+                      <> ("Send /'role " <> tshow gId <> " " <> strEncodeTxt anotherRole <> "' to change it.\n\n")
                       <> onlyViaLink gLink
                 Nothing -> sendReply $ "Error: failed reading the initial member role for the group " <> n
             Just mRole -> do
@@ -765,16 +794,19 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         where
           sendSettigns n a setTo =
             sendReply $
-              T.unlines
+              T.unlines $
                 [ "Spam filter settings for group " <> n <> setTo <> ":",
                   "- reject long/inappropriate names: " <> showCondition (rejectNames a),
                   "- pass captcha to join: " <> showCondition (passCaptcha a),
                   -- "- make observer: " <> showCondition (makeObserver a) <> (if isJust (makeObserver a) then "" else " (use default set with /role command)"),
-                  "",
+                  ""
                   -- "Use */filter " <> tshow gId <> " <level>* to change spam filter level: no (disable), basic, moderate, strong.",
                   -- "Or use */filter " <> tshow gId <> " [name[=noimage]] [captcha[=noimage]] [observer[=noimage]]* for advanced filter configuration."
-                  "Use */filter " <> tshow gId <> " [name] [captcha]* to enable and */filter " <> tshow gId <> " off* to disable filter."
                 ]
+                  <> ["/'filter " <> tshow gId <> " name' - enable name filter" | isNothing (rejectNames a)]
+                  <> ["/'filter " <> tshow gId <> " captcha' - enable captcha challenge" | isNothing (passCaptcha a)]
+                  <> ["/'filter " <> tshow gId <> " name captcha' - enable both" | isNothing (rejectNames a) || isNothing (passCaptcha a)]
+                  <> ["/'filter " <> tshow gId <> " off' - disable filter" | isJust (rejectNames a) || isJust (passCaptcha a)]
           showCondition = \case
             Nothing -> "_disabled_"
             Just PCAll -> "_enabled_"
@@ -887,7 +919,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                   showId = if isAdmin then tshow groupId <> ". " else ""
                   text = showId <> groupInfoText p <> "\n" <> membersStr
                in (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_)
-            moreMsg = (Nothing, MCText $ "Send */next* or just *.* for " <> tshow moreGroups <> " more result(s).")
+            moreMsg = (Nothing, MCText $ "Send /next for " <> tshow moreGroups <> " more result(s).")
 
     deAdminCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRAdmin -> IO ()
     deAdminCommand ct ciId cmd
@@ -907,11 +939,11 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                               let approved = "The group " <> userGroupReference' gr n <> " is approved"
                               notifyOwner gr $
                                 (approved <> " and listed in directory - please moderate it!\n")
-                                  <> "Please note: if you change the group profile it will be hidden from directory until it is re-approved.\n\n"
+                                  <> "_Please note_: if you change the group profile it will be hidden from directory until it is re-approved.\n\n"
                                   <> "Supported commands:\n"
-                                  <> ("- */filter " <> tshow ugrId <> "* - to configure anti-spam filter.\n")
-                                  <> ("- */role " <> tshow ugrId <> "* - to set default member role.\n")
-                                  <> "- */help commands* - other commands."
+                                  <> ("/'filter " <> tshow ugrId <> "' - to configure anti-spam filter.\n")
+                                  <> ("/'role " <> tshow ugrId <> "' - to set default member role.\n")
+                                  <> ("/'link " <> tshow ugrId <> "' - to view/upgrade group link.")
                               invited <-
                                 forM ownersGroup $ \og@KnownGroup {localDisplayName = ogName} -> do
                                   inviteToOwnersGroup og gr $ \case
@@ -920,7 +952,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                                       pure $ "Invited " <> owner <> " to owners' group " <> viewName ogName
                                     Left err -> pure err
                               sendReply $ "Group approved!" <> maybe "" ("\n" <>) invited
-                              notifyOtherSuperUsers $ approved <> " by " <> viewName (localDisplayName' ct) <> fromMaybe "" invited
+                              notifyOtherSuperUsers $ approved <> " by " <> viewName (localDisplayName' ct) <> maybe "" ("\n" <>) invited
                             Just GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
                             Just GRSContactNotOwner -> replyNotApproved "user is not an owner."
                             Just GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin
@@ -1062,7 +1094,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
       getGroupAndSummary cc user dbGroupId >>= \case
         Just (GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
           let membersStr = "_" <> tshow currentMembers <> " members_"
-              text = T.unlines $ [tshow useGroupId <> ". " <> groupInfoText p] <> maybeToList ownerStr_ <> [membersStr, statusStr]
+              cmds = "/'role " <> tshow useGroupId <> "', /'filter " <> tshow useGroupId <> "'"
+              text = T.unlines $ [tshow useGroupId <> ". " <> groupInfoText p] <> maybeToList ownerStr_ <> [membersStr, statusStr, cmds]
               msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
           sendComposedMessage cc ct Nothing msg
         Nothing -> do

tests/ChatTests/Utils.hs

@@ -24,6 +24,7 @@ import Data.Maybe (fromMaybe)
 import Data.String
 import qualified Data.Text as T
 import Simplex.Chat.Controller (ChatConfig (..), ChatController (..))
+import Simplex.Chat.Markdown (viewName)
 import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Direct (getContact)
@@ -723,7 +724,7 @@ connectUsers_ cc1 cc2 noShortLink = do
 showName :: TestCC -> IO String
 showName (TestCC ChatController {currentUser} _ _ _ _ _) = do
   Just User {localDisplayName, profile = LocalProfile {fullName, shortDescr}} <- readTVarIO currentUser
-  pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName shortDescr
+  pure . T.unpack $ viewName localDisplayName <> optionalFullName localDisplayName fullName shortDescr
 
 createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
 createGroup2 gName cc1 cc2 = createGroup2' gName cc1 (cc2, GRAdmin) True