diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs index 45c0b84cc6..ef6056fbc4 100644 --- a/apps/simplex-directory-service/src/Directory/Events.hs +++ b/apps/simplex-directory-service/src/Directory/Events.hs @@ -33,10 +33,10 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Directory.Store import Simplex.Chat.Controller -import Simplex.Chat.Markdown (displayNameTextP) +import Simplex.Chat.Markdown (MarkdownList, displayNameTextP) import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent -import Simplex.Chat.Protocol (MsgContent (..)) +import Simplex.Chat.Protocol (LinkOwnerSig, MsgChatLink, MsgContent (..)) import Simplex.Chat.Types import Simplex.Chat.Types.Shared import Simplex.Messaging.Agent.Protocol (AgentErrorType (..)) @@ -57,6 +57,8 @@ data DirectoryEvent | DEContactLeftGroup ContactId GroupInfo | DEServiceRemovedFromGroup GroupInfo | DEGroupDeleted GroupInfo + | DEChatLinkReceived {contact :: Contact, chatItemId :: ChatItemId, chatLink :: MsgChatLink, ownerSig :: Maybe LinkOwnerSig} + | DEMemberUpdated {groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember} | DEUnsupportedMessage Contact ChatItemId | DEItemEditIgnored Contact | DEItemDeleteIgnored Contact @@ -91,11 +93,14 @@ crDirectoryEvent_ = \case CEvtLeftMember {groupInfo, member} -> (`DEContactLeftGroup` groupInfo) <$> memberContactId member CEvtDeletedMemberUser {groupInfo} -> Just $ DEServiceRemovedFromGroup groupInfo CEvtGroupDeleted {groupInfo} -> Just $ DEGroupDeleted groupInfo + CEvtUnknownMemberAnnounced {groupInfo, unknownMember, announcedMember} -> Just $ DEMemberUpdated {groupInfo, fromMember = unknownMember, toMember = announcedMember} + CEvtGroupMemberUpdated {groupInfo, fromMember, toMember} -> Just $ DEMemberUpdated {groupInfo, fromMember, toMember} CEvtChatItemUpdated {chatItem = AChatItem _ SMDRcv (DirectChat ct) _} -> Just $ DEItemEditIgnored ct CEvtChatItemsDeleted {chatItemDeletions = ((ChatItemDeletion (AChatItem _ SMDRcv (DirectChat ct) _) _) : _), byUser = False} -> Just $ DEItemDeleteIgnored ct - CEvtNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc, meta = CIMeta {itemLive}}) : _} -> + CEvtNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc, formattedText = ft, meta = CIMeta {itemLive}}) : _} -> Just $ case (mc, itemLive) of - (MCText t, Nothing) -> DEContactCommand ct ciId $ fromRight err $ A.parseOnly (directoryCmdP <* A.endOfInput) $ T.dropWhileEnd isSpace t + (MCText t, Nothing) -> DEContactCommand ct ciId $ fromRight err $ A.parseOnly (directoryCmdP ft <* A.endOfInput) $ T.dropWhileEnd isSpace t + (MCChat {chatLink, ownerSig}, Nothing) -> DEChatLinkReceived {contact = ct, chatItemId = ciId, chatLink, ownerSig} _ -> DEUnsupportedMessage ct ciId where ciId = chatItemId' ci @@ -149,7 +154,7 @@ data DirectoryHelpSection = DHSRegistration | DHSCommands data DirectoryCmd (r :: DirectoryRole) where DCHelp :: DirectoryHelpSection -> DirectoryCmd 'DRUser - DCSearchGroup :: Text -> DirectoryCmd 'DRUser + DCSearchGroup :: Text -> Maybe MarkdownList -> DirectoryCmd 'DRUser DCSearchNext :: DirectoryCmd 'DRUser DCAllGroups :: DirectoryCmd 'DRUser DCRecentGroups :: DirectoryCmd 'DRUser @@ -181,11 +186,11 @@ data ADirectoryCmd = forall r. ADC (SDirectoryRole r) (DirectoryCmd r) deriving instance Show ADirectoryCmd -directoryCmdP :: Parser ADirectoryCmd -directoryCmdP = +directoryCmdP :: Maybe MarkdownList -> Parser ADirectoryCmd +directoryCmdP ft = (A.char '/' *> cmdStrP) <|> (A.char '.' $> ADC SDRUser DCSearchNext) - <|> (ADC SDRUser . DCSearchGroup <$> A.takeText) + <|> (ADC SDRUser . (`DCSearchGroup` ft) <$> A.takeText) where cmdStrP = (tagP >>= \(ADCT u t) -> ADC u <$> (cmdP t <|> pure (DCCommandError t))) @@ -304,7 +309,7 @@ directoryCmdP = directoryCmdTag :: DirectoryCmd r -> Text directoryCmdTag = \case DCHelp _ -> "help" - DCSearchGroup _ -> "search" + DCSearchGroup {} -> "search" DCSearchNext -> "next" DCAllGroups -> "all" DCRecentGroups -> "new" diff --git a/apps/simplex-directory-service/src/Directory/Listing.hs b/apps/simplex-directory-service/src/Directory/Listing.hs index 0d4e8d351c..ef093020bb 100644 --- a/apps/simplex-directory-service/src/Directory/Listing.hs +++ b/apps/simplex-directory-service/src/Directory/Listing.hs @@ -27,7 +27,7 @@ import Data.List (isPrefixOf) import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time.Clock import Data.Time.Clock.System import Data.Time.Format.ISO8601 (iso8601Show) @@ -53,16 +53,24 @@ listingImageFolder :: String listingImageFolder = "images" data DirectoryEntryType = DETGroup - { admission :: Maybe GroupMemberAdmission, + { groupType :: Maybe GroupType, + admission :: Maybe GroupMemberAdmission, summary :: GroupSummary } $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "DET") ''DirectoryEntryType) +data PublicLink = PublicLink + { connFullLink :: Maybe ConnReqContact, + connShortLink :: Maybe ShortLinkContact + } + +$(JQ.deriveJSON defaultJSON ''PublicLink) + data DirectoryEntry = DirectoryEntry { entryType :: DirectoryEntryType, displayName :: Text, - groupLink :: CreatedLinkContact, + groupLink :: PublicLink, shortDescr :: Maybe MarkdownList, welcomeMessage :: Maybe MarkdownList, imageFile :: Maybe String, @@ -90,8 +98,15 @@ recentRoundedTime roundTo now t groupDirectoryEntry :: UTCTime -> GroupInfo -> Maybe GroupLink -> Maybe (DirectoryEntry, Maybe (FilePath, ImageFileData)) groupDirectoryEntry now GroupInfo {groupProfile, chatTs, createdAt, groupSummary} gLink_ = - let GroupProfile {displayName, shortDescr, description, image, memberAdmission} = groupProfile - entryType = DETGroup memberAdmission groupSummary + let GroupProfile {displayName, shortDescr, description, image, memberAdmission, publicGroup} = groupProfile + gt = (\PublicGroupProfile {groupType} -> groupType) <$> publicGroup + entryType = DETGroup gt memberAdmission groupSummary + description' = case publicGroup of + Just PublicGroupProfile {groupType = gt', groupLink = sLnk} -> + let gtStr = case gt' of GTChannel -> "channel"; _ -> "group" + linkLine = "Link to join the " <> gtStr <> " " <> displayName <> ": " <> decodeUtf8 (strEncode sLnk) + in Just $ maybe linkLine (<> "\n\n" <> linkLine) description + Nothing -> description entry groupLink = let de = DirectoryEntry @@ -99,22 +114,30 @@ groupDirectoryEntry now GroupInfo {groupProfile, chatTs, createdAt, groupSummary displayName, groupLink, shortDescr = toFormattedText <$> shortDescr, - welcomeMessage = toFormattedText <$> description, + welcomeMessage = toFormattedText <$> description', imageFile = fst <$> imgData, activeAt = recentRoundedTime 900 now $ fromMaybe createdAt chatTs, createdAt = recentRoundedTime 86400 now createdAt } imgData = imgFileData groupLink =<< image in (de, imgData) - in (entry . connLinkContact) <$> gLink_ + in case publicGroup of + Just PublicGroupProfile {groupLink = sLnk} -> + Just $ entry $ PublicLink Nothing (Just sLnk) + Nothing -> + entry . toPublicLink . connLinkContact <$> gLink_ where - imgFileData :: CreatedConnLink 'CMContact -> ImageData -> Maybe (FilePath, ByteString) - imgFileData groupLink (ImageData img) = + toPublicLink (CCLink fullLink shortLink) = PublicLink (Just fullLink) shortLink + imgFileData :: PublicLink -> ImageData -> Maybe (FilePath, ByteString) + imgFileData PublicLink {connFullLink, connShortLink} (ImageData img) = let (img', imgExt) = fromMaybe (img, ".jpg") $ (,".jpg") <$> T.stripPrefix "data:image/jpg;base64," img <|> (,".png") <$> T.stripPrefix "data:image/png;base64," img - imgName = B.unpack $ B64URL.encodeUnpadded $ BA.convert $ (CH.hash :: ByteString -> Digest MD5) $ strEncode (connFullLink groupLink) + linkHash = case connFullLink of + Just fl -> strEncode fl + Nothing -> maybe "" strEncode connShortLink + imgName = B.unpack $ B64URL.encodeUnpadded $ BA.convert $ (CH.hash :: ByteString -> Digest MD5) linkHash imgFile = listingImageFolder imgName <> imgExt in case B64.decode $ encodeUtf8 img' of Right img'' -> Just (imgFile, img'') diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 34b63ff06a..c1cf61f5a1 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -19,6 +19,7 @@ module Directory.Service where import Control.Concurrent (forkIO) +import Control.Concurrent.Async (race_) import Control.Concurrent.STM import Control.Exception (SomeException, try) import Control.Logger.Simple @@ -31,7 +32,7 @@ import Data.Either (fromRight) import Data.List (find, intercalate) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe, isJust, isNothing) +import Data.Maybe (fromMaybe, isJust, isNothing, maybeToList) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T @@ -51,12 +52,12 @@ import Simplex.Chat.Bot import Simplex.Chat.Bot.KnownContacts import Simplex.Chat.Controller import Simplex.Chat.Core -import Simplex.Chat.Markdown (Format (..), FormattedText (..), parseMaybeMarkdownList, viewName) +import Simplex.Chat.Markdown (Format (..), FormattedText (..), SimplexLinkType (..), parseMaybeMarkdownList, viewName) import Simplex.Chat.Messages import Simplex.Chat.Options -import Simplex.Chat.Protocol (MsgContent (..), memberSupportVoiceVersion) +import Simplex.Chat.Protocol (GroupShortLinkData (..), LinkOwnerSig (..), MsgChatLink (..), MsgContent (..), memberSupportVoiceVersion) import Simplex.Chat.Store.Direct (getContact) -import Simplex.Chat.Store.Groups (getGroupLink, getGroupMember, setGroupCustomData) -- TODO remove setGroupCustomData +import Simplex.Chat.Store.Groups (getGroupLink, getGroupMember, getGroupMemberByMemberId, setGroupCustomData) -- TODO remove setGroupCustomData import Simplex.Chat.Store.Profiles (GroupLinkInfo (..), getGroupLinkInfo) import Simplex.Chat.Store.Shared (StoreError (..)) import Simplex.Chat.Terminal (terminalChatConfig) @@ -65,7 +66,7 @@ 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 (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact) +import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ACreatedConnLink (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String import Simplex.Messaging.TMap (TMap) @@ -164,7 +165,7 @@ directoryServiceCLI st opts = do [ simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing, processEvents eventQ env ] - <> updateListingsThread_ opts env + <> maybeToList (updateListingsThread_ opts env) where processEvents eventQ env = forever $ do (cc, resp) <- atomically $ readTQueue eventQ @@ -174,8 +175,8 @@ directoryServiceCLI st opts = do updateListingDelay :: Int updateListingDelay = 5 * 60 * 1000000 -- update every 5 minutes -updateListingsThread_ :: DirectoryOpts -> ServiceState -> [IO ()] -updateListingsThread_ opts env = maybe [] (\f -> [updateListingsThread f]) $ webFolder opts +updateListingsThread_ :: DirectoryOpts -> ServiceState -> Maybe (IO ()) +updateListingsThread_ opts env = updateListingsThread <$> webFolder opts where updateListingsThread f = do cc <- atomically $ takeTMVar $ updateListingsJob env @@ -234,13 +235,10 @@ directoryService st opts cfg = do acceptMember = Just $ acceptMemberHook opts env } simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \user cc -> - raceAny_ $ - [ forever $ void getLine, - forever $ do - (_, resp) <- atomically . readTBQueue $ outputQ cc - directoryServiceEvent st opts env user cc resp - ] - <> updateListingsThread_ opts env + maybe id race_ (updateListingsThread_ opts env) $ + forever $ do + (_, resp) <- atomically . readTBQueue $ outputQ cc + directoryServiceEvent st opts env user cc resp acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole)) acceptMemberHook @@ -298,6 +296,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName DEContactLeftGroup ctId g -> deContactLeftGroup ctId g DEServiceRemovedFromGroup g -> deServiceRemovedFromGroup g DEGroupDeleted g -> deGroupDeleted g + DEChatLinkReceived {contact = ct, chatLink, ownerSig} -> deChatLinkReceived ct chatLink ownerSig + DEMemberUpdated {groupInfo = g, fromMember, toMember} -> deMemberUpdated g fromMember toMember DEUnsupportedMessage _ct _ciId -> pure () DEItemEditIgnored _ct -> pure () DEItemDeleteIgnored _ct -> pure () @@ -325,7 +325,19 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName let msg = "Error: " <> err <> ", group: " <> tshow groupId <> " " <> localDisplayName <> ", " <> T.pack e notifyAdminUsers msg logError msg - groupInfoText p@GroupProfile {description = d} = groupNameDescr p <> maybe "" ("\nWelcome message:\n" <>) d + groupInfoText p@GroupProfile {description = d, publicGroup} = groupNameDescr p <> maybe "" ("\nWelcome message:\n" <>) d <> linkToJoin + where + linkToJoin = case publicGroup of + Just pg@PublicGroupProfile {groupLink} -> + "\nLink to join " <> groupTypeStr' pg <> ": " <> strEncodeTxt groupLink + <> "\nYou need SimpleX Chat app v6.5 to join." + Nothing -> "" + membersCountStr GroupProfile {publicGroup} GroupSummary {currentMembers, publicMemberCount} = + let count = fromMaybe currentMembers publicMemberCount + label = case publicGroup of + Just PublicGroupProfile {groupType = GTChannel} -> " subscribers" + _ -> " members" + in tshow count <> label knockingStr :: Maybe GroupMemberAdmission -> [Text] knockingStr = \case Just GroupMemberAdmission {review = Just MCAll} -> ["New members are reviewed by admins"] @@ -342,6 +354,9 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName groupReference' groupId displayName = "ID " <> tshow groupId <> " (" <> displayName <> ")" groupAlreadyListed GroupInfo {groupProfile = p} = "The group " <> groupNameDescr p <> " is already listed in the directory, please choose another name." + ifPublicGroup :: GroupInfo -> IO () -> IO () -> IO () + ifPublicGroup GroupInfo {groupProfile = GroupProfile {publicGroup}} reject action = + if isJust publicGroup then reject else action getDuplicateGroup :: GroupInfo -> IO (Either String DuplicateGroup) getDuplicateGroup GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = @@ -375,7 +390,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName sendMessage cc ct $ ("Welcome to " <> serviceName <> "!\n\n") <> "πŸ” Send search string to find groups - try _security_.\n\ - \/help - how to submit your group.\n\ + \/help - how to submit your group or channel.\n\ \/new - recent groups.\n\n\ \[Directory rules](https://simplex.chat/docs/directory.html)." @@ -461,37 +476,68 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName byMember = case memberContactId m of Just ctId | ctId `isOwner` gr -> "" -- group registration owner, not any group owner. _ -> " by " <> mName -- owner notification from directory will include the name. - case groupRegStatus of - GRSPendingConfirmation -> pure () - GRSProposed -> pure () - GRSPendingUpdate -> - groupProfileUpdate >>= \case - GPNoServiceLink -> - notifyOwner gr $ "The profile updated for " <> userGroupRef <> byMember <> ", but the group link is not added to the welcome message." - GPServiceLinkAdded _ -> groupLinkAdded gr byMember - GPServiceLinkRemoved -> - notifyOwner gr $ - "The group link of " <> userGroupRef <> " is removed from the welcome message" <> byMember <> ", please add it." - GPHasServiceLink {} -> groupLinkAdded gr byMember - GPServiceLinkError -> do - notifyOwner gr $ - ("Error: " <> serviceName <> " has no group link for " <> userGroupRef) - <> " after profile was updated" - <> byMember - <> ". Please report the error to the developers." - logError $ "Error: no group link for " <> userGroupRef - GRSPendingApproval n -> processProfileChange gr byMember False $ n + 1 - GRSActive -> processProfileChange gr byMember True 1 - GRSSuspended -> processProfileChange gr byMember False 1 - GRSSuspendedBadRoles -> processProfileChange gr byMember False 1 - GRSRemoved -> pure () + case publicGroup p' of + Just pg -> case groupRegStatus of + GRSPendingApproval n -> publicGroupProfileChange pg gr byMember $ n + 1 + GRSActive -> publicGroupProfileChange pg gr byMember 1 + _ -> pure () + Nothing -> case groupRegStatus of + GRSPendingConfirmation -> pure () + GRSProposed -> pure () + GRSPendingUpdate -> + groupProfileUpdate >>= \case + GPNoServiceLink -> + notifyOwner gr $ "The profile updated for " <> userGroupRef <> byMember <> ", but the group link is not added to the welcome message." + GPServiceLinkAdded _ -> groupLinkAdded gr byMember + GPServiceLinkRemoved -> + notifyOwner gr $ + "The group link of " <> userGroupRef <> " is removed from the welcome message" <> byMember <> ", please add it." + GPHasServiceLink {} -> groupLinkAdded gr byMember + GPServiceLinkError -> do + notifyOwner gr $ + ("Error: " <> serviceName <> " has no group link for " <> userGroupRef) + <> " after profile was updated" + <> byMember + <> ". Please report the error to the developers." + logError $ "Error: no group link for " <> userGroupRef + GRSPendingApproval n -> processProfileChange gr byMember False $ n + 1 + GRSActive -> processProfileChange gr byMember True 1 + GRSSuspended -> processProfileChange gr byMember False 1 + GRSSuspendedBadRoles -> processProfileChange gr byMember False 1 + GRSRemoved -> pure () where GroupInfo {groupId, groupProfile = p} = fromGroup GroupInfo {groupProfile = p'} = toGroup sameProfile - GroupProfile {displayName = n, fullName = fn, shortDescr = sd, image = i, description = d, memberAdmission = ma} - GroupProfile {displayName = n', fullName = fn', shortDescr = sd', image = i', description = d', memberAdmission = ma'} = - n == n' && fn == fn' && i == i' && sd == sd' && (T.words <$> d) == (T.words <$> d') && ma == ma' + GroupProfile {displayName = n, fullName = fn, shortDescr = sd, image = i, description = d, memberAdmission = ma, publicGroup = pg} + GroupProfile {displayName = n', fullName = fn', shortDescr = sd', image = i', description = d', memberAdmission = ma', publicGroup = pg'} = + n == n' && fn == fn' && i == i' && sd == sd' && (T.words <$> d) == (T.words <$> d') && ma == ma' && pg == pg' + publicGroupProfileChange pg@PublicGroupProfile {groupLink} gr byMember n' = do + let gt = groupTypeStr' pg + userGroupRef = userGroupReference gr toGroup + groupRef = groupReference toGroup + link = ACL SCMContact $ CLShort groupLink + updatedNotification gr' g' = do + notifyOwner gr' $ + ("The " <> gt <> " " <> userGroupRef <> " is updated" <> byMember) + <> ".\nIt is hidden from the directory until approved." + notifyAdminUsers $ "The " <> gt <> " " <> groupRef <> " is updated" <> byMember <> "." + sendToApprove g' gr' n' + sendChatCmd cc (APIConnectPlan userId (Just link) True Nothing) >>= \case + Right (CRConnectionPlan _ _ (CPGroupLink (GLPKnown {groupInfo = g'}))) -> + case dbOwnerMemberId gr of + Just ownerGMId -> + withDB "getGroupMember" cc (\db -> withExceptT show $ getGroupMember db (vr cc) user groupId ownerGMId) >>= \case + Right ownerMember + | let GroupMember {memberRole = role} = ownerMember, role >= GROwner -> + setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') (`updatedNotification` g') + | otherwise -> do + setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \_ -> pure () + notifyOwner gr $ "The registration owner is no longer an owner. Registration suspended." + Left _ -> logError $ "could not find owner member for " <> groupRef + Nothing -> logError $ "no owner member set for " <> groupRef + _ -> + setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') (`updatedNotification` toGroup) groupLinkAdded gr byMember = getDuplicateGroup toGroup >>= \case Left e -> notifyOwner gr $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e @@ -644,7 +690,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName -- /audio is matched as text, not as DirectoryCmd, because it is only valid -- in group context at captcha stage, while DirectoryCmd is for DM commands. isAudioCmd = T.strip msgText == "/audio" - cmd = fromRight (ADC SDRUser DCUnknownCommand) $ A.parseOnly (directoryCmdP <* A.endOfInput) $ T.strip msgText + cmd = fromRight (ADC SDRUser DCUnknownCommand) $ A.parseOnly (directoryCmdP Nothing <* A.endOfInput) $ T.strip msgText atomically (TM.lookup gmId $ pendingCaptchas env) >>= \case Nothing | isAudioCmd && canSendVoiceCaptcha g m -> sendMemberCaptcha g m (Just ciId) noCaptcha 0 CMAudio @@ -661,7 +707,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName sendComposedMessages_ cc sendRef [(Just ciId, MCText audioAlreadyEnabled)] else sendComposedMessages_ cc sendRef [(Just ciId, MCText voiceCaptchaUnavailable)] | otherwise -> case cmd of - ADC SDRUser (DCSearchGroup _) -> do + ADC SDRUser (DCSearchGroup {}) -> do ts <- getCurrentTime if | ts `diffUTCTime` sentAt > captchaTTL -> sendMemberCaptcha g m (Just ciId) captchaExpired (attempts - 1) captchaMode @@ -704,11 +750,12 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName useMemberFilter image $ passCaptcha a sendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO () - sendToApprove GroupInfo {groupId, groupProfile = p@GroupProfile {displayName, image = image'}, groupSummary} GroupReg {dbContactId, promoted} gaId = do + sendToApprove GroupInfo {groupId, groupProfile = p@GroupProfile {displayName, image = image', publicGroup = pg_}, groupSummary} GroupReg {dbContactId, promoted} gaId = do ct_ <- getContact' cc user dbContactId - let membersStr = "_" <> tshow (currentMembers groupSummary) <> " members_\n" + let gt = maybe "group" groupTypeStr' pg_ + membersStr = "_" <> membersCountStr p groupSummary <> "_\n" text = - either (\_ -> "The group ID " <> tshow groupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the group ID " <> tshow groupId <> ": ") ct_ + either (\_ -> "The " <> gt <> " ID " <> tshow groupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the " <> gt <> " ID " <> tshow groupId <> ": ") ct_ <> ("\n" <> groupInfoText p <> "\n" <> membersStr <> "\nTo approve send:") msg = maybe (MCText text) (\image -> MCImage {text, image}) image' withAdminUsers $ \cId -> do @@ -771,63 +818,205 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName >>= mapM_ (\cm@GroupMember {memberRole} -> when (memberRole == GROwner && memberActive cm) action) deContactRemovedFromGroup :: ContactId -> GroupInfo -> IO () - deContactRemovedFromGroup ctId g@GroupInfo {groupId} = do + deContactRemovedFromGroup ctId g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do + let gt = maybe "group" groupTypeStr' pg_ logInfo $ "contact ID " <> tshow ctId <> " removed from group " <> viewGroupName g - withGroupReg g "contact removed" $ \gr -> do + withGroupReg g "contact removed" $ \gr -> when (ctId `isOwner` gr) $ setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr' -> do - notifyOwner gr' $ "You are removed from the group " <> userGroupReference gr' g <> ".\n\nThe group is no longer listed in the directory." - notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group owner is removed)." + notifyOwner gr' $ "You are removed from the " <> gt <> " " <> userGroupReference gr' g <> ".\n\nThe " <> gt <> " is no longer listed in the directory." + notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " owner is removed)." + when (isJust pg_) $ leavePublicGroup g deContactLeftGroup :: ContactId -> GroupInfo -> IO () - deContactLeftGroup ctId g@GroupInfo {groupId} = do + deContactLeftGroup ctId g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do + let gt = maybe "group" groupTypeStr' pg_ logInfo $ "contact ID " <> tshow ctId <> " left group " <> viewGroupName g - -- TODO combine withGroupReg g "contact left" $ \gr -> when (ctId `isOwner` gr) $ setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr' -> do - notifyOwner gr' $ "You left the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory." - notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group owner left)." + notifyOwner gr' $ "You left the " <> gt <> " " <> userGroupReference gr' g <> ".\n\nThe " <> gt <> " is no longer listed in the directory." + notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " owner left)." + when (isJust pg_) $ leavePublicGroup g deServiceRemovedFromGroup :: GroupInfo -> IO () - deServiceRemovedFromGroup g@GroupInfo {groupId} = do + deServiceRemovedFromGroup g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do + let gt = maybe "group" groupTypeStr' pg_ logInfo $ "service removed from group " <> viewGroupName g setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr -> do - notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory." - notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)." + notifyOwner gr $ serviceName <> " is removed from the " <> gt <> " " <> userGroupReference gr g <> ".\n\nThe " <> gt <> " is no longer listed in the directory." + notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (directory service is removed)." deGroupDeleted :: GroupInfo -> IO () - deGroupDeleted g@GroupInfo {groupId} = do + deGroupDeleted g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do + let gt = maybe "group" groupTypeStr' pg_ logInfo $ "group removed " <> viewGroupName g setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr -> do - notifyOwner gr $ "The group " <> userGroupReference gr g <> " is deleted.\n\nThe group is no longer listed in the directory." - notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group is deleted)." + notifyOwner gr $ "The " <> gt <> " " <> userGroupReference gr g <> " is deleted.\n\nThe " <> gt <> " is no longer listed in the directory." + notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " is deleted)." + + deChatLinkReceived :: Contact -> MsgChatLink -> Maybe LinkOwnerSig -> IO () + deChatLinkReceived ct (MCLGroup {connLink, groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}}) (Just ownerSig@LinkOwnerSig {ownerId = Just (B64UrlByteString oIdBytes)}) = + case groupType of + GTUnknown tag -> sendMessage cc ct $ "Unsupported group type: " <> T.pack (show tag) + gt -> do + let link = ACL SCMContact $ CLShort connLink + mId = MemberId oIdBytes + gt' = groupTypeStr gt + sendChatCmd cc (APIConnectPlan userId (Just link) True (Just ownerSig)) >>= \case + Right (CRConnectionPlan _ (ACCL SCMContact ccLink) plan) -> + handleGroupLinkPlan ct ccLink mId ownerSig gt' plan + _ -> sendMessage cc ct "Error: could not connect. Please report it to directory admins." + deChatLinkReceived ct (MCLGroup {groupProfile = GroupProfile {publicGroup = Just pg}}) _ = + sendMessage cc ct $ "To add a " <> groupTypeStr' pg <> " to directory you must be the owner." + deChatLinkReceived ct _ _ = + sendMessage cc ct "Only channels can be added to directory via link." + + groupTypeStr :: GroupType -> Text + groupTypeStr = \case + GTChannel -> "channel" + GTGroup -> "group" + GTUnknown _ -> "group" + + groupTypeStr' :: PublicGroupProfile -> Text + groupTypeStr' PublicGroupProfile {groupType} = groupTypeStr groupType + + leavePublicGroup :: GroupInfo -> IO () + leavePublicGroup GroupInfo {groupId} = + void $ sendChatCmd cc (APILeaveGroup groupId) + + handleGroupLinkPlan :: Contact -> CreatedLinkContact -> MemberId -> LinkOwnerSig -> Text -> ConnectionPlan -> IO () + handleGroupLinkPlan ct ccLink mId ownerSig gt = \case + CPGroupLink glp -> case glp of + GLPOk {groupSLinkData_, ownerVerification} -> case (groupSLinkData_, ownerVerification) of + (Just groupSLinkData, Just OVVerified) -> joinAndRegisterPublicGroup ct ccLink mId gt groupSLinkData + (_, Just (OVFailed reason)) -> sendMessage cc ct $ "Link signature verification failed: " <> reason <> ".\nYou must be the " <> gt <> " owner to register it." + (Nothing, _) -> sendMessage cc ct $ "Error: no " <> gt <> " information available via the link." + _ -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership. Please report it to directory admins." + GLPKnown {groupInfo = g, groupUpdated, ownerVerification} -> case ownerVerification of + Just OVVerified -> deReregistration ct g groupUpdated ownerSig + Just (OVFailed reason) -> sendMessage cc ct $ "Link signature verification failed: " <> reason <> ".\nYou must be the " <> gt <> " owner to register it." + Nothing -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership." + GLPConnectingProhibit _ -> sendMessage cc ct $ "Already connecting to this " <> gt <> "." + GLPConnectingConfirmReconnect -> sendMessage cc ct $ "Already connecting to this " <> gt <> "." + GLPNoRelays _ -> sendMessage cc ct $ T.toTitle gt <> " has no active relays. Please try again later." + GLPOwnLink _ -> sendMessage cc ct "Unexpected error. Please report it to directory admins." + _ -> sendMessage cc ct "Unexpected error. Please report it to directory admins." + + joinAndRegisterPublicGroup :: Contact -> CreatedLinkContact -> MemberId -> Text -> GroupShortLinkData -> IO () + joinAndRegisterPublicGroup ct ccLink mId gt groupSLinkData = do + let GroupShortLinkData {groupProfile = GroupProfile {displayName}} = groupSLinkData + ownerContact = GroupOwnerContact {contactId = contactId' ct, memberId = mId} + sendMessage cc ct $ "Joining the " <> gt <> " " <> displayName <> "…" + sendChatCmd cc (APIPrepareGroup userId ccLink False groupSLinkData) >>= \case + Right (CRNewPreparedChat _ (AChat SCTGroup (Chat (GroupChat gInfo _) _ _))) -> do + let gId = groupId' gInfo + addGroupReg notifyAdminUsers st cc ct gInfo GRSProposed $ \_ -> pure () + sendChatCmd cc (APIConnectPreparedGroup gId False (Just ownerContact) Nothing) >>= \case + Right CRStartedConnectionToGroup {groupInfo = gInfo'} -> + withDB "getGroupMember" cc (\db -> withExceptT show $ getGroupMemberByMemberId db (vr cc) user gInfo' mId) >>= \case + Right ownerMember -> + void $ setGroupRegOwner cc gId ownerMember + Left e -> do + logError $ "could not find owner member: " <> T.pack e + sendMessage cc ct "Error: could not find owner member after joining. Please report it to directory admins." + _ -> sendMessage cc ct $ "Error joining " <> gt <> " " <> displayName <> ", please re-send the link!" + _ -> sendMessage cc ct $ "Error joining " <> gt <> " " <> displayName <> ", please re-send the link!" + + deReregistration :: Contact -> GroupInfo -> Bool -> LinkOwnerSig -> IO () + deReregistration ct g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} profileChanged LinkOwnerSig {ownerId = Just (B64UrlByteString oIdBytes)} = do + let mId = MemberId oIdBytes + gt = maybe "group" groupTypeStr' pg_ + withDB "getGroupMemberByMemberId" cc (\db -> withExceptT show $ getGroupMemberByMemberId db (vr cc) user g mId) >>= \case + Right ownerMember@GroupMember {memberRole = role, memberStatus} -> + if + | role >= GROwner && memberStatus /= GSMemUnknown -> + getGroupReg cc groupId >>= \case + Right gr + | contactId' ct `isOwner` gr -> sameOwnerReregistration gr gt + | otherwise -> sendMessage cc ct $ "This " <> gt <> " is registered by another owner." + Left _ -> + addGroupReg notifyAdminUsers st cc ct g (GRSPendingApproval 1) $ \gr -> do + void $ setGroupRegOwner cc groupId ownerMember + sendToApprove g gr 1 + | role < GROwner -> sendMessage cc ct $ "You must be the " <> gt <> " owner to register it." + | otherwise -> sendMessage cc ct $ "Waiting for the owner member to be connected to the " <> gt <> "." + Left _ -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership. Please report it to directory admins." + where + sameOwnerReregistration gr gt = case groupRegStatus gr of + GRSProposed -> sendMessage cc ct $ "Registration is in progress, waiting for the owner member to be connected to the " <> gt <> "." + GRSPendingConfirmation -> pendingApprovalTransition gr gt 1 + GRSPendingUpdate -> pendingApprovalTransition gr gt 1 + GRSPendingApproval n + | profileChanged -> pendingApprovalTransition gr gt $ n + 1 + | otherwise -> sendMessage cc ct $ T.toTitle gt <> " is already pending approval." + GRSActive + | profileChanged -> pendingApprovalTransition gr gt 1 + | otherwise -> sendMessage cc ct $ T.toTitle gt <> " is already listed in the directory." + GRSSuspended -> sendMessage cc ct $ T.toTitle gt <> " is suspended by admin. Please contact support." + GRSSuspendedBadRoles -> pendingApprovalTransition gr gt 1 + GRSRemoved -> pendingApprovalTransition gr gt 1 + pendingApprovalTransition gr gt n = do + let userGroupRef = userGroupReference gr g + setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n) $ \gr' -> do + notifyOwner gr' $ + "The " <> gt <> " " <> userGroupRef <> " is submitted for approval.\nIt is hidden from the directory until approved." + sendToApprove g gr' n + deReregistration ct _ _ _ = + sendMessage cc ct "Error: could not verify ownership. Please report it to directory admins." + + deMemberUpdated :: GroupInfo -> GroupMember -> GroupMember -> IO () + deMemberUpdated g@GroupInfo {groupId, groupProfile = GroupProfile {displayName, publicGroup}} fromMember toMember = + withGroupReg g "owner member announced" $ \gr@GroupReg {groupRegStatus, dbOwnerMemberId} -> + when (groupRegStatus == GRSProposed && (dbOwnerMemberId == Just (groupMemberId' fromMember) || dbOwnerMemberId == Just (groupMemberId' toMember))) $ + let GroupMember {memberRole = role} = toMember + gt = maybe "group" groupTypeStr' publicGroup + in if role >= GROwner + then setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval 1) $ \gr' -> do + notifyOwner gr' $ "Joined the " <> gt <> " " <> displayName <> ". Registration is pending approval β€” it may take up to 48 hours." + sendToApprove g gr' 1 + else do + setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \_ -> pure () + sendMessage' cc (dbContactId gr) "The signing key does not belong to a current owner. Registration cancelled." deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO () deUserCommand ct ciId = \case DCHelp DHSRegistration -> sendMessage cc ct $ - "You must be the group owner to add it to the directory:\n\n\ - \1️⃣ *Invite* " + "You must be the group or channel owner to add it to the directory.\n\n\ + \*To register a channel*, use _Share via chat_ to send its link to " + <> serviceName + <> " bot.\n\n\ + \*To register a group*:\n\ + \1️⃣ *Invite* " <> serviceName <> " 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)." + \2️⃣ *Add* this link to the group's welcome message.\n\n\ + \Once your group or channel *approved*, it can be found here or at [simplex.chat/directory](https://simplex.chat/directory).\n\n\ + \_We usually review 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\ + \/help - how to register your group or channel to be added to directory.\n\ \/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\ \`/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 -> - sendFoundListedGroups (STSearch s) Nothing "No groups found" $ \gs n -> -- $ sendSearchResults s + DCSearchGroup s ft -> + sendFoundListedGroups (STSearch s) Nothing notFound $ \gs n -> let more = if n > length gs then ", sending top " <> tshow (length gs) else "" in "Found " <> tshow n <> " group(s)" <> more <> "." + where + notFound + | hasSimplexGroupLink ft = "No groups found.\nTo register a group or a channel, please use \"Share via chat\" feature." + | otherwise = "No groups found" + hasSimplexGroupLink = \case + Just fts -> any isGroupLink fts + Nothing -> False + isGroupLink (FormattedText (Just SimplexLink {linkType}) _) = linkType == XLGroup || linkType == XLChannel + isGroupLink _ = False DCSearchNext -> atomically (TM.lookup (contactId' ct) searchRequests) >>= \case Just SearchRequest {searchType, searchTime, lastGroup} -> do @@ -858,14 +1047,17 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName Left e -> sendReply $ "Error reading groups: " <> T.pack e Right gs -> sendGroupsInfo ct ciId isAdmin (gs, length gs) DCDeleteGroup gId gName -> - (if isAdmin then withGroupAndReg sendReply else withUserGroupReg) gId gName $ \GroupInfo {groupProfile = GroupProfile {displayName}} GroupReg {dbGroupId} -> do + (if isAdmin then withGroupAndReg sendReply else withUserGroupReg) gId gName $ \g@GroupInfo {groupProfile = GroupProfile {displayName, publicGroup = pg_}} GroupReg {dbGroupId} -> do + let gt = maybe "group" groupTypeStr' pg_ delGroupReg cc dbGroupId >>= \case Right () -> do logGDelete st dbGroupId - sendReply $ (if isAdmin then "The group " else "Your group ") <> displayName <> " is deleted from the directory" - Left e -> sendReply $ "Error deleting group " <> displayName <> ": " <> T.pack e + sendReply $ (if isAdmin then "The " <> gt <> " " else "Your " <> gt <> " ") <> displayName <> " is deleted from the directory" + when (isJust pg_) $ leavePublicGroup g + Left e -> sendReply $ "Error deleting " <> gt <> " " <> displayName <> ": " <> T.pack e DCMemberRole gId gName_ mRole_ -> - (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr -> do + (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr -> + ifPublicGroup g (sendReply "This command is not available for public groups.") $ do let GroupInfo {groupProfile = GroupProfile {displayName = n}} = g case mRole_ of Nothing -> @@ -885,7 +1077,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName initialRole n mRole = "The initial member role for the group " <> n <> " is set to *" <> textEncode mRole <> "*\n" onlyViaLink gLink = "*Please note*: it applies only to members joining via this link: " <> groupLinkText gLink DCGroupFilter gId gName_ acceptance_ -> - (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr -> do + (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr -> + ifPublicGroup g (sendReply "This command is not available for public groups.") $ do let GroupInfo {groupProfile = GroupProfile {displayName = n}} = g a = groupMemberAcceptance g case acceptance_ of @@ -916,39 +1109,42 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName Just PCAll -> "_enabled_" Just PCNoImage -> "_enabled for profiles without image_" DCShowUpgradeGroupLink gId gName_ -> - (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \GroupInfo {groupId, localDisplayName = gName} _ -> do - let groupRef = groupReference' gId gName - withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink groupId) $ - \GroupLink {connLinkContact = gLink@(CCLink _ sLnk_), acceptMemberRole, shortLinkDataSet, shortLinkLargeDataSet = BoolDef slLargeDataSet} -> do - let shouldBeUpgraded = isNothing sLnk_ || not shortLinkDataSet || not slLargeDataSet - sendReply $ - T.unlines $ - [ "The link to join the group " <> groupRef <> ":", - groupLinkText gLink, - "New member role: " <> textEncode acceptMemberRole - ] - <> ["The link is being upgraded..." | shouldBeUpgraded] - when shouldBeUpgraded $ do - let send = sendComposedMessage cc ct Nothing . MCText . T.unlines - withGroupLinkResult groupRef (sendChatCmd cc $ APIAddGroupShortLink groupId) $ - \GroupLink {connLinkContact = CCLink _ sLnk_'} -> case (sLnk_, sLnk_') of - (Just _, Just _) -> - send ["The group link is upgraded for: " <> groupRef, "No changes to group needed."] - (Nothing, Just sLnk) -> - sendComposedMessages - cc - (SRDirect $ contactId' ct) - [ MCText $ - T.unlines - [ "Please replace the old link in welcome message of your group " <> groupRef, - "If this is the only change, the group will remain listed in directory without re-approval.", - "", - "The new link:" - ], - MCText $ strEncodeTxt sLnk - ] - (_, Nothing) -> - send ["The short link is not created for " <> groupRef, "Please report it to the developers."] + (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}, localDisplayName = gName} _ -> case pg_ of + Just pg@PublicGroupProfile {groupLink} -> + sendReply $ "The link to join the " <> groupTypeStr' pg <> " " <> groupReference' gId gName <> ":\n" <> strEncodeTxt groupLink + Nothing -> do + let groupRef = groupReference' gId gName + withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink groupId) $ + \GroupLink {connLinkContact = gLink@(CCLink _ sLnk_), acceptMemberRole, shortLinkDataSet, shortLinkLargeDataSet = BoolDef slLargeDataSet} -> do + let shouldBeUpgraded = isNothing sLnk_ || not shortLinkDataSet || not slLargeDataSet + sendReply $ + T.unlines $ + [ "The link to join the group " <> groupRef <> ":", + groupLinkText gLink, + "New member role: " <> textEncode acceptMemberRole + ] + <> ["The link is being upgraded..." | shouldBeUpgraded] + when shouldBeUpgraded $ do + let send = sendComposedMessage cc ct Nothing . MCText . T.unlines + withGroupLinkResult groupRef (sendChatCmd cc $ APIAddGroupShortLink groupId) $ + \GroupLink {connLinkContact = CCLink _ sLnk_'} -> case (sLnk_, sLnk_') of + (Just _, Just _) -> + send ["The group link is upgraded for: " <> groupRef, "No changes to group needed."] + (Nothing, Just sLnk) -> + sendComposedMessages + cc + (SRDirect $ contactId' ct) + [ MCText $ + T.unlines + [ "Please replace the old link in welcome message of your group " <> groupRef, + "If this is the only change, the group will remain listed in directory without re-approval.", + "", + "The new link:" + ], + MCText $ strEncodeTxt sLnk + ] + (_, Nothing) -> + send ["The short link is not created for " <> groupRef, "Please report it to the developers."] where withGroupLinkResult groupRef a cb = a >>= \case @@ -1000,8 +1196,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName where msgs = replyMsg :| map foundGroup gs <> [moreMsg | moreGroups > 0] replyMsg = (Just ciId, MCText reply) - foundGroup (GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary = GroupSummary {currentMembers}}, _) = - let membersStr = "_" <> tshow currentMembers <> " members_" + foundGroup (GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary}, _) = + let membersStr = "_" <> membersCountStr p groupSummary <> "_" showId = if isAdmin then tshow groupId <> ". " else "" text = T.unlines $ [showId <> groupInfoText p, membersStr] ++ knockingStr memberAdmission in (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_) @@ -1014,40 +1210,49 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName withGroupAndReg sendReply groupId n $ \g gr@GroupReg {userGroupRegId = ugrId, promoted} -> case groupRegStatus gr of GRSPendingApproval gaId - | gaId == groupApprovalId -> + | gaId == groupApprovalId -> do + let GroupInfo {groupProfile = GroupProfile {publicGroup = pg_}} = g + isPublicGroup_ = isJust pg_ + gt = maybe "group" groupTypeStr' pg_ getDuplicateGroup g >>= \case Left e -> sendReply $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e - Right DGReserved -> sendReply $ "The group " <> groupRef <> " is already listed in the directory." - _ -> getGroupRolesStatus g gr >>= \case - Right GRSOk -> do - let grPromoted' - | promoted || knownCt `elem` superUsers = fromMaybe promoted promote - | otherwise = False - setGroupStatusPromo sendReply st env cc gr GRSActive grPromoted' $ do - 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" - <> "Supported 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.") - invited <- - forM ownersGroup $ \og@KnownGroup {localDisplayName = ogName} -> do - inviteToOwnersGroup og gr $ \case - Right () -> do - owner <- groupOwnerInfo groupRef $ dbContactId gr - pure $ "Invited " <> owner <> " to owners' group " <> viewName ogName - Left err -> pure err - sendReply $ "Group approved" <> (if grPromoted' then " (promoted)" else "") <> "!" <> maybe "" ("\n" <>) invited - notifyOtherSuperUsers $ approved <> " by " <> viewName (localDisplayName' ct) <> maybe "" ("\n" <>) invited - Right GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin - Right GRSContactNotOwner -> replyNotApproved "user is not an owner." - Right GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin - Left e -> sendReply $ "Error: getGroupRolesStatus. Please notify the developers.\n" <> T.pack e - where - replyNotApproved reason = sendReply $ "Group is not approved: " <> reason - serviceNotAdmin = serviceName <> " is not an admin." + Right DGReserved -> sendReply $ "The " <> gt <> " " <> groupRef <> " is already listed in the directory." + _ -> do + rolesOk <- if isPublicGroup_ then pure (Right GRSOk) else getGroupRolesStatus g gr + case rolesOk of + Right GRSOk -> do + let grPromoted' + | promoted || knownCt `elem` superUsers = fromMaybe promoted promote + | otherwise = False + setGroupStatusPromo sendReply st env cc gr GRSActive grPromoted' $ do + let approved = "The " <> gt <> " " <> userGroupReference' gr n <> " is approved" + let 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.") + notifyOwner gr $ + (approved <> " and listed in directory - please moderate it!\n") + <> "_Please note_: if you change the " <> gt <> " profile it will be hidden from directory until it is re-approved." + <> commands + invited <- + forM ownersGroup $ \og@KnownGroup {localDisplayName = ogName} -> do + inviteToOwnersGroup og gr $ \case + Right () -> do + owner <- groupOwnerInfo groupRef $ dbContactId gr + pure $ "Invited " <> owner <> " to owners' group " <> viewName ogName + Left err -> pure err + sendReply $ T.toTitle gt <> " approved" <> (if grPromoted' then " (promoted)" else "") <> "!" <> maybe "" ("\n" <>) invited + notifyOtherSuperUsers $ approved <> " by " <> viewName (localDisplayName' ct) <> maybe "" ("\n" <>) invited + Right GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin + Right GRSContactNotOwner -> replyNotApproved "user is not an owner." + Right GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin + Left e -> sendReply $ "Error: getGroupRolesStatus. Please notify the developers.\n" <> T.pack e + where + replyNotApproved reason = sendReply $ "Group is not approved: " <> reason + serviceNotAdmin = serviceName <> " is not an admin." | otherwise -> sendReply "Incorrect approval code" _ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval." where @@ -1189,7 +1394,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName GroupReg {userGroupRegId, groupRegStatus} = gr useGroupId = if isAdmin then groupId else userGroupRegId statusStr = "Status: " <> groupRegStatusText groupRegStatus - membersStr = "_" <> tshow (currentMembers groupSummary) <> " members_" + membersStr = "_" <> membersCountStr p groupSummary <> "_" cmds = "/'role " <> tshow useGroupId <> "', /'filter " <> tshow useGroupId <> "'" ownerStr = maybe "" (("Owner: " <>) . either (("getContact error: " <>) . T.pack) localDisplayName') ct_ text = T.unlines $ [tshow useGroupId <> ". " <> groupInfoText p] ++ [ownerStr | isAdmin] ++ [membersStr, statusStr] ++ knockingStr memberAdmission ++ [cmds] diff --git a/bots/api/COMMANDS.md b/bots/api/COMMANDS.md index ab3ec3d241..5ca2c4260a 100644 --- a/bots/api/COMMANDS.md +++ b/bots/api/COMMANDS.md @@ -1285,6 +1285,7 @@ Determine SimpleX link type and if the bot is already connected via this link. **Parameters**: - userId: int64 - connectionLink: string? +- resolveKnown: bool - linkOwnerSig: [LinkOwnerSig](./TYPES.md#linkownersig)? **Syntax**: diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index 23fc79b634..2e4f64dcdd 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -2290,6 +2290,8 @@ ConnectingProhibit: Known: - type: "known" - groupInfo: [GroupInfo](#groupinfo) +- groupUpdated: bool +- ownerVerification: [OwnerVerification](#ownerverification)? NoRelays: - type: "noRelays" @@ -2513,6 +2515,7 @@ Public: **Enum type**: - "channel" +- "group" --- diff --git a/bots/src/API/Docs/Types.hs b/bots/src/API/Docs/Types.hs index e2f67c88c6..de5b721b2d 100644 --- a/bots/src/API/Docs/Types.hs +++ b/bots/src/API/Docs/Types.hs @@ -294,7 +294,7 @@ chatTypesDocsData = (sti @GroupShortLinkInfo, STRecord, "", [], "", ""), (sti @GroupSummary, STRecord, "", [], "", ""), (sti @GroupSupportChat, STRecord, "", [], "", ""), - (sti @GroupType, STEnum1, "GT", ["GTUnknown"], "", ""), + (sti @GroupType, STEnum, "GT", ["GTUnknown"], "", ""), (sti @HandshakeError, STEnum, "", [], "", ""), (sti @InlineFileMode, STEnum, "IFM", [], "", ""), (sti @InvitationLinkPlan, STUnion, "ILP", [], "", ""), diff --git a/packages/simplex-chat-client/types/typescript/src/commands.ts b/packages/simplex-chat-client/types/typescript/src/commands.ts index 36692739dd..9c5c31ceb2 100644 --- a/packages/simplex-chat-client/types/typescript/src/commands.ts +++ b/packages/simplex-chat-client/types/typescript/src/commands.ts @@ -471,6 +471,7 @@ export namespace APIAddContact { export interface APIConnectPlan { userId: number // int64 connectionLink?: string + resolveKnown: boolean linkOwnerSig?: T.LinkOwnerSig } diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index 6f4f0b6525..08cb225cbc 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -2610,6 +2610,8 @@ export namespace GroupLinkPlan { export interface Known extends Interface { type: "known" groupInfo: GroupInfo + groupUpdated: boolean + ownerVerification?: OwnerVerification } export interface NoRelays extends Interface { @@ -2776,6 +2778,7 @@ export interface GroupSupportChat { export enum GroupType { Channel = "channel", + Group = "group", } export enum HandshakeError { diff --git a/plans/2026-04-19-directory-public-groups.md b/plans/2026-04-19-directory-public-groups.md new file mode 100644 index 0000000000..1b23234d14 --- /dev/null +++ b/plans/2026-04-19-directory-public-groups.md @@ -0,0 +1,324 @@ +# Directory Service β€” Public Group Registration via Chat Cards + +## Goal + +Enable directory registration of public groups (channels and future group types) via MCChat cards shared in DM with the bot. Replaces the admin-invitation flow with a signature-verified card flow. + +## Background + +### Current group registration flow +1. Owner invites bot as admin member +2. Bot joins, creates group link, asks owner to add link to welcome message +3. Owner updates profile with link β†’ bot sends for admin approval +4. Admin approves β†’ group listed + +This requires the bot to be admin. Public groups don't need this β€” they already have a public link, and ownership is proven via `ownerSig` on the MCChat card. + +### Public group identity +- `PublicGroupProfile {groupType :: GroupType, groupLink :: ShortLinkContact, publicGroupId :: B64UrlByteString}` +- `publicGroupId = sha256(rootKey)` β€” immutable identity +- `GroupType`: currently `GTChannel`, adding `GTGroup` for forward compatibility +- `GroupKeys {publicGroupId, groupRootKey, memberPrivKey}` β€” owner's signing keys +- `ownerId` in `LinkOwnerSig` = `B64UrlByteString (unMemberId memberId)` β€” the owner's MemberId bytes + +### ownerId-to-member mapping +- `LinkOwnerSig.ownerId = Just (B64UrlByteString unMemberId)` β€” same raw bytes as `MemberId` +- `createLinkOwnerMember` (called during `APIConnectPreparedGroup`, Commands.hs:2129) creates a member record with `memberRole = GROwner`, `memberStatus = GSMemUnknown`, `memberContactId = Nothing` +- `GroupMemberId` is available immediately after `APIConnectPreparedGroup` +- `getGroupMemberIdViaMemberId db user gInfo (MemberId ownerId)` looks up `GroupMemberId` from `MemberId` + +### Owner member activation +When a relay announces the pre-created `GSMemUnknown` member, `CEvtUnknownMemberAnnounced` fires (Subscriber.hs:2872, via `xGrpMemNew`). The member's profile and role are updated from the announcement's `MemberInfo` (via `updateUnknownMemberAnnounced`, Groups.hs:3010) β€” the role reflects the member's actual current role, not the pre-created `GROwner`. This event is not currently handled in directory Events.hs. + +### connectPlan and known groups +`apiConnectPlan` with `linkOwnerSig` returns: +- `GLPOk {groupSLinkData_, ownerVerification}` β€” new group +- `GLPKnown {groupInfo}` β€” bot already a member +- `GLPOwnLink` / `GLPConnectingProhibit` / `GLPConnectingConfirmReconnect` / `GLPNoRelays` + +**Gap**: For `GLPKnown`, `groupShortLinkPlan` short-circuits via `knownLinkPlans` β€” never resolves link data, never verifies signature. + +**Fix**: Add an optional parameter to `APIConnectPlan` (before `sig=`, since JSON must be last) that forces link data re-resolution even for known groups. With this parameter, `GLPKnown` includes `ownerVerification` and freshly loaded `groupSLinkData`. The loaded profile may differ from stored β€” the bot treats the server's current data as authoritative and updates its stored profile accordingly. + +**Future**: Add a signed version counter to link data to detect rollback attacks (malicious server serving old signed profiles). The bot would store the highest version seen and reject/flag version reductions. For now, the server is treated as authoritative. + +### Owner-contact association via APIConnectPreparedGroup +`createLinkOwnerMember` (called during `APIConnectPreparedGroup`) currently creates owner members with `memberContactId = Nothing`. Add an optional `(contactId, ownerId)` paired parameter to `APIConnectPreparedGroup`: when the link was received in a DM, pass the sender's `contactId` and the `ownerId` from `LinkOwnerSig`. The core sets `memberContactId` on the specific owner member whose `memberId` matches `ownerId`. + +This makes ALL existing directory event routing work: `DEContactRoleChanged`, `DEContactRemovedFromGroup`, `DEContactLeftGroup` all resolve via `memberContactId` β€” no new event types needed for owner tracking. + +Also benefits regular UI: when a user taps an owner's link in a DM, the contact association is created, improving the experience (e.g., showing the contact in the group member list). + +## Registration flow for public groups + +1. Owner taps "Share via chat" on their public group β†’ sends MCChat card to bot in DM +2. Bot receives `CEvtNewChatItems` with `MCChat` content in direct chat β†’ `DEChatLinkReceived` +3. Bot validates card (see validation matrix) +4. Bot calls `apiConnectPlan` with `connLink`, `linkOwnerSig`, and force-resolve flag +5. On `GLPOk` + `Verified`: bot replies "Joining {channel/group} {name}..." and joins via `APIPrepareGroup` then `APIConnectPreparedGroup` (passing owner's `contactId` and `ownerId`). On error: replies "Error joining {channel/group} {name}, please re-send the link!" (same pattern as existing group flow, Service.hs:368-370). +6. After `APIConnectPreparedGroup`, bot stores `dbOwnerMemberId` (via `getGroupMemberIdViaMemberId` β€” `createLinkOwnerMember` created the record during connect). Registration status: `GRSProposed`. +7. When `CEvtUnknownMemberAnnounced` fires for the owner member β†’ `DEOwnerMemberAnnounced` β†’ bot transitions to `GRSPendingApproval`, replies "Joined {channel/group} {name}. Registration is pending approval β€” it may take up to 48 hours.", sends to admins for approval +8. Admin approves β†’ `GRSActive` + +## Scenario matrix: card received in DM + +### Event + +One event: `DEChatLinkReceived { contact :: Contact, chatItemId :: ChatItemId, chatLink :: MsgChatLink, ownerSig :: Maybe LinkOwnerSig }`. + +Handler validates and replies based on content. + +### Card validation (handler level) + +| Condition | Action | +|---|---| +| `chatLink` is not MCLGroup, or MCLGroup but no `publicGroup` in profile | Reply: "Only channels can be added to directory via link." | +| MCLGroup + publicGroup but `ownerSig` is `Nothing` | Reply: "To add a {channel/group} to directory you must be the owner." | +| MCLGroup + publicGroup + `ownerSig` is `Just` | Proceed to connectPlan | + +### connectPlan results + +| Plan result | ownerVerification | Action | +|---|---|---| +| `GLPOk` + sLinkData | `Verified` | Reply "Joining {channel/group} {name}...", join (with contactId + ownerId), register as `GRSProposed` | +| `GLPOk` + sLinkData | `Failed reason` | Reply: "Link signature verification failed: {reason}.\nYou must be the {channel/group} owner to register it." | +| `GLPOk` + sLinkData | `Nothing` | Reply: "Error: could not verify {channel/group} ownership. Please report it to directory admins." | +| `GLPOk` no sLinkData | β€” | Reply: "Error: no {channel/group} information available via the link." | +| `GLPKnown` | `Verified` | Bot already member β€” handle as re-registration (see below) | +| `GLPKnown` | `Failed reason` | Reply: "Link signature verification failed: {reason}.\nYou must be the {channel/group} owner to register it." | +| `GLPKnown` | `Nothing` | Reply: "Error: could not verify ownership." | +| `GLPConnectingProhibit` | β€” | Reply: "Already connecting to this {channel/group}." | +| `GLPConnectingConfirmReconnect` | β€” | Reply: "Already connecting to this {channel/group}." | +| `GLPOwnLink` | β€” | Log error. Reply: "Unexpected error. Please report it to directory admins." | +| `GLPNoRelays` | β€” | Reply: "{Channel/Group} has no active relays. Please try again later." | + +### Owner member activation after joining + +Bot is in `GRSProposed`. The pre-created owner member has `GSMemUnknown` status. When the relay announces this member, `CEvtUnknownMemberAnnounced` fires β†’ mapped to `DEOwnerMemberAnnounced` in directory events. + +| Condition | Action | +|---|---| +| `CEvtUnknownMemberAnnounced` for member matching `dbOwnerMemberId`, announced role is `GROwner` | Transition to `GRSPendingApproval`, notify submitting contact, send for admin approval | +| `CEvtUnknownMemberAnnounced` for member matching `dbOwnerMemberId`, announced role < `GROwner` | Reply: "The signing key does not belong to a current owner. Registration cancelled." Set `GRSRemoved`. | +| Owner member never announced | Registration stays in `GRSProposed`. No timeout β€” manual cleanup via admin. | + +### Re-registration (GLPKnown β€” bot already member, signature verified at plan) + +With the `connectPlan` fix, `GLPKnown` now includes `ownerVerification` and fresh `groupSLinkData`. Only proceed if `Verified`. + +Bot extracts `ownerId`, looks up member via `getGroupMemberIdViaMemberId`, confirms `memberRole >= GROwner` AND `memberStatus` is active (not `GSMemUnknown`). The pre-created member has `GROwner` role from creation, so role alone is insufficient β€” the member must have been announced by a relay to confirm actual presence in the group. + +Look up existing `GroupReg` by `groupId`: + +| Existing registration | Ownership verified | Action | +|---|---|---| +| No GroupReg found | Yes | Create new registration as `GRSPendingApproval` | +| GroupReg exists, same owner contact | Yes | Handle based on current status (see status matrix) | +| GroupReg exists, different contact | Sender is verified owner AND previous registrant no longer owner (check `dbOwnerMemberId` member's current role) | Transfer: update `dbContactId` and `dbOwnerMemberId`, proceed as same-owner case | +| GroupReg exists, different contact | Sender is verified owner BUT previous registrant still owner | Reply: "This {channel/group} is registered by another owner." | +| GroupReg exists, different contact | Sender NOT verified owner | Reply: "You must be the {channel/group} owner to register it." Additionally: check if previous registrant (via `dbOwnerMemberId`) is still owner. If not β†’ suspend (`GRSSuspendedBadRoles`). | + +### Re-registration by same owner β€” status matrix + +| Current status | Action | +|---|---| +| `GRSProposed` | Only if owner member is active (not `GSMemUnknown`): transition to `GRSPendingApproval`, send for approval. If still `GSMemUnknown`: reply "Waiting for owner to connect to the {channel/group}." | +| `GRSPendingConfirmation` | Transition to `GRSPendingApproval`, send for approval (only if previously registered via admin-invitation flow) | +| `GRSPendingUpdate` | Transition to `GRSPendingApproval`, send for approval (only if previously registered via admin-invitation flow) | +| `GRSPendingApproval n` | Check if profile changed (fresh profile from connectPlan vs bot's current DB). If yes: increment approval ID, re-send. If no: reply "Already pending approval." | +| `GRSActive` | Check if profile changed. If yes: transition to `GRSPendingApproval`, re-send. If no: reply "Already listed in the directory." | +| `GRSSuspended` | Reply: "{Channel/Group} is suspended by admin. Contact support." | +| `GRSSuspendedBadRoles` | Ownership re-verified at plan. Transition to `GRSPendingApproval`, send for approval. | +| `GRSRemoved` | Re-register as `GRSPendingApproval` | + +### Profile change detection + +For re-registration: compare the freshly loaded profile (from connectPlan's re-resolved `groupSLinkData`) against the group's current profile in the bot's database. + +For XGrpInfo updates: re-resolve the link via `apiConnectPlan` with `resolve=on`, compare freshly loaded link profile against bot's stored profile. + +Uses the same `sameProfile` comparison as existing group flow (Service.hs:491-494), extended with `publicGroup` field: `displayName`, `fullName`, `shortDescr`, `image`, `description`, `memberAdmission`, `publicGroup` β€” any difference triggers re-approval. The `publicGroup` field includes `groupLink` (ShortLinkContact), so link regeneration by the owner also triggers re-approval. + +## Profile updates via XGrpInfo (bot is subscriber) + +Bot receives `DEGroupUpdated` when any member updates the group profile. Works for subscribers. + +For public groups: skip "link in welcome message" check. First check if the profile actually changed using the same `sameProfile` comparison as for regular groups (`displayName`, `fullName`, `shortDescr`, `image`, `description`, `memberAdmission`). Only if changed, call `apiConnectPlan` with `resolve=on` to re-resolve the link data. Compare the resolved link profile against the bot's stored profile. + +Note: `xGrpInfo` (Subscriber.hs:3172) prevents `publicGroup` removal and `publicGroupId` changes for channels β€” these cases can never occur. The `groupLink` (ShortLinkContact) CAN change if the owner regenerates the link; the bot's DB is updated via XGrpInfo and subsequent re-resolution uses the current link. + +| Current status | Profile changed (link data vs stored) | Action | +|---|---|---| +| `GRSProposed` | Any | No action (waiting for owner activation) | +| `GRSPendingApproval n` | Yes | Increment approval ID, re-send for approval | +| `GRSPendingApproval n` | No | No action | +| `GRSActive` | Yes | Transition to `GRSPendingApproval`, notify owner, re-send | +| `GRSActive` | No | No action | +| `GRSSuspended` | Any | No action | +| `GRSSuspendedBadRoles` | Any | No action | +| `GRSRemoved` | Any | No action | + +## Owner tracking + +### Owner-contact association + +When the bot connects via `APIConnectPreparedGroup` with the submitting contact's `contactId` and `ownerId`, the core sets `memberContactId` on the specific pre-created owner member whose `memberId` matches `ownerId`. This makes all existing event routing work: `DEContactRoleChanged`, `DEContactRemovedFromGroup`, `DEContactLeftGroup` resolve via `memberContactId`. + +### Owner changes + +| Event | Detection | Action | +|---|---|---| +| Owner loses owner role | `DEContactRoleChanged` (works via `memberContactId` set at connect time) | Transition to `GRSSuspendedBadRoles`, notify | +| Owner leaves group | `DEContactLeftGroup` | Transition to `GRSRemoved`, notify, leave group | +| Owner removed from group | `DEContactRemovedFromGroup` | Transition to `GRSRemoved`, notify, leave group | +| Non-owner sends card, current registrant no longer owner | Re-registration flow detects stale ownership | Suspend (`GRSSuspendedBadRoles`). Non-owner's card also checked: if their `ownerId` resolves to a non-owner member, and the current registrant is also not owner β†’ suspend. | +| New owner sends card, current registrant no longer owner | Re-registration flow, verified | Transfer registration | + +## Commands for public group registrations + +Bot is subscriber (not admin): +- `/filter` β€” Reply: "This command is not available for public groups." +- `/role` β€” Reply: "This command is not available for public groups." +- `/link` β€” Show `PublicGroupProfile.groupLink` with appropriate message. +- `/delete` β€” Remove registration, bot leaves group (`APILeaveGroup`). +- `/list` β€” Works as before, includes public group registrations. + +## De-registration + +| Event | Action | +|---|---| +| Owner sends `/delete ID:NAME` | Delete registration, reply confirmation, leave group | +| Bot removed (`DEServiceRemovedFromGroup`) | Set `GRSRemoved`, notify | +| Group deleted (`DEGroupDeleted`) | Set `GRSRemoved`, notify | +| Owner leaves (`DEContactLeftGroup`) | Set `GRSRemoved`, notify, leave group | +| Owner removed (`DEContactRemovedFromGroup`) | Set `GRSRemoved`, notify, leave group | +| Admin sends `/suspend ID:NAME` | Set `GRSSuspended`, notify, do NOT leave group | + +Bot leaves group only for public group registrations (regular groups preserve existing behavior). + +## Code changes + +### 1. GroupType β€” add GTGroup + +`Types.hs`: +```haskell +data GroupType = GTChannel | GTGroup | GTUnknown Text +``` + +### 2. connectPlan β€” force-resolve parameter + +Add optional parameter to `APIConnectPlan` (before `sig=`): `resolve=on`. When present, `groupShortLinkPlan` skips the `knownLinkPlans` shortcut and always resolves link data. `GLPKnown` extended with `ownerVerification` and `groupSLinkData_`: +```haskell +GLPKnown {groupInfo :: GroupInfo, ownerVerification :: Maybe OwnerVerification, groupSLinkData_ :: Maybe GroupShortLinkData} +``` + +Parser: `/_connect plan [resolve=on] [sig=]` + +### 3. APIConnectPreparedGroup β€” optional (contactId, ownerId) + +Add optional paired `(contactId, ownerId)` parameter to `APIConnectPreparedGroup`. When present, `createLinkOwnerMember` (called during connect, Commands.hs:2129) sets `memberContactId` on the specific owner member whose `memberId` matches the provided `ownerId`. + +Current parser (Commands.hs:5045): `/_connect group # [incognito=on] []` +New parser: `/_connect group # [contact= owner=] [incognito=on] []` + +`contact` and `owner` are paired β€” both required together. `ownerId` identifies which pre-created owner member gets the `memberContactId` set (multiple owners possible via OwnerAuth chain). + +Current type (Controller.hs:479): `APIConnectPreparedGroup GroupId IncognitoEnabled (Maybe MsgContent)` +New type: `APIConnectPreparedGroup GroupId (Maybe (ContactId, B64UrlByteString)) IncognitoEnabled (Maybe MsgContent)` + +This also benefits the UI: when tapping an owner's link in a DM, the contactId is threaded through the connect alert to `APIConnectPreparedGroup`, creating the association. + +### 4. Events.hs β€” new events + +`DEChatLinkReceived` β€” fires for ALL MCChat messages in DM (any `MsgChatLink` variant, signed or unsigned): +```haskell +| DEChatLinkReceived + { contact :: Contact, + chatItemId :: ChatItemId, + chatLink :: MsgChatLink, + ownerSig :: Maybe LinkOwnerSig + } +``` + +`DEOwnerMemberAnnounced` (from `CEvtUnknownMemberAnnounced`): +```haskell +| DEOwnerMemberAnnounced GroupInfo GroupMember GroupMember + -- ^ groupInfo, unknownMember, announcedMember +``` + +In `crDirectoryEvent_`, extend `CEvtNewChatItems` for direct chat: +```haskell +(MCChat {chatLink, ownerSig}, Nothing) -> DEChatLinkReceived ct ciId chatLink ownerSig +``` + +Add `CEvtUnknownMemberAnnounced` handler: +```haskell +CEvtUnknownMemberAnnounced {groupInfo, unknownMember, announcedMember} -> + Just $ DEOwnerMemberAnnounced groupInfo unknownMember announcedMember +``` + +### 5. Service.hs β€” public group link handler + +`deChatLinkReceived`: validates card, calls `apiConnectPlan` (with `resolve=on`), handles per scenario matrix. The link string comes from `MCLGroup.connLink` (`ShortLinkContact`) formatted as URI β€” passed via command string, parsed inside the handler. For `GLPOk` + `Verified`: joins (with contactId + ownerId), stores `dbOwnerMemberId`, registers as `GRSProposed`. On join error: replies to owner (same pattern as Service.hs:368-370). For `GLPKnown` + `Verified`: re-registration flow. + +### 6. Service.hs β€” owner member announced handler + +`deOwnerMemberAnnounced`: checks if the announced member's `GroupMemberId` matches `dbOwnerMemberId` of any `GRSProposed` registration. If yes and role is `GROwner`: transition to `GRSPendingApproval`, notify, send for approval. If role < `GROwner`: cancel. + +### 7. Service.hs β€” deGroupUpdated changes + +For public groups (`groupProfile.publicGroup` present), skip "link in welcome message" check. On profile change, call `apiConnectPlan` with `resolve=on` to get authoritative link data. Compare resolved profile against stored. If different, trigger re-approval. + +### 8. Service.hs β€” command restrictions and de-registration + +Check `groupProfile.publicGroup` for `/filter`, `/role`. On `/delete` for public groups, call `APILeaveGroup`. Same for owner departure/removal events. + +### 9. Help message update + +``` +To register a channel, share its link with this bot using the "Share via chat" button. +To register a group, invite this bot as admin. +``` + +### 10. Approval message for admins + +Include: group name, description, image, member count, "Registered via link sharing (signed by owner)", publicGroupId. + +### 11. Tests + +**Registration:** +- Share signed card β†’ bot joins, owner announced, pending approval +- Share unsigned card β†’ "must be owner" reply +- Share non-MCLGroup / non-public-group card β†’ "only channels" reply +- Share card with invalid signature β†’ rejection with reason +- Share card, owner never announced β†’ stays GRSProposed +- Share card, owner announced but role < GROwner β†’ cancelled + +**Re-registration (GLPKnown, verified):** +- Same owner re-shares, active β†’ "already listed" +- Same owner re-shares, pending β†’ "already pending" +- Same owner re-shares with changed profile β†’ re-approval +- Different contact, verified owner, previous no longer owner β†’ transfer +- Different contact, verified owner, previous still owner β†’ "registered by another owner" +- Different contact, not owner β†’ rejection + stale ownership check +- Same owner re-shares while GRSProposed, owner still GSMemUnknown β†’ "waiting for owner" + +**Profile updates:** +- XGrpInfo on active public group β†’ re-approval +- XGrpInfo on pending public group β†’ increment approval ID +- XGrpInfo on public group skips link-in-welcome check + +**Owner tracking (via contactId association):** +- Owner role changed β†’ suspension +- Owner leaves β†’ removal, bot leaves +- Owner removed β†’ removal, bot leaves + +**De-registration:** +- `/delete` by owner β†’ removal, bot leaves +- Bot removed β†’ removal +- Admin `/suspend` β†’ suspension, bot stays + +**Commands:** +- `/filter` on public group β†’ disabled +- `/role` on public group β†’ disabled +- `/link` on public group β†’ shows public link diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index e989e520a5..a7f4ceced0 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -470,13 +470,13 @@ data ChatCommand | AddContact IncognitoEnabled | APISetConnectionIncognito Int64 IncognitoEnabled | APIChangeConnectionUser Int64 UserId -- new user id to switch connection to - | APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectionLink is used to report link parsing failure as special error + | APIConnectPlan {userId :: UserId, connectionLink :: Maybe AConnectionLink, resolveKnown :: Bool, linkOwnerSig :: Maybe LinkOwnerSig} -- Maybe AConnectionLink is used to report link parsing failure as special error | APIPrepareContact UserId ACreatedConnLink ContactShortLinkData | APIPrepareGroup UserId CreatedLinkContact DirectLink GroupShortLinkData | APIChangePreparedContactUser ContactId UserId | APIChangePreparedGroupUser GroupId UserId | APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent} - | APIConnectPreparedGroup GroupId IncognitoEnabled (Maybe MsgContent) + | APIConnectPreparedGroup {groupId :: GroupId, incognito :: IncognitoEnabled, ownerContact :: Maybe GroupOwnerContact, msgContent_ :: Maybe MsgContent} | APIConnect {userId :: UserId, incognito :: IncognitoEnabled, preparedLink_ :: Maybe ACreatedConnLink} -- Maybe is used to report link parsing failure as special error | Connect {incognito :: IncognitoEnabled, connLink_ :: Maybe AConnectionLink} | APIConnectContactViaAddress UserId IncognitoEnabled ContactId @@ -1037,7 +1037,7 @@ data GroupLinkPlan | GLPOwnLink {groupInfo :: GroupInfo} | GLPConnectingConfirmReconnect | GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo} - | GLPKnown {groupInfo :: GroupInfo} + | GLPKnown {groupInfo :: GroupInfo, groupUpdated :: Bool, ownerVerification :: Maybe OwnerVerification} | GLPNoRelays {groupSLinkData_ :: Maybe GroupShortLinkData} deriving (Show) @@ -1046,6 +1046,12 @@ data OwnerVerification | OVFailed {reason :: Text} deriving (Show) +data GroupOwnerContact = GroupOwnerContact + { contactId :: ContactId, + memberId :: MemberId + } + deriving (Show) + type DirectLink = Bool data GroupShortLinkInfo = GroupShortLinkInfo diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 042280e062..7a5309164b 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1978,9 +1978,9 @@ processChatCommand vr nm = \case createDirectConnection db newUser agConnId ccLink' Nothing ConnNew Nothing subMode initialChatVersion PQSupportOn deleteAgentConnectionAsync (aConnId' conn) pure conn' - APIConnectPlan userId (Just cLink) linkOwnerSig_ -> withUserId userId $ \user -> - uncurry (CRConnectionPlan user) <$> connectPlan user cLink linkOwnerSig_ - APIConnectPlan _ Nothing _ -> throwChatError CEInvalidConnReq + APIConnectPlan userId (Just cLink) resolveKnown linkOwnerSig_ -> withUserId userId $ \user -> + uncurry (CRConnectionPlan user) <$> connectPlan user cLink resolveKnown linkOwnerSig_ + APIConnectPlan _ Nothing _ _ -> throwChatError CEInvalidConnReq APIPrepareContact userId accLink contactSLinkData -> withUserId userId $ \user -> do let ContactShortLinkData {profile, message, business} = contactSLinkData welcomeSharedMsgId <- forM message $ \_ -> getSharedMsgId @@ -2100,7 +2100,7 @@ processChatCommand vr nm = \case toView $ CEvtNewChatItems user [ci] pure $ CRStartedConnectionToContact user ct' customUserProfile CVRConnectedContact ct' -> pure $ CRContactAlreadyExists user ct' - APIConnectPreparedGroup groupId incognito msgContent_ -> withUser $ \user -> do + APIConnectPreparedGroup {groupId, incognito, ownerContact, msgContent_} -> withUser $ \user -> do gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId case gInfo of GroupInfo {preparedGroup = Nothing} -> throwCmdError "group doesn't have link to connect" @@ -2126,8 +2126,12 @@ processChatCommand vr nm = \case gInfo' <- withFastStore $ \db -> do gInfo' <- updatePreparedRelayedGroup db vr user gInfo mainCReq cReqHash incognitoProfile rootKey memberPrivKey publicMemberCount_ -- Pre-emptively create owner members with trusted keys from link data - forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> - void $ createLinkOwnerMember db vr user gInfo' (MemberId ownerId) ownerKey + forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> do + let ctId_ = case ownerContact of + Just GroupOwnerContact {contactId, memberId} + | memberId == MemberId ownerId -> Just contactId + _ -> Nothing + void $ createLinkOwnerMember db vr user gInfo' ctId_ (MemberId ownerId) ownerKey pure gInfo' rs <- mapConcurrently (connectToRelay gInfo') relays let relayFailed = \case (_, _, Left _) -> True; _ -> False @@ -2221,7 +2225,7 @@ processChatCommand vr nm = \case Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do -- TODO [relays] member: /c api to support groups with relays -- TODO - possibly by going through APIPrepareGroup -> APIConnectPreparedGroup - (ccLink, plan) <- connectPlan user cLink Nothing `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing Nothing)); _ -> throwError e + (ccLink, plan) <- connectPlan user cLink False Nothing `catchAllErrors` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing Nothing)); _ -> throwError e connectWithPlan user incognito ccLink plan Connect _ Nothing -> throwChatError CEInvalidConnReq APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do @@ -3978,8 +3982,8 @@ processChatCommand vr nm = \case pure (gId, chatSettings) _ -> throwCmdError "not supported" processChatCommand vr nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings - connectPlan :: User -> AConnectionLink -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan) - connectPlan user (ACL SCMInvitation cLink) sig_ = case cLink of + connectPlan :: User -> AConnectionLink -> Bool -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan) + connectPlan user (ACL SCMInvitation cLink) _ sig_ = case cLink of CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing Nothing CLShort l -> do let l' = serverShortLink l @@ -4000,7 +4004,7 @@ processChatCommand vr nm = \case invitationReqAndPlan cReq sLnk_ cld ov = do plan <- invitationRequestPlan user cReq cld ov `catchAllErrors` (pure . CPError) pure (ACCL SCMInvitation (CCLink cReq sLnk_), plan) - connectPlan user (ACL SCMContact cLink) sig_ = case cLink of + connectPlan user (ACL SCMContact cLink) resolveKnown sig_ = case cLink of CLFull cReq -> do plan <- contactOrGroupRequestPlan user cReq `catchAllErrors` (pure . CPError) pure (ACCL SCMContact $ CCLink cReq Nothing, plan) @@ -4033,9 +4037,11 @@ processChatCommand vr nm = \case where l' = serverShortLink l con cReq = ACCL SCMContact $ CCLink cReq (Just l') - gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g)) + gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g False Nothing)) groupShortLinkPlan = knownLinkPlans >>= \case + Just (_, CPGroupLink (GLPKnown g _ _)) + | resolveKnown -> resolveKnownGroup g Just r -> pure r Nothing -> do (fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l' @@ -4045,8 +4051,6 @@ processChatCommand vr nm = \case else do let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId} - -- Cross-validate linkEntityId and publicGroupId from profile: - -- for channels both must be present and match, for p2p groups both must be absent let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} -> fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup case (B64UrlByteString <$> linkEntityId, profilePGId) of @@ -4061,6 +4065,15 @@ processChatCommand vr nm = \case liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g)) Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l' + resolveKnownGroup g@GroupInfo {groupProfile = p} = do + (fd@FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' nm user l' + groupSLinkData_ <- liftIO $ decodeLinkUserData cData + let ov = verifyLinkOwner rk owners l' sig_ + (g', updated) <- case groupSLinkData_ of + Just GroupShortLinkData {groupProfile} + | p /= groupProfile -> (,True) <$> withStore (\db -> updateGroupProfile db user g groupProfile) + _ -> pure (g, False) + pure (con (linkConnReq fd), CPGroupLink (GLPKnown g' updated ov)) connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse connectWithPlan user@User {userId} incognito ccLink plan | connectionPlanProceed plan = do @@ -4140,10 +4153,10 @@ processChatCommand vr nm = \case (Just gInfo, _) -> groupPlan gInfo linkInfo gld ov groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan groupPlan gInfo@GroupInfo {membership} linkInfo gld ov - | memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo) + | memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo False ov) | not (memberActive membership) && not (memberRemoved membership) = pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo) - | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo) + | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo False ov) | otherwise = pure $ CPGroupLink (GLPOk linkInfo gld ov) contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact) contactCReqSchemas crData = @@ -5051,13 +5064,13 @@ chatCommandP = (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayNameP <* A.space <* char_ '@' <*> (Just <$> displayNameP) <* A.space <*> quotedMsg <*> msgTextP), "/_contacts " *> (APIListContacts <$> A.decimal), "/contacts" $> ListContacts, - "/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> optional (" sig=" *> jsonP)), + "/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> ((" resolve=" *> onOffP) <|> pure False) <*> optional (" sig=" *> jsonP)), "/_prepare contact " *> (APIPrepareContact <$> A.decimal <* A.space <*> connLinkP <* A.space <*> jsonP), "/_prepare group " *> (APIPrepareGroup <$> A.decimal <* A.space <*> connLinkP' <*> (" direct=" *> onOffP <|> pure True) <* A.space <*> jsonP), "/_set contact user @" *> (APIChangePreparedContactUser <$> A.decimal <* A.space <*> A.decimal), "/_set group user #" *> (APIChangePreparedGroupUser <$> A.decimal <* A.space <*> A.decimal), "/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)), - "/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)), + "/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> ownerContactP) <*> optional (A.space *> msgContentP)), "/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP), "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP_), "/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP), @@ -5187,6 +5200,7 @@ chatCommandP = ((Just <$> connLinkP) <|> A.takeTill (== ' ') $> Nothing) incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False + ownerContactP = "contact=" *> (GroupOwnerContact <$> A.decimal <* " owner=" <*> strP) imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,") imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P)) chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char '*' $> CTLocal <|> A.char ':' $> CTContactConnection diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index e92622b60c..5d99491b01 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -2917,8 +2917,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = GCHostMember -> withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right existingMember - | useRelays' gInfo -> - void $ withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo + | useRelays' gInfo -> do + updatedMember <- withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo + toView $ CEvtGroupMemberUpdated user gInfo existingMember updatedMember | otherwise -> messageError "x.grp.mem.intro ignored: member already exists" Left _ diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index c4e7210637..3f5414a1d8 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -2966,8 +2966,8 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g where VersionRange minV maxV = vr -createLinkOwnerMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember -createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId ownerKey = do +createLinkOwnerMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Maybe ContactId -> MemberId -> C.PublicKeyEd25519 -> ExceptT StoreError IO GroupMember +createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId} contactId_ memberId ownerKey = do currentTs <- liftIO getCurrentTime let memberProfile = profileFromName $ nameFromMemberId memberId (localDisplayName, profileId) <- createNewMemberProfile_ db user memberProfile currentTs @@ -2983,7 +2983,7 @@ createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (groupId, indexInGroup, memberId, GROwner, GCPreMember, GSMemUnknown, Binary B.empty, fromInvitedBy userContactId IBUnknown) - :. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, ownerKey, currentTs, currentTs) + :. (userId, localDisplayName, contactId_, profileId, ownerKey, currentTs, currentTs) :. (minV, maxV) ) groupMemberId <- liftIO $ insertedRowId db diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 6ddc411fff..6fb55c84ce 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -769,15 +769,18 @@ fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contact data GroupType = GTChannel + | GTGroup | GTUnknown Text deriving (Eq, Show) instance TextEncoding GroupType where textEncode = \case GTChannel -> "channel" + GTGroup -> "group" GTUnknown tag -> tag textDecode s = Just $ case s of "channel" -> GTChannel + "group" -> GTGroup tag -> GTUnknown tag instance FromField GroupType where fromField = fromTextField_ textDecode diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ce0f55cf01..2bd48d297a 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -2103,7 +2103,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"] GLPConnectingProhibit Nothing -> [grpLink "connecting"] GLPConnectingProhibit (Just g) -> connecting g - GLPKnown g@GroupInfo {preparedGroup, membership = m} -> case preparedGroup of + GLPKnown g@GroupInfo {preparedGroup, membership = m} _ _ -> case preparedGroup of Just PreparedGroup {connLinkStartedConnection} -> case memberStatus m of GSMemUnknown | connLinkStartedConnection -> connecting g diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 852e4cf4c4..bf2f1c8128 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -7,7 +7,9 @@ module Bots.DirectoryTests where import ChatClient +import ChatTests.ChatRelays (withRelay) import ChatTests.DBUtils +import ChatTests.Groups (memberJoinChannel, prepareChannel1Relay) import ChatTests.Utils import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Exception (finally) @@ -85,6 +87,12 @@ directoryServiceTests = do describe "help commands" $ do it "should not list audio command" testHelpNoAudio it "should reject audio command in DM" testAudioCommandInDM + describe "public group registration" $ do + it "should register channel via shared link card" testRegisterChannelViaCard + it "should suggest share via chat when link sent as text" testLinkAsTextSearch + it "should reject card shared by non-owner" testNonOwnerSharesCard + it "should delete channel registration and leave" testDeleteChannelRegistration + it "should handle re-registration when already listed" testReregistrationAlreadyListed directoryProfile :: Profile directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing} @@ -1771,7 +1779,7 @@ u `connectVia` dsLink = do u .<# "> Welcome to SimpleX Directory!" u <## "" u <## "πŸ” Send search string to find groups - try security." - u <## "/help - how to submit your group." + u <## "/help - how to submit your group or channel." u <## "/new - recent groups." u <## "" u <## "[Directory rules](https://simplex.chat/docs/directory.html)." @@ -1922,7 +1930,7 @@ testHelpNoAudio ps = -- commands help should not mention /audio bob #> "@'SimpleX Directory' /help commands" bob <# "'SimpleX Directory'> /'help commands' - receive this help message." - bob <## "/help - how to register your group to be added to directory." + bob <## "/help - how to register your group or channel to be added to directory." 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." @@ -1940,6 +1948,201 @@ testAudioCommandInDM ps = bob <# "'SimpleX Directory'> > /audio" bob <## " Unknown command" +testRegisterChannelViaCard :: HasCallStack => TestParams -> IO () +testRegisterChannelViaCard ps = + withDirectoryServiceCfg ps testCfg $ \superUser dsLink -> + withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> + withRelay ps $ \relay -> do + -- bob connects to directory service first + bob `connectVia` dsLink + -- bob creates a channel with a relay + (_shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay + -- bob shares the channel card with directory bot + bob ##> "/share chat #news @'SimpleX Directory'" + bob <# "@'SimpleX Directory' link to join channel #news (signed):" + _ <- getTermLine bob -- short link + _ <- getTermLine bob -- ownerSig JSON + -- directory bot validates and joins via relay + bob <# "'SimpleX Directory'> Joining the channel news…" + concurrentlyN_ + [ do + relay <## "'SimpleX Directory': accepting request to join group #news..." + relay <## "#news: 'SimpleX Directory' joined the group", + bob <## "#news: relay added 'SimpleX Directory_1' to the group" + ] + -- owner sends a message to trigger member introduction + bob <# "'SimpleX Directory'> Joined the channel news. Registration is pending approval β€” it may take up to 48 hours." + superUser <# "'SimpleX Directory'> bob submitted the channel ID 1:" + superUser <## "news" + superUser <##. "Link to join channel: " + superUser <## "You need SimpleX Chat app v6.5 to join." + superUser <## "2 subscribers" + superUser <## "" + superUser <## "To approve send:" + superUser <# "'SimpleX Directory'> /approve 1:news 1" + -- superuser approves + let approve = "/approve 1:news 1" + superUser #> ("@'SimpleX Directory' " <> approve) + superUser <# ("'SimpleX Directory'> > " <> approve) + superUser <## " Channel approved!" + bob <# ("'SimpleX Directory'> The channel ID 1 (news) is approved and listed in directory - please moderate it!") + bob <## "Please note: if you change the channel profile it will be hidden from directory until it is re-approved." + -- owner updates channel profile, triggering re-approval + bob ##> "/gp news news News and Updates" + bob <## "description changed to: News and Updates" + bob <# "'SimpleX Directory'> The channel ID 1 (news) is updated." + bob <## "It is hidden from the directory until approved." + relay <## "bob updated group #news: (signed)" + relay <## "description changed to: News and Updates" + superUser <# "'SimpleX Directory'> The channel ID 1 (news) is updated." + superUser <# ("'SimpleX Directory'> bob submitted the channel ID 1:") + superUser <## "news (News and Updates)" + superUser <##. "Link to join channel: " + superUser <## "You need SimpleX Chat app v6.5 to join." + superUser <## "3 subscribers" + superUser <## "" + superUser <## "To approve send:" + superUser <# "'SimpleX Directory'> /approve 1:news 1" + -- re-approve after profile update + let approve2 = "/approve 1:news 1" + superUser #> ("@'SimpleX Directory' " <> approve2) + superUser <# ("'SimpleX Directory'> > " <> approve2) + superUser <## " Channel approved!" + bob <# ("'SimpleX Directory'> The channel ID 1 (news) is approved and listed in directory - please moderate it!") + bob <## "Please note: if you change the channel profile it will be hidden from directory until it is re-approved." + -- owner leaves channel, triggering de-listing and bot leaving + bob ##> "/leave #news" + concurrentlyN_ + [ do + bob <## "#news: you left the group" + bob <## "use /d #news to delete the group", + relay <## "#news: bob left the group (signed)" + ] + bob <# "'SimpleX Directory'> You left the channel ID 1 (news)." + bob <## "" + bob <## "The channel is no longer listed in the directory." + superUser <# "'SimpleX Directory'> The channel ID 1 (news) is de-listed (channel owner left)." + relay <## "#news: 'SimpleX Directory' left the group (signed)" + +testLinkAsTextSearch :: HasCallStack => TestParams -> IO () +testLinkAsTextSearch ps = + withDirectoryServiceCfg ps testCfg $ \_superUser dsLink -> + withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> + withRelay ps $ \relay -> do + bob `connectVia` dsLink + (shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay + bob #> ("@'SimpleX Directory' " <> shortLink) + bob <# ("'SimpleX Directory'> > " <> shortLink) + bob <## " No groups found." + bob <## "To register a group or a channel, please use \"Share via chat\" feature." + +testNonOwnerSharesCard :: HasCallStack => TestParams -> IO () +testNonOwnerSharesCard ps = + withDirectoryServiceCfg ps testCfg $ \_superUser dsLink -> + withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> + withRelay ps $ \relay -> + withNewTestChatCfg ps testCfg "cath" cathProfile $ \cath -> do + bob `connectVia` dsLink + cath `connectVia` dsLink + (shortLink, fullLink) <- prepareChannel1Relay "news" bob relay + memberJoinChannel "news" [relay] [bob] shortLink fullLink cath + cath ##> "/share chat #news @'SimpleX Directory'" + cath <# "@'SimpleX Directory' link to join channel #news:" + _ <- getTermLine cath -- short link + cath <# "'SimpleX Directory'> To add a channel to directory you must be the owner." + +testDeleteChannelRegistration :: HasCallStack => TestParams -> IO () +testDeleteChannelRegistration ps = + withDirectoryServiceCfg ps testCfg $ \superUser dsLink -> + withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> + withRelay ps $ \relay -> do + bob `connectVia` dsLink + (_shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay + bob ##> "/share chat #news @'SimpleX Directory'" + bob <# "@'SimpleX Directory' link to join channel #news (signed):" + _ <- getTermLine bob -- short link + _ <- getTermLine bob -- ownerSig JSON + bob <# "'SimpleX Directory'> Joining the channel news…" + concurrentlyN_ + [ do + relay <## "'SimpleX Directory': accepting request to join group #news..." + relay <## "#news: 'SimpleX Directory' joined the group", + bob <## "#news: relay added 'SimpleX Directory_1' to the group" + ] + bob <# "'SimpleX Directory'> Joined the channel news. Registration is pending approval β€” it may take up to 48 hours." + superUser <# "'SimpleX Directory'> bob submitted the channel ID 1:" + superUser <## "news" + superUser <##. "Link to join channel: " + superUser <## "You need SimpleX Chat app v6.5 to join." + superUser <## "2 subscribers" + superUser <## "" + superUser <## "To approve send:" + superUser <# "'SimpleX Directory'> /approve 1:news 1" + let approve = "/approve 1:news 1" + superUser #> ("@'SimpleX Directory' " <> approve) + superUser <# ("'SimpleX Directory'> > " <> approve) + superUser <## " Channel approved!" + bob <# ("'SimpleX Directory'> The channel ID 1 (news) is approved and listed in directory - please moderate it!") + bob <## "Please note: if you change the channel profile it will be hidden from directory until it is re-approved." + -- owner deletes registration + bob #> "@'SimpleX Directory' /delete 1:news" + bob + <### + [ WithTime "'SimpleX Directory'> > /delete 1:news", + " Your channel news is deleted from the directory", + "#news: 'SimpleX Directory_1' left the group (signed)" + ] + relay <## "#news: 'SimpleX Directory' left the group (signed)" + +testReregistrationAlreadyListed :: HasCallStack => TestParams -> IO () +testReregistrationAlreadyListed ps = + withDirectoryServiceCfg ps testCfg $ \superUser dsLink -> + withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> + withRelay ps $ \relay -> do + bob `connectVia` dsLink + (_shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay + -- register and approve + bob ##> "/share chat #news @'SimpleX Directory'" + bob <# "@'SimpleX Directory' link to join channel #news (signed):" + _ <- getTermLine bob -- short link + _ <- getTermLine bob -- ownerSig JSON + bob <# "'SimpleX Directory'> Joining the channel news…" + concurrentlyN_ + [ do + relay <## "'SimpleX Directory': accepting request to join group #news..." + relay <## "#news: 'SimpleX Directory' joined the group", + bob <## "#news: relay added 'SimpleX Directory_1' to the group" + ] + bob <# "'SimpleX Directory'> Joined the channel news. Registration is pending approval β€” it may take up to 48 hours." + superUser <# "'SimpleX Directory'> bob submitted the channel ID 1:" + superUser <## "news" + superUser <##. "Link to join channel: " + superUser <## "You need SimpleX Chat app v6.5 to join." + superUser <## "2 subscribers" + superUser <## "" + superUser <## "To approve send:" + superUser <# "'SimpleX Directory'> /approve 1:news 1" + let approve = "/approve 1:news 1" + superUser #> ("@'SimpleX Directory' " <> approve) + superUser <# ("'SimpleX Directory'> > " <> approve) + superUser <## " Channel approved!" + bob <# ("'SimpleX Directory'> The channel ID 1 (news) is approved and listed in directory - please moderate it!") + bob <## "Please note: if you change the channel profile it will be hidden from directory until it is re-approved." + -- search finds the channel with its link + bob #> "@'SimpleX Directory' news" + bob <# "'SimpleX Directory'> > news" + bob <## " Found 1 group(s)." + bob <# "'SimpleX Directory'> news" + bob <##. "Link to join channel: " + bob <## "You need SimpleX Chat app v6.5 to join." + bob <## "3 subscribers" + -- owner re-shares card while already listed + bob ##> "/share chat #news @'SimpleX Directory'" + bob <# "@'SimpleX Directory' link to join channel #news (signed):" + _ <- getTermLine bob -- short link + _ <- getTermLine bob -- ownerSig JSON + bob <# "'SimpleX Directory'> Channel is already listed in the directory." + testGetCaptchaStr :: HasCallStack => TestParams -> IO () testGetCaptchaStr _ps = do s0 <- getCaptchaStr 0 "" diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 880c1373e9..fb94194561 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -19,7 +19,7 @@ import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Library.Internal (roundedFDCount) import Simplex.Chat.Mobile.File import Simplex.Chat.Options (ChatOpts (..)) -import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..)) +import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), XFTPStoreConfig (..)) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize) @@ -940,7 +940,7 @@ testXFTPRcvError ps = do alice <## "completed uploading file 1 (test.pdf) for bob" -- server is up w/t store log - file reception should fail - withXFTPServer' xftpServerConfig {storeLogFile = Nothing} $ do + withXFTPServer' xftpServerConfig {serverStoreCfg = XSCMemory Nothing, storeLogFile = Nothing} $ do withTestChat ps "bob" $ \bob -> do bob <## "subscribed 1 connections on server localhost" bob ##> "/fr 1 ./tests/tmp" diff --git a/website/src/directory.html b/website/src/directory.html index 4ea42f0c3b..f6fc7991f0 100644 --- a/website/src/directory.html +++ b/website/src/directory.html @@ -20,14 +20,14 @@ active_directory: true word-break: break-word; } - #directory .entry a { + #directory .entry a.img-link { order: -1; object-fit: cover; margin-right: 16px; margin-bottom: 16px; } - #directory .entry a img { + #directory .entry a.img-link img { min-width: 104px; min-height: 104px; width: 104px; diff --git a/website/src/js/directory.js b/website/src/js/directory.js index d008370342..ca3ed796e6 100644 --- a/website/src/js/directory.js +++ b/website/src/js/directory.js @@ -165,7 +165,7 @@ function entrySortPriority(entry) { function entryMemberCount(entry) { return entry.entryType.type == 'group' - ? (entry.entryType.summary?.currentMembers ?? 0) + ? (entry.entryType.summary?.publicMemberCount ?? entry.entryType.summary?.currentMembers ?? 0) : 0 } @@ -263,6 +263,13 @@ function displayEntries(entries) { }, 0); } + if (entryType?.groupType) { + const noteElement = document.createElement('p'); + noteElement.innerHTML = 'You need SimpleX Chat app v6.5 to join.'; + noteElement.className = 'text-sm'; + textContainer.appendChild(noteElement); + } + const entryTimestamp = currentSortMode === 'new' && entry.createdAt ? showCreatedOn(entry.createdAt) : entry.activeAt @@ -278,7 +285,8 @@ function displayEntries(entries) { const memberCount = entryMemberCount(entry); if (typeof memberCount == 'number' && memberCount > 0) { const memberCountElement = document.createElement('p'); - memberCountElement.textContent = `${memberCount} members`; + const isChannel = entryType?.groupType === 'channel'; + memberCountElement.textContent = `${memberCount} ${isChannel ? 'subscribers' : 'members'}`; memberCountElement.className = 'text-sm'; textContainer.appendChild(memberCountElement); } @@ -291,6 +299,7 @@ function displayEntries(entries) { } const imgLinkElement = document.createElement('a'); + imgLinkElement.className = 'img-link'; const groupLinkUri = groupLink.connShortLink ?? groupLink.connFullLink try { imgLinkElement.href = platformSimplexUri(groupLinkUri);