fix freshness bug with local chats: When core marks a chat verified for a name, it now first un-verifies the user's other chats of the same kind:

- a contact name covers contacts and business chats;
  - a channel name covers channels.
This commit is contained in:
Alain Brenzikofer
2026-09-30 10:10:29 +02:00
parent 98d0e4b77c
commit ddc18b326b
16 changed files with 139 additions and 50 deletions
+2 -2
View File
@@ -1180,7 +1180,7 @@ data InvitationLinkPlan
deriving (Show)
data ContactAddressPlan
= CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification, addressChanged :: Bool}
= CAPOk {contactSLinkData_ :: Maybe ContactShortLinkData, ownerVerification :: Maybe OwnerVerification, addressChanged :: Bool, existingChat_ :: Maybe AChatInfo}
| CAPOwnLink
| CAPConnectingConfirmReconnect
| CAPConnectingProhibit {contact :: Contact}
@@ -1189,7 +1189,7 @@ data ContactAddressPlan
deriving (Show)
data GroupLinkPlan
= GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification, addressChanged :: Bool}
= GLPOk {groupSLinkInfo_ :: Maybe GroupShortLinkInfo, groupSLinkData_ :: Maybe GroupShortLinkData, ownerVerification :: Maybe OwnerVerification, addressChanged :: Bool, existingChat_ :: Maybe AChatInfo}
| GLPOwnLink {groupInfo :: GroupInfo}
| GLPConnectingConfirmReconnect
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
+23 -16
View File
@@ -2443,7 +2443,7 @@ processChatCommand cxt nm = \case
toView $ CEvtChatInfoUpdated user (AChatInfo SCTDirect $ DirectChat ct')
throwError e
ConnectSimplex incognito -> withUser $ \user -> do
plan <- contactRequestPlan user adminContactReq Nothing Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing Nothing False) Nothing)
plan <- contactRequestPlan user adminContactReq Nothing Nothing `catchAllErrors` const (pure $ CPContactAddress (CAPOk Nothing Nothing False Nothing) Nothing)
connectWithPlan user incognito (Just (ACCL SCMContact (CCLink adminContactReq Nothing))) Nothing Nothing plan
DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId Nothing) cdm
ClearContact cName -> withContactName cName $ \chatId -> APIClearChat $ ChatRef CTDirect chatId Nothing
@@ -4534,10 +4534,10 @@ processChatCommand cxt nm = \case
Just r@(_, p) | knownChat p -> pure r
_ -> throwError e
linkPlan expiresAt l' = case known_ of
Just r@(l, _)
Just r@(l, p)
| knownLinkOf l == Just l' -> confirmKnown expiresAt l' r
| otherwise ->
(second setAddressChanged <$> resolvedPlan expiresAt l') `catchAllErrors` \case
(second (setAddressChanged p) <$> resolvedPlan expiresAt l') `catchAllErrors` \case
ChatError (CESimplexDomainNotReady _ SDEUnknownDomain) -> pure r
e -> throwError e
Nothing -> resolvedPlan expiresAt l'
@@ -4575,7 +4575,7 @@ processChatCommand cxt nm = \case
_ -> pure plan0
forM_ planDomain $ \nameDomain ->
let domain_ = (\GroupProfile {publicGroup} -> claimDomain <$> (publicGroup >>= publicGroupAccess >>= groupDomainClaim)) =<< case plan of
CPGroupLink (GLPOk _ (Just GroupShortLinkData {groupProfile}) _ _) _ -> Just groupProfile
CPGroupLink (GLPOk _ (Just GroupShortLinkData {groupProfile}) _ _ _) _ -> Just groupProfile
CPGroupLink (GLPKnown GroupInfo {groupProfile} _ _ _) _ -> Just groupProfile
CPGroupLink (GLPOwnLink GroupInfo {groupProfile}) _ -> Just groupProfile
CPGroupLink (GLPConnectingProhibit (Just GroupInfo {groupProfile})) _ -> Just groupProfile
@@ -4638,8 +4638,8 @@ processChatCommand cxt nm = \case
case plan of
CPContactAddress (CAPContactViaAddress Contact {contactId}) _ ->
processChatCommand cxt nm $ APIConnectContactViaAddress userId incognito contactId
CPContactAddress (CAPOk (Just sld) _ _) _ | isJust vName -> connectContactViaName ccLink sld
CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct = False}) (Just gld) _ _) _
CPContactAddress (CAPOk (Just sld) _ _ _) _ | isJust vName -> connectContactViaName ccLink sld
CPGroupLink (GLPOk (Just GroupShortLinkInfo {direct = False}) (Just gld) _ _ _) _
| ACCL SCMContact ccl <- ccLink -> joinChannelViaRelays ccl gld
_ -> processChatCommand cxt nm $ APIConnect userId incognito $ Just ccLink
| otherwise = pure $ CRConnectionPlan user ccLink_ planSimplexName otherSimplexName plan
@@ -4706,13 +4706,13 @@ processChatCommand cxt nm = \case
Nothing ->
withFastStore' (\db -> getContactWithoutConnViaAddress db cxt user cReqSchemas) >>= \case
Just ct | not (contactDeleted ct) -> plan $ CAPContactViaAddress ct
_ -> plan $ CAPOk cld ov False
_ -> plan $ CAPOk cld ov False Nothing
Just (RcvDirectMsgConnection Connection {connStatus} Nothing)
| connStatus == ConnPrepared -> plan $ CAPOk cld ov False
| connStatus == ConnPrepared -> plan $ CAPOk cld ov False Nothing
| otherwise -> plan CAPConnectingConfirmReconnect
Just (RcvDirectMsgConnection _ (Just ct))
| not (contactReady ct) && contactActive ct -> plan $ CAPConnectingProhibit ct
| contactDeleted ct -> plan $ CAPOk cld ov False
| contactDeleted ct -> plan $ CAPOk cld ov False Nothing
| otherwise -> plan $ CAPKnown ct
-- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?)
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Nothing Nothing []
@@ -4728,12 +4728,12 @@ processChatCommand cxt nm = \case
connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db cxt user cReqHashes
gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db cxt user cReqHashes
case (gInfo_, connEnt_) of
(Nothing, Nothing) -> plan $ GLPOk linkInfo gld ov False
(Nothing, Nothing) -> plan $ GLPOk linkInfo gld ov False Nothing
-- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?)
(Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> plan $ GLPConnectingConfirmReconnect
(Nothing, Just (RcvDirectMsgConnection _ (Just ct)))
| not (contactReady ct) && contactActive ct -> plan $ GLPConnectingProhibit gInfo_
| otherwise -> plan $ GLPOk linkInfo gld ov False
| otherwise -> plan $ GLPOk linkInfo gld ov False Nothing
(Nothing, Just _) -> throwCmdError "found connection entity is not RcvDirectMsgConnection"
(Just gInfo, _) -> groupPlan gInfo linkInfo gld ov glOwners
groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> [GroupLinkOwner] -> CM ConnectionPlan
@@ -4742,7 +4742,7 @@ processChatCommand cxt nm = \case
| not (memberActive membership) && not (memberRemoved membership) =
plan $ GLPConnectingProhibit $ Just gInfo
| memberActive membership = plan $ GLPKnown gInfo False ov (ListDef glOwners)
| otherwise = plan $ GLPOk linkInfo gld ov False
| otherwise = plan $ GLPOk linkInfo gld ov False Nothing
where
plan p = pure $ CPGroupLink p Nothing
contactCReqSchemas :: ConnReqContact -> (ConnReqContact, ConnReqContact)
@@ -5189,11 +5189,18 @@ setNameWarning w = \case
NWReservedForCommunity -> Just w
_ -> Nothing
setAddressChanged :: ConnectionPlan -> ConnectionPlan
setAddressChanged = \case
CPContactAddress (CAPOk cld ov _) w_ -> CPContactAddress (CAPOk cld ov True) w_
CPGroupLink (GLPOk li gld ov _) w_ -> CPGroupLink (GLPOk li gld ov True) w_
setAddressChanged :: ConnectionPlan -> ConnectionPlan -> ConnectionPlan
setAddressChanged known = \case
CPContactAddress (CAPOk cld ov _ _) w_ -> CPContactAddress (CAPOk cld ov True existingChat_) w_
CPGroupLink (GLPOk li gld ov _ _) w_ -> CPGroupLink (GLPOk li gld ov True existingChat_) w_
p -> p
where
existingChat_ = case known of
CPContactAddress (CAPKnown ct) _ -> Just $ AChatInfo SCTDirect $ DirectChat ct
CPGroupLink (GLPKnown g _ _ _) _ -> groupChat g
CPGroupLink (GLPOwnLink g) _ -> groupChat g
_ -> Nothing
groupChat g = Just $ AChatInfo SCTGroup $ GroupChat g Nothing
verifyEntityDomain :: User -> NetworkRequestMode -> SimplexNameType -> SimplexDomainClaim -> Maybe AConnShortLink -> CM (Maybe Bool, Maybe Text)
verifyEntityDomain user nm nameType SimplexDomainClaim {domain = StrJSON domain, proof = proof_} connLink_ = case (proof_, connLink_) of
+20 -3
View File
@@ -52,6 +52,7 @@ module Simplex.Chat.Store.Direct
getContactIdByName,
updateContactProfile,
setContactDomainVerified,
unverifyNameChats,
getContactDomainResolution,
updateContactUserPreferences,
updateContactAlias,
@@ -112,11 +113,11 @@ import Data.Type.Equality
import Simplex.Chat.Badges (badgeToRow)
import Simplex.Chat.Messages
import Simplex.Chat.Store.Shared
import Simplex.Chat.Names (SimplexDomainClaim (..))
import Simplex.Chat.Names (SimplexDomainClaim (..), claimDomain)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), SConnectionMode (..), SimplexNameInfo (..), UserId)
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), SConnectionMode (..), SimplexDomain, SimplexNameInfo (..), SimplexNameType (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -592,8 +593,9 @@ updateContactProfile db cxt user@User {userId} c p' = do
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
setContactDomainVerified :: DB.Connection -> User -> Contact -> Bool -> Maybe UTCTime -> IO Contact
setContactDomainVerified db User {userId} ct@Contact {contactId, profile = p} verified expiresAt = do
setContactDomainVerified db User {userId} ct@Contact {contactId, profile = p@LocalProfile {contactDomain}} verified expiresAt = do
currentTs <- getCurrentTime
when verified $ forM_ contactDomain $ unverifyNameChats db userId NTContact . claimDomain
DB.execute
db
[sql|
@@ -603,6 +605,21 @@ setContactDomainVerified db User {userId} ct@Contact {contactId, profile = p} ve
(BI verified, currentTs, expiresAt, userId, contactId)
pure (ct {profile = p {contactDomainVerified = Just verified}} :: Contact)
unverifyNameChats :: DB.Connection -> UserId -> SimplexNameType -> SimplexDomain -> IO ()
unverifyNameChats db userId nameType domain = case nameType of
NTContact -> do
DB.execute db "UPDATE contact_profiles SET contact_domain_verified = 0 WHERE user_id = ? AND contact_domain = ? AND contact_domain_verified = 1" (userId, domain)
unverifyGroups " AND business_chat IS NOT NULL"
NTPublicGroup -> unverifyGroups " AND business_chat IS NULL"
where
unverifyGroups businessCond = DB.execute db (unverifyGroupsQuery <> businessCond) (userId, domain)
unverifyGroupsQuery =
[sql|
UPDATE groups SET group_domain_verified = 0
WHERE user_id = ? AND group_domain_verified = 1
AND group_profile_id IN (SELECT group_profile_id FROM group_profiles WHERE group_domain = ?)
|]
getContactDomainResolution :: DB.Connection -> User -> Contact -> IO (Maybe (UTCTime, Maybe UTCTime))
getContactDomainResolution db User {userId} Contact {profile = LocalProfile {profileId}} =
maybeFirstRow id $
+4 -1
View File
@@ -2744,8 +2744,11 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
safeDeleteLDN db user localDisplayName
setGroupDomainVerified :: DB.Connection -> User -> GroupInfo -> Bool -> Maybe UTCTime -> IO GroupInfo
setGroupDomainVerified db User {userId} g@GroupInfo {groupId} verified expiresAt = do
setGroupDomainVerified db User {userId} g@GroupInfo {groupId, businessChat} verified expiresAt = do
currentTs <- getCurrentTime
when verified $ do
domain_ <- maybeFirstRow fromOnly $ DB.query db "SELECT gp.group_domain FROM groups g JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE g.user_id = ? AND g.group_id = ? AND gp.group_domain IS NOT NULL" (userId, groupId)
forM_ domain_ $ unverifyNameChats db userId (if isJust businessChat then NTContact else NTPublicGroup)
DB.execute
db
"UPDATE groups SET group_domain_verified = ?, group_domain_resolved_at = ?, group_domain_expires_at = ? WHERE user_id = ? AND group_id = ?"
+2 -2
View File
@@ -2278,7 +2278,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
| business -> ("business address: " <>)
_ -> ("invitation link: " <>)
CPContactAddress cap _ -> case cap of
CAPOk contactSLinkData ov addressChanged -> [addrOrBiz contactSLinkData ("ok to connect" <> (if addressChanged then ", address changed" else ""))] <> viewSigVerification ov <> [viewJSON contactSLinkData | testView]
CAPOk contactSLinkData ov addressChanged _ -> [addrOrBiz contactSLinkData ("ok to connect" <> (if addressChanged then ", address changed" else ""))] <> viewSigVerification ov <> [viewJSON contactSLinkData | testView]
CAPOwnLink -> [ctAddr "own address"]
CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
@@ -2296,7 +2296,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
| business -> ("business address: " <>)
_ -> ("contact address: " <>)
CPGroupLink glp _ -> case glp of
GLPOk groupSLinkInfo_ groupSLinkData ov addressChanged ->
GLPOk groupSLinkInfo_ groupSLinkData ov addressChanged _ ->
let direct = maybe True (\(GroupShortLinkInfo {direct = d}) -> d) groupSLinkInfo_
in [grpLink $ (if direct then "ok to connect directly" else "ok to connect via relays") <> (if addressChanged then ", address changed" else "")]
<> viewSigVerification ov