From 2269df1166cdf3642f1402ad829a4757d37716a2 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 9 Aug 2026 08:56:22 +0000 Subject: [PATCH] update messages --- .../src/Directory/Listing.hs | 20 +++++++++-- .../src/Directory/Service.hs | 36 +++++++++++-------- .../src/Directory/Util.hs | 14 -------- tests/Bots/DirectoryTests.hs | 10 +++--- 4 files changed, 43 insertions(+), 37 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Listing.hs b/apps/simplex-directory-service/src/Directory/Listing.hs index 49bebe3cbf..34271d0966 100644 --- a/apps/simplex-directory-service/src/Directory/Listing.hs +++ b/apps/simplex-directory-service/src/Directory/Listing.hs @@ -32,7 +32,6 @@ import Data.Time.Clock import Data.Time.Clock.System import Data.Time.Format.ISO8601 (iso8601Show) import Directory.Store -import Directory.Util (descriptionContainsLink) import Simplex.Chat.Markdown import Simplex.Chat.Types import Simplex.Chat.View (simplexChatContact) @@ -42,6 +41,23 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON) import System.Directory import System.FilePath +-- the line the directory recommends adding to the group welcome message +groupLinkLine :: Text -> Text -> Text +groupLinkLine name link = groupLinkLinePrefix name <> link + +groupLinkLinePrefix :: Text -> Text +groupLinkLinePrefix name = "Link to join the group " <> name <> ": " + +matchesGroupLink :: CreatedLinkContact -> FormattedText -> Bool +matchesGroupLink (CCLink cReq sLnk_) = \case + FormattedText (Just SimplexLink {simplexUri = ACL SCMContact cLink}) _ -> case cLink of + CLFull cReq' -> sameConnReqContact cReq' cReq + CLShort sLnk' -> maybe False (sameShortLinkContact sLnk') sLnk_ + _ -> False + +descriptionContainsLink :: CreatedLinkContact -> Text -> Bool +descriptionContainsLink gLink = maybe False (any (matchesGroupLink gLink)) . parseMaybeMarkdownList + directoryDataPath :: String directoryDataPath = "data" @@ -113,7 +129,7 @@ groupDirectoryEntry now g@GroupInfo {groupProfile, chatTs, createdAt, groupSumma Just gLink@(CCLink cReq sLnk_) | not (maybe False (descriptionContainsLink gLink) description) -> let linkText = maybe (strEncode $ simplexChatContact cReq) strEncode sLnk_ - linkLine = "Link to join the group " <> displayName <> ": " <> decodeUtf8 linkText + linkLine = groupLinkLine displayName $ decodeUtf8 linkText in Just $ maybe linkLine (<> "\n\n" <> linkLine) description _ -> description entry groupLink = diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 030498f214..b0d6215d46 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -582,11 +582,13 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName where GroupProfile {displayName = dn, fullName = fn, shortDescr = sd, image = i, description = d, memberAdmission = ma} = p GroupProfile {displayName = dn', fullName = fn', shortDescr = sd', image = i', description = d', memberAdmission = ma'} = p' - descrWords = maybe [] (T.words . T.replace ("Link to join the group " <> dn <> ":") "" . withoutLink) - withoutLink descr = case gLink_ of + -- drop the recommended link line (link token and prefix) so adding or removing it is not a content change + descrWords = maybe [] $ case gLink_ of Just GroupLink {connLinkContact} -> - maybe descr (T.concat . map ftText . filter (not . matchesGroupLink connLinkContact)) (parseMaybeMarkdownList descr) - Nothing -> descr + T.words . T.replace (groupLinkLinePrefix dn) "" . withoutLink connLinkContact + Nothing -> T.words + withoutLink gl descr = + maybe descr (T.concat . map ftText . filter (not . matchesGroupLink gl)) $ parseMaybeMarkdownList descr ftText (FormattedText _ t) = t checkRolesSendToApprove gr gaId = do (badRolesMsg <$$> getGroupRolesStatus toGroup gr) >>= \case @@ -1048,7 +1050,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName \/list - list the groups you registered.\n\ \`/role ` - view and set default member role for your group.\n\ \`/filter ` - view and set spam filter settings for group.\n\ - \`/link ` - view and upgrade group link.\n\ + \`/link ` - view group link.\n\ \`/delete :` - 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 ft -> case ft >>= groupLinkUri of @@ -1252,7 +1254,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName case groupRegStatus gr of GRSPendingApproval gaId | gaId == groupApprovalId -> do - let GroupInfo {groupProfile = GroupProfile {publicGroup = pg_}} = g + let GroupInfo {groupProfile = GroupProfile {publicGroup = pg_, description = descr_}} = g isPublicGroup_ = isJust pg_ gt = maybe "group" groupTypeStr' pg_ getDuplicateGroup g >>= \case @@ -1271,19 +1273,22 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName | otherwise = False setGroupStatusPromo sendReply st env cc gr GRSActive grPromoted' $ do let approved = "The " <> gt <> " " <> userGroupReference' gr n <> " is approved" - let linkStr = maybe "" (\l -> "Link to join the group " <> n <> ": " <> groupLinkText l <> "\nWe recommend adding this link to the group welcome message.\n") gLink' - let commands + addLink = maybe False (\l -> not $ maybe False (descriptionContainsLink l) descr_) gLink' + commands | isPublicGroup_ = "" | otherwise = "\n\nSupported commands:\n" <> ("/'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.") + <> ("/'link " <> tshow ugrId <> "' - to view group link.") notifyOwner gr $ (approved <> " and listed in directory - please moderate it!\n") - <> linkStr - <> "_Please note_: if you change the " <> gt <> " profile it will be hidden from directory until it is re-approved." + <> ( if addLink + then "To help people join, copy the next message with the group link and add it to the end of the group welcome message. The group will remain listed. Any other change to the group profile hides it from the directory until it is re-approved." + else "_Please note_: if you change the " <> gt <> " profile it will be hidden from directory until it is re-approved." + ) <> commands + when addLink $ forM_ gLink' $ \l -> notifyOwner gr $ groupLinkLine n (groupLinkText l) invited <- forM ownersGroup $ \og@KnownGroup {localDisplayName = ogName} -> do inviteToOwnersGroup og gr $ \case @@ -1447,21 +1452,22 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName where replyMsg = (Just ciId, MCText reply) foundGroup (g@GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary}, _) = do - linkStr_ <- groupLinkLine g p + linkStr_ <- foundGroupLinkLine g p let membersStr = "_" <> membersCountStr p groupSummary <> "_" showId = if isAdminUser ct then tshow groupId <> ". " else "" text = T.unlines $ [showId <> groupInfoText (simplexNameStr <$> verifiedGroupDomain g) p] <> linkStr_ <> [membersStr] <> knockingStr memberAdmission pure (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_) moreMsg = (Nothing, MCText $ "Send /next for " <> tshow moreGroups <> " more result(s).") - groupLinkLine :: GroupInfo -> GroupProfile -> IO [Text] - groupLinkLine g GroupProfile {displayName = n, description, publicGroup} = case publicGroup of + -- link line for a non-public group in search results, unless its welcome message already contains it + foundGroupLinkLine :: GroupInfo -> GroupProfile -> IO [Text] + foundGroupLinkLine g GroupProfile {displayName = n, description, publicGroup} = case publicGroup of Just _ -> pure [] Nothing -> withDB' "getGroupLink" cc (\db -> runExceptT $ getGroupLink db user g) >>= \case Right (Right GroupLink {connLinkContact = gLink}) | not (maybe False (descriptionContainsLink gLink) description) -> - pure ["Link to join the group " <> n <> ": " <> groupLinkText gLink] + pure [groupLinkLine n (groupLinkText gLink)] _ -> pure [] withGroupAndReg :: (Text -> IO ()) -> GroupId -> GroupName -> (GroupInfo -> GroupReg -> IO ()) -> IO () diff --git a/apps/simplex-directory-service/src/Directory/Util.hs b/apps/simplex-directory-service/src/Directory/Util.hs index 0c76442b08..52d376a945 100644 --- a/apps/simplex-directory-service/src/Directory/Util.hs +++ b/apps/simplex-directory-service/src/Directory/Util.hs @@ -1,6 +1,4 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -12,9 +10,7 @@ import Control.Monad.Except import Data.Text (Text) import qualified Data.Text as T import Simplex.Chat.Controller -import Simplex.Chat.Markdown (Format (..), FormattedText (..), parseMaybeMarkdownList) import Simplex.Chat.Types -import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact) import Simplex.Messaging.Agent.Store.Common (withTransaction) import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Messaging.Util (catchAll) @@ -33,13 +29,3 @@ withDB cxt ChatController {chatStore} action = do Left e -> logError $ "Database error: " <> cxt <> " " <> T.pack e Right _ -> pure () pure r_ - -matchesGroupLink :: CreatedLinkContact -> FormattedText -> Bool -matchesGroupLink (CCLink cReq sLnk_) = \case - FormattedText (Just SimplexLink {simplexUri = ACL SCMContact cLink}) _ -> case cLink of - CLFull cReq' -> sameConnReqContact cReq' cReq - CLShort sLnk' -> maybe False (sameShortLinkContact sLnk') sLnk_ - _ -> False - -descriptionContainsLink :: CreatedLinkContact -> Text -> Bool -descriptionContainsLink gLink = maybe False (any (matchesGroupLink gLink)) . parseMaybeMarkdownList diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 5e03d08afc..2807efbf02 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -1814,15 +1814,13 @@ approveRegistration_ su u n gId ugId gaId = do groupApprovedNotification :: TestCC -> String -> Int -> IO String groupApprovedNotification u n ugId = do u <# ("'SimpleX Directory'> The group ID " <> show ugId <> " (" <> n <> ") is approved and listed in directory - please moderate it!") - welcomeWithLink <- getTermLine u - u <## "We recommend adding this link to the group welcome message." - u <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved." + u <## "To help people join, copy the next message with the group link and add it to the end of the group welcome message. The group will remain listed. Any other change to the group profile hides it from the directory until it is re-approved." u <## "" u <## "Supported commands:" u <## ("/'filter " <> show ugId <> "' - to configure anti-spam filter.") u <## ("/'role " <> show ugId <> "' - to set default member role.") - u <## ("/'link " <> show ugId <> "' - to view/upgrade group link.") - pure welcomeWithLink + u <## ("/'link " <> show ugId <> "' - to view group link.") + dropStrPrefix "'SimpleX Directory'> " . dropTime <$> getTermLine u groupUpdatedHidden :: HasCallStack => TestCC -> TestCC -> String -> String -> IO () groupUpdatedHidden superUser u n byMember = do @@ -2010,7 +2008,7 @@ testHelpNoAudio ps = bob <## "/list - list the groups you registered." bob <## "`/role ` - view and set default member role for your group." bob <## "`/filter ` - view and set spam filter settings for group." - bob <## "`/link ` - view and upgrade group link." + bob <## "`/link ` - view group link." bob <## "`/delete :` - remove the group you submitted from directory, with ID and name as shown by /list command." bob <## "" bob <## "To search for groups, send the search text."