core, web: correctly process name verification for channels, show names in directory (#7238)

* core, web: correctly process name verification for channels, show names in directory

* remove duplicate verification

* remove plan

* refactor

* remove comments

* stabilize tests

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny
2026-07-12 18:52:45 +01:00
committed by GitHub
parent 414f4b6ce1
commit c1cc568704
11 changed files with 264 additions and 55 deletions
@@ -70,6 +70,7 @@ $(JQ.deriveJSON defaultJSON ''PublicLink)
data DirectoryEntry = DirectoryEntry
{ entryType :: DirectoryEntryType,
displayName :: Text,
simplexName :: Maybe Text,
groupLink :: PublicLink,
shortDescr :: Maybe MarkdownList,
welcomeMessage :: Maybe MarkdownList,
@@ -97,7 +98,7 @@ recentRoundedTime roundTo now t
in Just $ systemToUTCTime $ MkSystemTime secs 0
groupDirectoryEntry :: UTCTime -> GroupInfo -> Maybe GroupLink -> Maybe (DirectoryEntry, Maybe (FilePath, ImageFileData))
groupDirectoryEntry now GroupInfo {groupProfile, chatTs, createdAt, groupSummary} gLink_ =
groupDirectoryEntry now g@GroupInfo {groupProfile, chatTs, createdAt, groupSummary} gLink_ =
let GroupProfile {displayName, shortDescr, description, image, memberAdmission, publicGroup} = groupProfile
gt = (\PublicGroupProfile {groupType} -> groupType) <$> publicGroup
entryType = DETGroup gt memberAdmission groupSummary
@@ -112,6 +113,7 @@ groupDirectoryEntry now GroupInfo {groupProfile, chatTs, createdAt, groupSummary
DirectoryEntry
{ entryType,
displayName,
simplexName = shortNameInfoStr . SimplexNameInfo NTPublicGroup <$> verifiedGroupDomain g,
groupLink,
shortDescr = toFormattedText <$> shortDescr,
welcomeMessage = toFormattedText <$> description',
@@ -64,11 +64,12 @@ import Simplex.Chat.Terminal.Main (simplexChatCLI')
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.View (serializeChatError, serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ACreatedConnLink (..), AgentErrorType (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact)
import Simplex.Chat.View (groupSimplexDomain, serializeChatError, serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ACreatedConnLink (..), AgentErrorType (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), SimplexDomain, sameConnReqContact, sameShortLinkContact)
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ErrorType (..))
import Simplex.Messaging.SimplexName (SimplexNameInfo (..), SimplexNameType (..), shortNameInfoStr)
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (eitherToMaybe, raceAny_, safeDecodeUtf8, tshow, unlessM, (<$$>))
@@ -361,7 +362,15 @@ 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, publicGroup} = groupNameDescr p <> maybe "" ("\nWelcome message:\n" <>) d <> linkToJoin
verifyGroupDomain_ :: GroupInfo -> IO GroupInfo
verifyGroupDomain_ g@GroupInfo {groupId}
| isJust (groupSimplexDomain g) =
sendChatCmd cc (APIVerifyGroupDomain groupId) >>= \case
Right CRGroupDomainVerified {groupInfo = g'} -> pure g'
Right r -> g <$ logError ("verifyGroupDomain_: unexpected response " <> tshow r)
Left e -> g <$ logInfo ("verifyGroupDomain_: error " <> tshow e)
| otherwise = pure g
groupInfoText simplexName_ p@GroupProfile {description = d, publicGroup} = groupNameDescr p <> maybe "" ("\nSimpleX name: " <>) simplexName_ <> maybe "" ("\nWelcome message:\n" <>) d <> linkToJoin
where
linkToJoin = case publicGroup of
Just pg@PublicGroupProfile {groupLink} ->
@@ -559,7 +568,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
("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'
verifyAndSendToApprove g' gr' n'
sendChatCmd cc (APIConnectPlan userId (Just (aConnectTarget link)) PRMAllGroups Nothing) >>= \case
Right (CRConnectionPlan _ _ _ _ (CPGroupLink (GLPKnown {groupInfo = g'}))) ->
case dbOwnerMemberId gr of
@@ -646,7 +655,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
(badRolesMsg <$$> getGroupRolesStatus toGroup gr) >>= \case
Left e -> notifyOwner gr $ "Error: getGroupRolesStatus. Please notify the developers.\n" <> T.pack e
Right (Just msg) -> notifyOwner gr msg
Right Nothing -> sendToApprove toGroup gr gaId
Right Nothing -> verifyAndSendToApprove toGroup gr gaId
dePendingMember :: GroupInfo -> GroupMember -> IO ()
dePendingMember g@GroupInfo {groupProfile = GroupProfile {displayName}} m
@@ -800,18 +809,22 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
alwaysCaptcha || useMemberFilter image (passCaptcha a)
sendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO ()
sendToApprove GroupInfo {groupId, groupProfile = p@GroupProfile {displayName, image = image', publicGroup = pg_}, groupSummary} GroupReg {dbContactId, promoted} gaId = do
sendToApprove g@GroupInfo {groupId, groupProfile = p@GroupProfile {displayName, image = image', publicGroup = pg_}, groupSummary} GroupReg {dbContactId, promoted} gaId = do
ct_ <- getContact' cc user dbContactId
let gt = maybe "group" groupTypeStr' pg_
nameStr_ = (\d -> simplexNameStr d <> (if groupDomainVerified g == Just True then "" else " (NOT verified - will not be shown)")) <$> groupSimplexDomain g
membersStr = "_" <> membersCountStr p groupSummary <> "_\n"
text =
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:")
<> ("\n" <> groupInfoText nameStr_ p <> "\n" <> membersStr <> "\nTo approve send:")
msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
withAdminUsers $ \cId -> do
let approveCmd = MCText $ "/approve " <> tshow groupId <> ":" <> viewName displayName <> " " <> tshow gaId <> if promoted then " promote=on" else ""
sendComposedMessages cc (SRDirect cId) [msg, approveCmd]
verifyAndSendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO ()
verifyAndSendToApprove g gr gaId = verifyGroupDomain_ g >>= \g' -> sendToApprove g' gr gaId
deGroupLinkCheck :: GroupInfo -> IO ()
deGroupLinkCheck gInfo@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}, groupSummary = summary} =
withGroupReg gInfo "link check" $ \gr@GroupReg {groupRegStatus, dbOwnerMemberId} ->
@@ -821,8 +834,10 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
sendChatCmd cc (APIConnectPlan userId (Just (aConnectTarget link)) PRMAllGroups Nothing) >>= \case
Right (CRConnectionPlan _ _ _ _ (CPGroupLink (GLPKnown {groupInfo = g', groupUpdated, linkOwners = ListDef owners}))) ->
checkValidOwner dbOwnerMemberId owners $ do
when groupUpdated $ reapprove pg gr groupRegStatus g'
when (groupUpdated || summary /= groupSummary g') $ listingsUpdated env
-- re-verify every cycle: a name that stopped resolving to the link must lose verified status
g'' <- verifyGroupDomain_ g'
when groupUpdated $ reapprove pg gr groupRegStatus g''
when (groupUpdated || summary /= groupSummary g'' || groupDomainVerified g'' /= groupDomainVerified gInfo) $ listingsUpdated env
Left (ChatErrorAgent {agentError = SMP _ err}) | linkDeleted err ->
setGroupStatus logError st env cc groupId GRSRemoved $ \gr' ->
notifyOwner gr' "The channel link is no longer valid.\nThe channel is removed from the directory."
@@ -866,7 +881,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
notifyOwner gr' $ uCtRole <> ".\n\nThe group is listed in the directory again."
notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suCtRole
GRSPendingApproval gaId | rStatus == GRSOk -> do
sendToApprove g gr gaId
verifyAndSendToApprove g gr gaId
notifyOwner gr $ uCtRole <> ".\n\nThe group is submitted for approval."
GRSActive | rStatus /= GRSOk ->
setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \gr' -> do
@@ -893,7 +908,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole
GRSPendingApproval gaId | serviceRole == GRAdmin ->
whenContactIsOwner gr $ do
sendToApprove g gr gaId
verifyAndSendToApprove g gr gaId
notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval."
GRSActive | serviceRole /= GRAdmin ->
setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \gr' -> do
@@ -1030,7 +1045,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
Left _ ->
addGroupReg notifyAdminUsers st cc user ct g (GRSPendingApproval 1) $ \gr -> do
void $ setGroupRegOwner cc groupId ownerMember
sendToApprove g gr 1
verifyAndSendToApprove 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."
@@ -1053,7 +1068,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
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
verifyAndSendToApprove g gr' n
deReregistration ct _ _ _ =
sendMessage cc ct "Error: could not verify ownership. Please report it to directory admins."
@@ -1067,7 +1082,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
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."
notifyOwner gr' $ recommendedSettingsNotice (userGroupRegId gr')
sendToApprove g gr' 1
verifyAndSendToApprove 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."
@@ -1202,9 +1217,10 @@ 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, groupProfile = GroupProfile {publicGroup = pg_}, localDisplayName = gName} _ -> case pg_ of
(if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g@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
<> maybe "" (("\nSimpleX name: " <>) . simplexNameStr) (verifiedGroupDomain g)
Nothing -> do
let groupRef = groupReference' gId gName
withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink groupId) $
@@ -1289,10 +1305,10 @@ 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}, _) =
foundGroup (g@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
text = T.unlines $ [showId <> groupInfoText (simplexNameStr <$> verifiedGroupDomain g) p, membersStr] ++ knockingStr memberAdmission
in (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_)
moreMsg = (Nothing, MCText $ "Send /next for " <> tshow moreGroups <> " more result(s).")
@@ -1490,7 +1506,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
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]
text = T.unlines $ [tshow useGroupId <> ". " <> groupInfoText (simplexNameStr <$> verifiedGroupDomain g) p] ++ [ownerStr | isAdmin] ++ [membersStr, statusStr] ++ knockingStr memberAdmission ++ [cmds]
msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
in (Nothing, msg)
@@ -1563,3 +1579,6 @@ unexpectedError err = "Unexpected error: " <> err <> ", please notify the develo
strEncodeTxt :: StrEncoding a => a -> Text
strEncodeTxt = safeDecodeUtf8 . strEncode
simplexNameStr :: SimplexDomain -> Text
simplexNameStr = shortNameInfoStr . SimplexNameInfo NTPublicGroup
@@ -43,6 +43,7 @@ module Directory.Store
getAllListedGroups,
getAllListedGroups_,
searchListedGroups,
verifiedGroupDomain,
groupRegStatusText,
pendingApproval,
groupRemoved,
@@ -86,11 +87,13 @@ import Data.Time.Clock.System (systemEpochDay)
import Directory.Search
import Directory.Util
import Simplex.Chat.Controller
import Simplex.Chat.Names (claimDomain)
import Simplex.Chat.Options.DB (FromField (..), ToField (..))
import Simplex.Chat.Store
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Shared (groupInfoQueryFields, groupInfoQueryFrom)
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (SimplexDomain)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..), fromTextField_)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Encoding.String
@@ -222,6 +225,11 @@ grDirectoryStatus = \case
GRSRemoved -> DSRemoved
_ -> DSRegistered
verifiedGroupDomain :: GroupInfo -> Maybe SimplexDomain
verifiedGroupDomain GroupInfo {groupProfile = GroupProfile {publicGroup}, groupDomainVerified}
| groupDomainVerified == Just True = claimDomain <$> (publicGroup >>= publicGroupAccess >>= groupDomainClaim)
| otherwise = Nothing
$(JQ.deriveJSON (enumJSON $ dropPrefix "PC") ''ProfileCondition)
$(JQ.deriveJSON defaultJSON ''DirectoryMemberAcceptance)
@@ -385,15 +393,19 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa
orderBy = " ORDER BY r.created_at DESC, r.group_reg_id ASC "
STSearch search -> case lastGroup_ of
Nothing -> do
gs <- groups currentTs $ DB.query db (listedGroupQuery <> searchCond <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, s, s, s, s, pageSize)
n <- count $ DB.query db (countQuery' <> searchCond) (GRSActive, s, s, s, s)
gs <- groups currentTs $ DB.query db (listedGroupQuery <> searchCond <> orderBy <> " LIMIT ?") ((userId, userContactId, GRSActive, s, s, s, s) :. (sDomain, pageSize))
n <- count $ DB.query db (countQuery' <> searchCond) (GRSActive, s, s, s, s, sDomain)
pure (gs, n)
Just gId -> do
gs <- groups currentTs $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> searchCond <> orderBy <> " LIMIT ?") (userId, userContactId, GRSActive, gId, s, s, s, s, pageSize)
n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> searchCond) (GRSActive, gId, s, s, s, s)
gs <- groups currentTs $ DB.query db (listedGroupQuery <> " AND r.group_id > ? " <> searchCond <> orderBy <> " LIMIT ?") ((userId, userContactId, GRSActive, gId, s, s, s, s) :. (sDomain, pageSize))
n <- count $ DB.query db (countQuery' <> " AND r.group_id > ? " <> searchCond) (GRSActive, gId, s, s, s, s, sDomain)
pure (gs, n)
where
s = T.toLower search
-- a bare "#"/"@" maps to "#", matching no stored domain (domains are stored unprefixed)
sDomain = case T.uncons s of
Just (c, rest) | c == '#' || c == '@' -> if T.null rest then "#" else rest
_ -> s
countQuery' = countQuery <> " JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE r.group_reg_status = ? "
orderBy = " ORDER BY g.summary_current_members_count DESC, r.group_reg_id ASC "
where
@@ -407,6 +419,7 @@ searchListedGroups cc user@User {userId, userContactId} searchType lastGroup_ pa
OR LOWER(gp.full_name) LIKE '%' || ? || '%'
OR LOWER(gp.short_descr) LIKE '%' || ? || '%'
OR LOWER(gp.description) LIKE '%' || ? || '%'
OR (LOWER(gp.group_domain) LIKE '%' || ? || '%' AND g.group_domain_verified = 1)
)
|]
+29 -17
View File
@@ -111,7 +111,8 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), patt
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (base64P)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), MsgFlags (..), NameRecord (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ErrorType (NAME), MsgFlags (..), NameRecord (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport.Client (defaultSocksProxyWithAuth)
@@ -1863,7 +1864,7 @@ processChatCommand cxt nm = \case
(_, cData@(ContactLinkData _ UserContactData {relays = currentRelayLinks})) <- getShortLinkConnReq' nm user sLnk
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
gInfo' <- case groupSLinkData_ of
Just sLinkData -> fst <$> updateGroupFromLinkData user gInfo sLinkData
Just sLinkData -> fst <$> updateGroupFromLinkData user gInfo sLinkData Nothing
_ -> pure gInfo
when (memberRole' (membership gInfo) /= GROwner && memberCurrent (membership gInfo)) $
withGroupLock "syncSubscriberRelays" groupId $
@@ -2307,11 +2308,18 @@ processChatCommand cxt nm = \case
ct' <- maybe (pure ct) (\v -> withFastStore' $ \db -> setContactDomainVerified db user ct v) verified
pure $ CRContactDomainVerified user ct' reason
APIVerifyGroupDomain groupId -> withUser $ \user -> do
g@GroupInfo {groupProfile = GroupProfile {publicGroup}, preparedGroup} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
let connLink_ = preparedGroup >>= \PreparedGroup {connLinkToConnect = CCLink _ sLnk_} -> ACSL SCMContact <$> sLnk_
domain <- maybe (throwCmdError "group has no name to verify") pure $ publicGroup >>= publicGroupAccess >>= groupDomainClaim
(verified, reason) <- verifyEntityDomain user nm NTPublicGroup domain connLink_
g' <- maybe (pure g) (\v -> withFastStore' $ \db -> setGroupDomainVerified db user g v) verified
g@GroupInfo {groupProfile = GroupProfile {publicGroup}} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
PublicGroupProfile {groupLink, publicGroupAccess} <- maybe (throwCmdError "not a public group") pure publicGroup
claim <- maybe (throwCmdError "group has no name to verify") pure $ publicGroupAccess >>= groupDomainClaim
-- checks the profile link, not the link we joined through (which may have rotated)
(verified, reason) <-
tryAllErrors (withAgent $ \a -> resolveSimplexName a nm (aUserId user) (claimDomain claim)) >>= \case
Right NameRecord {nrSimplexChannel}
| nameResolvesTo groupLink nrSimplexChannel -> pure (True, Nothing)
| otherwise -> pure (False, Just "the name does not resolve to the link in the group profile")
Left (ChatErrorAgent {agentError = SMP _ (NAME SMP.NOT_FOUND)}) -> pure (False, Just "the name is not registered")
Left e -> throwError e
g' <- withFastStore' $ \db -> setGroupDomainVerified db user g verified
pure $ CRGroupDomainVerified user g' reason
APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
ct@Contact {profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db cxt user contactId
@@ -3139,7 +3147,7 @@ processChatCommand cxt nm = \case
processChatCommand cxt nm $ APIListGroups userId (contactId' <$> ct_) search_
APIUpdateGroupProfile groupId p' -> withUser $ \user -> do
gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId
runUpdateGroupProfile user gInfo p'
runUpdateGroupProfile user gInfo p' False
UpdateGroupNames gName GroupProfile {displayName, fullName, shortDescr} ->
updateGroupProfileByName gName $ \p -> p {displayName, fullName, shortDescr}
ShowGroupProfile gName -> withUser $ \user ->
@@ -3152,11 +3160,12 @@ processChatCommand cxt nm = \case
gInfo@GroupInfo {groupProfile = p@GroupProfile {publicGroup}} <- withStore $ \db -> getGroupInfo db cxt user gId
case publicGroup of
Just pg@PublicGroupProfile {groupLink, publicGroupAccess = existingAccess} -> do
let domainChanged = (claimDomain <$> newClaim) /= (claimDomain <$> (existingAccess >>= groupDomainClaim))
forM_ (claimDomain <$> newClaim) $ \newDomain ->
when (Just newDomain /= (claimDomain <$> (existingAccess >>= groupDomainClaim))) $ do
when domainChanged $ do
NameRecord {nrSimplexChannel} <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) newDomain
unless (nameResolvesTo groupLink nrSimplexChannel) $ throwChatError $ CESimplexDomainNotReady newDomain SDENoValidLink
runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just access}}
runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just access}} (isJust newClaim && domainChanged)
Nothing -> throwChatError $ CECommandError "not a public group"
APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
gInfo@GroupInfo {groupProfile} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
@@ -3914,11 +3923,14 @@ processChatCommand cxt nm = \case
void (sendDirectContactMessage user ct' $ XInfo p) `catchAllErrors` eToView
lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
pure $ CRContactPrefsUpdated user ct ct'
runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> CM ChatResponse
runUpdateGroupProfile user gInfo@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} p'@GroupProfile {displayName = n'} = do
runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> Bool -> CM ChatResponse
runUpdateGroupProfile user gInfo@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} p'@GroupProfile {displayName = n'} domainVerified = do
assertUserGroupRole gInfo GROwner
when (n /= n') $ checkValidName n'
gInfo' <- withStore $ \db -> updateGroupProfile db user gInfo p'
-- updateGroupProfile clears domain verification; re-set it when the caller already re-resolved the name
gInfo' <- withStore $ \db -> do
g <- updateGroupProfile db user gInfo p'
if domainVerified then liftIO $ setGroupDomainVerified db user g True else pure g
msg <- case businessChat of
Just BusinessChatInfo {businessId} -> do
ms <- withStore' $ \db -> getGroupMembers db cxt user gInfo'
@@ -4011,7 +4023,7 @@ processChatCommand cxt nm = \case
applicable = if channel then groupFeatureInChannel feature else groupFeatureInRegularGroup feature
unless applicable $
throwCmdError $ T.unpack (groupFeatureNameText feature) <> " is not available in " <> (if channel then "channels" else "groups")
runUpdateGroupProfile user gInfo $ update p
runUpdateGroupProfile user gInfo (update p) False
withCurrentCall :: ContactId -> (User -> Contact -> Call -> CM (Maybe Call)) -> CM ChatResponse
withCurrentCall ctId action = do
(user, ct) <- withStore $ \db -> do
@@ -4338,8 +4350,8 @@ processChatCommand cxt nm = \case
-- e.g. an un-upgraded relay dropped the claim); refresh its profile from the fresh link
-- data and mark it verified, so the check below passes and future by-name lookups match
plan <- case (planDomain, plan0, groupSLinkData_) of
(Just _, CPGroupLink (GLPKnown g u o os), Just sLinkData) ->
(\(g', _) -> CPGroupLink (GLPKnown g' u o os)) <$> updateGroupFromLinkData user g sLinkData
(Just nameDomain, CPGroupLink (GLPKnown g u o os), Just sLinkData) ->
(\(g', _) -> CPGroupLink (GLPKnown g' u o os)) <$> updateGroupFromLinkData user g sLinkData (Just nameDomain)
_ -> pure plan0
forM_ planDomain $ \nameDomain ->
let domain_ = (\GroupProfile {publicGroup} -> claimDomain <$> (publicGroup >>= publicGroupAccess >>= groupDomainClaim)) =<< case plan of
@@ -4366,7 +4378,7 @@ processChatCommand cxt nm = \case
let ov = verifyLinkOwner rk owners l' sig_
glOwners = map (\OwnerAuth {ownerId, ownerKey} -> GroupLinkOwner {memberId = MemberId ownerId, memberKey = ownerKey}) owners
(g', updated) <- case groupSLinkData_ of
Just sLinkData -> updateGroupFromLinkData user g sLinkData
Just sLinkData -> updateGroupFromLinkData user g sLinkData Nothing
_ -> pure (g, False)
pure (con l' (linkConnReq fd), CPGroupLink (GLPKnown g' updated ov (ListDef glOwners)))
-- resolve a name to its first contact/channel short link
+6 -7
View File
@@ -1469,9 +1469,10 @@ updatePublicGroupData user gInfo
withStore $ \db -> updatePublicMemberCount db cxt user gInfo
| otherwise = pure gInfo
updateGroupFromLinkData :: User -> GroupInfo -> GroupShortLinkData -> CM (GroupInfo, Bool)
updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupDomainVerified, groupSummary = GroupSummary {publicMemberCount = localCount}} GroupShortLinkData {groupProfile, publicGroupData}
| profileChanged || countChanged || verifyChanged = do
-- must not resolve names here: a background link-data refresh would leak channel membership to the resolver
updateGroupFromLinkData :: User -> GroupInfo -> GroupShortLinkData -> Maybe SimplexDomain -> CM (GroupInfo, Bool)
updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} GroupShortLinkData {groupProfile, publicGroupData} resolvedDomain_
| profileChanged || countChanged || verifyResolved = do
cxt <- chatStoreCxt
withStore $ \db -> do
g <- if profileChanged then updateGroupProfile db user gInfo groupProfile else pure gInfo
@@ -1479,9 +1480,7 @@ updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupDomainVerif
Just PublicGroupData {publicMemberCount} | countChanged ->
setPublicMemberCount db cxt user g publicMemberCount
_ -> pure g
-- the group's own link is authoritative for its domain claim, so a claim in the link profile is
-- verified; updateGroupProfile above clears verification on a claim change, so set it afterwards
g'' <- if verifyChanged then liftIO $ setGroupDomainVerified db user g' True else pure g'
g'' <- if verifyResolved then liftIO $ setGroupDomainVerified db user g' True else pure g'
pure (g'', profileChanged)
| otherwise = pure (gInfo, False)
where
@@ -1491,7 +1490,7 @@ updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupDomainVerif
_ -> False
groupClaim GroupProfile {publicGroup} = claimDomain <$> (publicGroup >>= publicGroupAccess >>= groupDomainClaim)
newClaim = groupClaim groupProfile
verifyChanged = isJust newClaim && (groupDomainVerified /= Just True || groupClaim p /= newClaim)
verifyResolved = isJust resolvedDomain_ && resolvedDomain_ == newClaim
updateContactFromLinkData :: User -> Contact -> Profile -> CM Contact
updateContactFromLinkData user ct@Contact {profile = profile@LocalProfile {contactDomain = prevClaim, contactDomainVerified}} linkProfile@Profile {contactDomain = newClaim}
+89
View File
@@ -30,7 +30,9 @@ import Simplex.Chat.Options.DB
import Simplex.Chat.Protocol (memberSupportVoiceVersion)
import Simplex.Chat.Types (ChatPeerType (..), Profile (..))
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..))
import Simplex.Messaging.Version
import NameResolver
import System.FilePath ((</>))
import Test.Hspec hiding (it)
@@ -100,6 +102,12 @@ directoryServiceTests = do
it "should handle re-registration when already listed" testReregistrationAlreadyListed
it "should update subscriber count periodically" testLinkCheckUpdatesCount
-- separate spec from directoryServiceTests: these need a names-enabled SMP server (withSmpServerAndNames)
directoryNameTests :: SpecWith TestParams
directoryNameTests = do
it "should verify and show a channel's SimpleX name" testDirectoryChannelName
it "should mark an inconsistent SimpleX name as not verified" testDirectoryChannelNameNotVerified
directoryProfile :: Profile
directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing}
@@ -2117,6 +2125,87 @@ testRegisterChannelViaCard ps =
superUser <# "'SimpleX Directory'> The channel ID 1 (news) is de-listed (channel owner left)."
relay <## "#news: 'SimpleX Directory' left the group (signed)"
-- owner sets a name; directory verifies name<->link consistency and shows the verified name to the admin
testDirectoryChannelName :: HasCallStack => TestParams -> IO ()
testDirectoryChannelName ps = withSmpServerAndNames $ \reg ->
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
bob `connectVia` dsLink
(shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay
registerName reg newsName (channelNameRecord "news" (T.pack shortLink))
bob ##> "/public group access #news domain=news.simplex"
bob <## "updated public group access: domain=news.simplex"
relay <## "bob updated group #news: (signed)"
relay <## "updated public group access: domain=news.simplex"
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 introduced 'SimpleX Directory_1' in the channel"
]
bob <# "'SimpleX Directory'> Joined the channel news. Registration is pending approval — it may take up to 48 hours."
bob <# "'SimpleX Directory'> We recommend allowing direct messages, media, voice, and SimpleX links only for group moderators and admins. Use group preferences to set them."
bob <## "Captcha verification is enabled. Use /'filter 1' to change it."
-- the directory verified the name against the channel link and shows it to the admin
superUser <# "'SimpleX Directory'> bob submitted the channel ID 1:"
superUser <## "news"
superUser <## "SimpleX name: #news"
superUser <##. "Link to join channel: "
superUser <## "You need SimpleX Chat app v6.5 to join."
superUser <## "1 subscribers"
superUser <## ""
superUser <## "To approve send:"
superUser <# "'SimpleX Directory'> /approve 1:news 1"
where
newsName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "news" [])
-- registry re-pointed to a different link after the owner set the name: directory verification fails
testDirectoryChannelNameNotVerified :: HasCallStack => TestParams -> IO ()
testDirectoryChannelNameNotVerified ps = withSmpServerAndNames $ \reg ->
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
bob `connectVia` dsLink
(shortLink, _fullLink) <- prepareChannel1Relay "news" bob relay
registerName reg newsName (channelNameRecord "news" (T.pack shortLink))
bob ##> "/public group access #news domain=news.simplex"
bob <## "updated public group access: domain=news.simplex"
relay <## "bob updated group #news: (signed)"
relay <## "updated public group access: domain=news.simplex"
-- the name is re-pointed to a different link after the owner set it
registerName reg newsName (channelNameRecord "news" "https://simplex.chat/other")
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 introduced 'SimpleX Directory_1' in the channel"
]
bob <# "'SimpleX Directory'> Joined the channel news. Registration is pending approval — it may take up to 48 hours."
bob <# "'SimpleX Directory'> We recommend allowing direct messages, media, voice, and SimpleX links only for group moderators and admins. Use group preferences to set them."
bob <## "Captcha verification is enabled. Use /'filter 1' to change it."
superUser <# "'SimpleX Directory'> bob submitted the channel ID 1:"
superUser <## "news"
superUser <## "SimpleX name: #news (NOT verified - will not be shown)"
superUser <##. "Link to join channel: "
superUser <## "You need SimpleX Chat app v6.5 to join."
superUser <## "1 subscribers"
superUser <## ""
superUser <## "To approve send:"
superUser <# "'SimpleX Directory'> /approve 1:news 1"
where
newsName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "news" [])
testLinkAsTextSearch :: HasCallStack => TestParams -> IO ()
testLinkAsTextSearch ps =
withDirectoryServiceCfg ps testCfg $ \_superUser dsLink ->
+7 -6
View File
@@ -1555,11 +1555,12 @@ testConnSyncExtraAgentUsers ps = do
DB.execute_ db "UPDATE connections_sync SET should_sync = 1 WHERE connections_sync_id = 1"
withTestChat ps "alice" $ \alice -> do
alice <## "connections difference summary:"
alice <## "number of extra users in agent: 1"
alice <## "removed extra users in agent"
alice <## "subscribed 1 connections on server localhost"
alice <###
[ "connections difference summary:",
"number of extra users in agent: 1",
"removed extra users in agent",
"subscribed 1 connections on server localhost"
]
threadDelay 100000
agentUserCount <- withCCAgentTransaction alice $ \db ->
@@ -2396,7 +2397,7 @@ testDisableCIExpirationOnlyForOneUser ps = do
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
threadDelay 2500000
threadDelay 3000000
-- second user messages are deleted
alice #$> ("/_get chat @6 count=100", chat, [(1,"chat banner")])
+1
View File
@@ -8537,6 +8537,7 @@ testScopedSupportMemberLeaves =
alice <## "members require attention: 1"
alice <## "bob (Bob) (id 2): unread: 2, require attention: 2, mentions: 0"
threadDelay 100000
bob ##> "/l team"
concurrentlyN_
[ do
+52 -1
View File
@@ -5,7 +5,7 @@ module ChatTests.Names where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Groups (prepareChannel1Relay)
import ChatTests.Groups (memberJoinChannel, prepareChannel1Relay)
import ChatTests.Utils
import Control.Concurrent.Async (concurrently_)
import qualified Data.Text as T
@@ -20,6 +20,8 @@ chatNamesTests = do
it "connect by name to a known contact not claimed in profile is rejected" testConnectByNameKnownContactNotClaimed
it "connect by unregistered name fails to resolve" testConnectByNameNotFound
it "set name not resolving to own address is rejected" testSetNameNotOwnAddress
it "channel name is not verified just by joining via link" testChannelDomainLinkJoinUnverified
it "verify channel name, fail on re-point, retain status on refresh" testChannelDomainVerify
it "connect by channel name" testConnectByChannelName
it "connect by name resolving to channel (primary) and direct contact" testConnectByNameChannelAndContact
it "connect by name resolving to direct contact (primary) and channel" testConnectByNameContactAndChannel
@@ -115,6 +117,55 @@ testSetNameNotOwnAddress ps = withSmpServerAndNames $ \reg ->
alice ##> "/_set domain 1 alice.simplex"
alice <## "SimpleX name alice.simplex has no valid connection link"
-- a self-claimed name is never auto-verified from link data: the claim is not proof of ownership
testChannelDomainLinkJoinUnverified :: HasCallStack => TestParams -> IO ()
testChannelDomainLinkJoinUnverified ps = withSmpServerAndNames $ \reg ->
withNewTestChat ps "alice" aliceProfile $ \alice ->
withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
(shortLink, fullLink) <- prepareChannel1Relay "team" alice cath
registerName reg teamName (channelNameRecord "team" (T.pack shortLink))
alice ##> "/public group access #team domain=team.simplex"
alice <## "updated public group access: domain=team.simplex"
cath <## "alice updated group #team: (signed)"
cath <## "updated public group access: domain=team.simplex"
memberJoinChannel "team" [cath] [alice] shortLink fullLink bob
-- a link-data refresh must not mark the self-claimed name verified
bob ##> ("/_connect plan 1 " <> shortLink <> " resolve=allGroups")
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages" -- no "SimpleX name" line: status stays unknown
where
teamName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "team" [])
testChannelDomainVerify :: HasCallStack => TestParams -> IO ()
testChannelDomainVerify ps = withSmpServerAndNames $ \reg ->
withNewTestChat ps "alice" aliceProfile $ \alice ->
withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
(shortLink, fullLink) <- prepareChannel1Relay "team" alice cath
registerName reg teamName (channelNameRecord "team" (T.pack shortLink))
alice ##> "/public group access #team domain=team.simplex"
alice <## "updated public group access: domain=team.simplex"
cath <## "alice updated group #team: (signed)"
cath <## "updated public group access: domain=team.simplex"
-- setting the name resolved it, so the owner's channel is verified
alice ##> "/_verify domain #1"
alice <## "SimpleX name #team verified"
memberJoinChannel "team" [cath] [alice] shortLink fullLink bob
bob ##> "/_verify domain #1"
bob <## "SimpleX name #team verified"
-- the name is re-pointed to a different link: verification fails
registerName reg teamName (channelNameRecord "team" "https://simplex.chat/other")
bob ##> "/_verify domain #1"
bob <## "SimpleX name #team not verified: the name does not resolve to the link in the group profile"
-- a link-data refresh keeps the failed status, not overwritten with verified
bob ##> ("/_connect plan 1 " <> shortLink <> " resolve=allGroups")
bob <## "group link: known group #team"
bob <## "SimpleX name: #team (verification failed)"
bob <## "use #team <message> to send messages"
where
teamName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "team" [])
testConnectByChannelName :: HasCallStack => TestParams -> IO ()
testConnectByChannelName ps = withSmpServerAndNames $ \reg ->
withNewTestChat ps "alice" aliceProfile $ \alice ->
+1
View File
@@ -74,6 +74,7 @@ main = do
describe "Random servers" randomServersTests
#if !defined(dbPostgres)
around (tmpTestBracket chatQueryStats agentQueryStats) $ describe "names tests" chatNamesTests
around (tmpTestBracket chatQueryStats agentQueryStats) $ xdescribe'' "SimpleX Directory names" directoryNameTests
#endif
#if defined(dbPostgres)
createdDropDb . around testBracket
+22 -1
View File
@@ -107,10 +107,24 @@ function filterEntries(mode, s) {
|| (entry.displayName || '').toLowerCase().includes(query)
|| includesQuery(entry.shortDescr, query)
|| includesQuery(entry.welcomeMessage, query)
|| simplexNameIncludesQuery(entry.simplexName, query)
)
);
}
function simplexNameIncludesQuery(name, query) {
if (!name) return false;
const q = normalizeSimplexName(query);
return q !== '' && normalizeSimplexName(name).includes(q);
}
function normalizeSimplexName(s) {
s = s.toLowerCase();
if (s.startsWith('#') || s.startsWith('@')) s = s.slice(1);
if (s.endsWith('.simplex')) s = s.slice(0, -'.simplex'.length);
return s;
}
function includesQuery(field, query) {
return field
&& Array.isArray(field)
@@ -215,7 +229,7 @@ function displayEntries(entries) {
for (let entry of entries) {
try {
const { entryType, displayName, groupLink, shortDescr, welcomeMessage, imageFile } = entry;
const { entryType, displayName, simplexName, groupLink, shortDescr, welcomeMessage, imageFile } = entry;
const entryDiv = document.createElement('div');
entryDiv.className = 'entry w-full flex flex-col items-start md:flex-row rounded-[4px] overflow-hidden shadow-[0px_20px_30px_rgba(0,0,0,0.12)] dark:shadow-none bg-white dark:bg-[#0B2A59] mb-8';
@@ -227,6 +241,13 @@ function displayEntries(entries) {
nameElement.className = 'text-grey-black dark:text-white !text-lg md:!text-xl font-bold';
textContainer.appendChild(nameElement);
if (simplexName) {
const simplexNameElement = document.createElement('p');
simplexNameElement.textContent = simplexName;
simplexNameElement.className = 'text-sm font-medium';
textContainer.appendChild(simplexNameElement);
}
const welcomeMessageHTML = welcomeMessage ? renderMarkdown(welcomeMessage) : undefined;
const shortDescrHTML = shortDescr ? renderMarkdown(shortDescr) : undefined;
if (shortDescrHTML && welcomeMessageHTML?.includes(shortDescrHTML) !== true) {