mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-07-17 06:31:58 +00:00
chat: APIVerifySimplexName command + CEvtSimplexNameUnverified warning
Addresses the TOFU vulnerability where peer-claimed simplex_name was accepted unverified. Adds: - contacts.simplex_name_verified_at + groups.simplex_name_verified_at (M20260606_simplex_name_verified) - APIVerifySimplexName ChatRef command: RSLV-resolves the claimed name and compares the resolved link to the peer's stored connection link; on match writes verified_at and emits CEvtSimplexNameVerified; on mismatch emits CEvtSimplexNameVerifyFailed - CEvtSimplexNameUnverified passive warning emitted on incoming XInfo / XGrpInfo when a name claim arrives without a current verification - updateContactProfileWithConflict / updateGroupProfileWithConflict clear simplex_name_verified_at whenever the peer's claim transitions (any value change including Nothing<->Just): the prior verification was bound to the prior claim. UI can surface the unverified indicator next to a contact / group's name, and prompt the user to invoke the verify command. This shifts the security model from "TOFU + last-writer-wins" to "TOFU + on-demand RSLV verification".
This commit is contained in:
shum
@@ -139,6 +139,7 @@ library
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260531_member_removed_at
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260604_simplex_name_profiles
|
||||
Simplex.Chat.Store.Postgres.Migrations.M20260606_simplex_name_verified
|
||||
else
|
||||
exposed-modules:
|
||||
Simplex.Chat.Archive
|
||||
@@ -300,6 +301,7 @@ library
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260531_member_removed_at
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260604_simplex_name_profiles
|
||||
Simplex.Chat.Store.SQLite.Migrations.M20260606_simplex_name_verified
|
||||
other-modules:
|
||||
Paths_simplex_chat
|
||||
hs-source-dirs:
|
||||
|
||||
@@ -486,6 +486,11 @@ data ChatCommand
|
||||
| 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, connTarget_ :: Maybe ConnectTarget}
|
||||
| -- Resolves the simplex_name claim on the chat row (contact or group) via
|
||||
-- RSLV and compares the resolved link to the peer's stored connection link.
|
||||
-- On match: writes simplex_name_verified_at and emits CEvtSimplexNameVerified.
|
||||
-- On link mismatch or resolver failure: emits CEvtSimplexNameVerifyFailed.
|
||||
APIVerifySimplexName {chatRef :: ChatRef}
|
||||
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
|
||||
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
|
||||
| DeleteContact ContactName ChatDeleteMode
|
||||
@@ -952,11 +957,40 @@ data ChatEvent
|
||||
-- (newer-claim-wins per RSLV); displacedFrom is the old row's local
|
||||
-- display_name, claimedBy is the peer / group whose claim won.
|
||||
CEvtSimplexNameConflict {user :: User, simplexName :: SimplexNameInfo, entity :: SimplexNameConflictEntity, claimedBy :: ContactName, displacedFrom :: ContactName}
|
||||
| -- Emitted by APIVerifySimplexName when the RSLV-resolved link for the
|
||||
-- claimed name matches the peer's stored connection link. simplex_name_verified_at
|
||||
-- has been written; UI should clear the unverified indicator.
|
||||
CEvtSimplexNameVerified {user :: User, chatRef :: ChatRef, simplexName :: SimplexNameInfo, verifiedAt :: UTCTime}
|
||||
| -- Emitted by APIVerifySimplexName when verification did not succeed.
|
||||
-- The simplex_name claim is NOT cleared; the user may still wish to keep
|
||||
-- the contact/group. UI should surface the failure reason.
|
||||
CEvtSimplexNameVerifyFailed {user :: User, chatRef :: ChatRef, simplexName :: SimplexNameInfo, reason :: SimplexNameVerifyFailReason}
|
||||
| -- Passive warning emitted when an incoming XInfo / XGrpInfo carries a
|
||||
-- simplex_name claim that the user has not (yet) verified — i.e.
|
||||
-- simplex_name_verified_at is NULL. The UI is expected to show an
|
||||
-- unverified indicator; the user can invoke APIVerifySimplexName to clear it.
|
||||
CEvtSimplexNameUnverified {user :: User, chatRef :: ChatRef, simplexName :: SimplexNameInfo}
|
||||
deriving (Show)
|
||||
|
||||
data SimplexNameConflictEntity = SNCEContact | SNCEGroup
|
||||
deriving (Show)
|
||||
|
||||
-- | Why APIVerifySimplexName failed. The resolved record is not stashed: we
|
||||
-- intentionally do not allow a "verified to point at a DIFFERENT contact"
|
||||
-- state; the user must decide whether to keep the existing contact or start
|
||||
-- a fresh connection with the resolved link.
|
||||
data SimplexNameVerifyFailReason
|
||||
= -- | Resolver returned a NameRecord but its link for this entity's type
|
||||
-- (nrSimplexContact for contacts, nrSimplexChannel for groups) differs
|
||||
-- from the link stored locally for the peer.
|
||||
SNVFLinkMismatch
|
||||
| -- | RSLV returned AUTH (NameNotRegistered): no on-chain record exists.
|
||||
SNVFNameNotRegistered
|
||||
| -- | Transport / proxy / other resolver-side failure. The agent error is
|
||||
-- surfaced verbatim so the UI can reuse existing agent-error rendering.
|
||||
SNVFResolverError {agentError :: AgentErrorType}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data TerminalEvent
|
||||
= TEGroupLinkRejected {user :: User, groupInfo :: GroupInfo, groupRejectionReason :: GroupRejectionReason}
|
||||
| TERelayRejected {user :: User, groupInfo :: GroupInfo, relayRejectionReason :: RelayRejectionReason}
|
||||
@@ -1783,6 +1817,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "SNCE") ''SimplexNameConflictEntity)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "SNVF") ''SimplexNameVerifyFailReason)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CEvt") ''ChatEvent)
|
||||
|
||||
$(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
|
||||
|
||||
@@ -2248,6 +2248,7 @@ processChatCommand vr nm = \case
|
||||
(ccLink, plan) <- connectPlanName user ni
|
||||
connectWithPlan user incognito ccLink plan
|
||||
Connect _ Nothing -> throwChatError CEInvalidConnReq
|
||||
APIVerifySimplexName chatRef -> withUser $ \user -> apiVerifySimplexName user chatRef
|
||||
APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
|
||||
ct@Contact {profile = LocalProfile {contactLink}} <- withFastStore $ \db -> getContact db vr user contactId
|
||||
ccLink <- case contactLink of
|
||||
@@ -4749,6 +4750,78 @@ resolveErrorToChatError ni = \case
|
||||
ResolverUnavailable -> ChatError $ CESimplexNameResolverUnavailable ni
|
||||
ResolverTransport e -> chatErrorAgent e
|
||||
|
||||
-- | Best-effort comparison between an RSLV-resolved link (a 'Text' from the
|
||||
-- name record) and the peer's stored connection link. Both are normalized via
|
||||
-- 'strDecode' + 'strEncode' so scheme drift (simplex:/ vs https://simplex.chat)
|
||||
-- doesn't cause a false negative. If the RSLV text fails to parse as a contact
|
||||
-- link, we treat it as a mismatch — the resolver returned something we don't
|
||||
-- understand, which is not a valid verification.
|
||||
linksMatch :: Text -> ConnLinkContact -> Bool
|
||||
linksMatch resolved stored = case strDecode (encodeUtf8 resolved) :: Either String AConnectionLink of
|
||||
Right (ACL SCMContact resolvedLink) -> normalize resolvedLink == normalize stored
|
||||
_ -> False
|
||||
where
|
||||
-- Mirror the inline 'serverShortLink' helper used elsewhere in this module:
|
||||
-- the agent's simplex:/ scheme and the server-hostname scheme encode the
|
||||
-- same link; verification must be scheme-insensitive.
|
||||
normalize :: ConnLinkContact -> ByteString
|
||||
normalize = \case
|
||||
CLFull cReq -> strEncode cReq
|
||||
CLShort (CSLContact _ ct srv linkKey) ->
|
||||
strEncode (CSLContact SLSServer ct srv linkKey :: ConnShortLink 'CMContact)
|
||||
|
||||
-- | Resolves the chat row's simplex_name claim via RSLV and compares the
|
||||
-- resolved per-type link to the peer's stored connection link. On match,
|
||||
-- timestamps the contact/group row and emits CEvtSimplexNameVerified.
|
||||
-- On mismatch / RSLV failure, emits CEvtSimplexNameVerifyFailed.
|
||||
-- Throws CESimplexNameNotFound when the row has no claim to verify.
|
||||
apiVerifySimplexName :: User -> ChatRef -> CM ChatResponse
|
||||
apiVerifySimplexName user chatRef = do
|
||||
vr <- chatVersionRange
|
||||
(claim, storedLink, persistVerified) <- loadClaimAndLink vr
|
||||
let domain = (\SimplexNameInfo {nameDomain} -> nameDomain) claim
|
||||
nameType' = (\SimplexNameInfo {nameType} -> nameType) claim
|
||||
resolveOnUserServers user domain >>= \case
|
||||
Right NameRecord {nrSimplexContact, nrSimplexChannel} -> do
|
||||
let resolvedLink = case nameType' of
|
||||
NTContact -> nrSimplexContact
|
||||
NTPublicGroup -> nrSimplexChannel
|
||||
case resolvedLink of
|
||||
Just lnk | linksMatch lnk storedLink -> do
|
||||
ts <- liftIO getCurrentTime
|
||||
withStore' $ \db -> persistVerified db ts
|
||||
toView $ CEvtSimplexNameVerified user chatRef claim ts
|
||||
_ ->
|
||||
toView $ CEvtSimplexNameVerifyFailed user chatRef claim SNVFLinkMismatch
|
||||
Left NameNotRegistered ->
|
||||
toView $ CEvtSimplexNameVerifyFailed user chatRef claim SNVFNameNotRegistered
|
||||
Left ResolverUnavailable ->
|
||||
throwChatError $ CESimplexNameResolverUnavailable claim
|
||||
Left (ResolverTransport e) ->
|
||||
toView $ CEvtSimplexNameVerifyFailed user chatRef claim (SNVFResolverError e)
|
||||
pure $ CRCmdOk (Just user)
|
||||
where
|
||||
-- Returns the claim to verify, the peer's stored link, and a callback that
|
||||
-- persists the verified_at timestamp to the appropriate table. Throws a
|
||||
-- command error when the row has no claim or no link (nothing to verify).
|
||||
loadClaimAndLink :: VersionRangeChat -> CM (SimplexNameInfo, ConnLinkContact, DB.Connection -> UTCTime -> IO ())
|
||||
loadClaimAndLink vr = case chatRef of
|
||||
ChatRef CTDirect cId _ -> do
|
||||
ct <- withFastStore $ \db -> getContact db vr user cId
|
||||
let Contact {contactId, simplexName = ctSimplexName, profile = LocalProfile {contactLink}} = ct
|
||||
claim <- maybe (throwCmdError "contact has no simplex_name to verify") pure ctSimplexName
|
||||
lnk <- maybe (throwCmdError "contact has no stored link to verify against") pure contactLink
|
||||
pure (claim, lnk, \db ts -> setContactSimplexNameVerifiedAt db user contactId ts)
|
||||
ChatRef CTGroup gId _ -> do
|
||||
g <- withFastStore $ \db -> getGroupInfo db vr user gId
|
||||
let GroupInfo {groupId, simplexName = gSimplexName, preparedGroup} = g
|
||||
claim <- maybe (throwCmdError "group has no simplex_name to verify") pure gSimplexName
|
||||
PreparedGroup {connLinkToConnect = CCLink cReq shortLink_} <-
|
||||
maybe (throwCmdError "group has no stored link to verify against") pure preparedGroup
|
||||
let lnk = maybe (CLFull cReq) CLShort shortLink_
|
||||
pure (claim, lnk, \db ts -> setGroupSimplexNameVerifiedAt db user groupId ts)
|
||||
_ -> throwCmdError "APIVerifySimplexName supports only direct and group chat refs"
|
||||
|
||||
-- | Pure iteration logic for 'resolveOnUserServers'. Extracted so tests can
|
||||
-- supply a stub resolver without standing up a real agent / proxy.
|
||||
iterateResolvers ::
|
||||
@@ -5395,6 +5468,7 @@ chatCommandP =
|
||||
"/_set conn user :" *> (APIChangeConnectionUser <$> A.decimal <* A.space <*> A.decimal),
|
||||
("/connect" <|> "/c") *> (AddContact <$> incognitoP),
|
||||
("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeTill isSpace $> Nothing)),
|
||||
"/_verify simplex name " *> (APIVerifySimplexName <$> chatRefP),
|
||||
ForwardMessage <$> chatNameP <* " <- @" <*> displayNameP <* A.space <*> msgTextP,
|
||||
ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <* A.space <* A.char '@' <*> (Just <$> displayNameP) <* A.space <*> msgTextP,
|
||||
ForwardGroupMessage <$> chatNameP <* " <- #" <*> displayNameP <*> pure Nothing <* A.space <*> msgTextP,
|
||||
|
||||
@@ -2566,8 +2566,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
else do
|
||||
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
|
||||
updateContactProfileWithConflict db user c' p'
|
||||
let Contact {localDisplayName = newLDN} = c'
|
||||
let Contact {contactId = ctId, localDisplayName = newLDN, simplexNameVerifiedAt = vAt} = c'
|
||||
surfaceSimplexNameConflict user p'SimplexName displaced_ SNCEContact newLDN
|
||||
-- Passive unverified warning: a non-empty incoming claim that the user
|
||||
-- has not verified (or whose prior verification was cleared by the
|
||||
-- claim transition in updateContactProfileWithConflict) should be
|
||||
-- surfaced so the UI can prompt the user to invoke APIVerifySimplexName.
|
||||
forM_ p'SimplexName $ \ni ->
|
||||
when (isNothing vAt) $
|
||||
toView $ CEvtSimplexNameUnverified user (ChatRef CTDirect ctId Nothing) ni
|
||||
when (directOrUsed c' && createItems) $ do
|
||||
createProfileUpdatedItem c'
|
||||
lift $ createRcvFeatureItems user c c'
|
||||
@@ -3307,8 +3314,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
case businessChat of
|
||||
Nothing -> unless (p == p') $ do
|
||||
(g', displaced_) <- withStore $ \db -> updateGroupProfileWithConflict db user g p'
|
||||
let GroupInfo {localDisplayName = newLDN} = g'
|
||||
let GroupInfo {groupId = gId, localDisplayName = newLDN, simplexNameVerifiedAt = vAt} = g'
|
||||
surfaceSimplexNameConflict user p'GroupSimplexName displaced_ SNCEGroup newLDN
|
||||
-- Passive unverified warning, mirrors processContactProfileUpdate.
|
||||
forM_ p'GroupSimplexName $ \ni ->
|
||||
when (isNothing vAt) $
|
||||
toView $ CEvtSimplexNameUnverified user (ChatRef CTGroup gId Nothing) ni
|
||||
(g'', m', scopeInfo) <- mkGroupChatScope g' m
|
||||
toView $ CEvtGroupUpdated user g g'' (Just m') msgSigned
|
||||
let cd = CDGroupRcv g'' scopeInfo m'
|
||||
|
||||
@@ -1461,6 +1461,8 @@ instance MsgDirectionI d => ToJSON (CIFile d) where
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GCS") ''GroupChatScope)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ChatRef)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCI") ''JSONCIDirection)
|
||||
|
||||
instance (ChatTypeI c, MsgDirectionI d) => FromJSON (CIDirection c d) where
|
||||
|
||||
@@ -120,7 +120,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
|]
|
||||
(userId, contactId, CSActive)
|
||||
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
|
||||
toContact' contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL, ctSimplexNameRaw, cpSimplexNameRaw)) =
|
||||
toContact' contactId conn chatTags ((profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL, ctSimplexNameRaw, cpSimplexNameRaw, simplexNameVerifiedAt)) =
|
||||
let simplexName = decodeSimplexName ctSimplexNameRaw
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName cpSimplexNameRaw, peerType, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
|
||||
@@ -128,7 +128,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
activeConn = Just conn
|
||||
preparedContact = toPreparedContact preparedContactRow
|
||||
groupDirectInv = toGroupDirectInvitation groupDirectInvRow
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData, simplexName}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData, simplexName, simplexNameVerifiedAt}
|
||||
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember_ groupMemberId c = do
|
||||
gm <-
|
||||
@@ -149,7 +149,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
g.use_relays, g.relay_own_status,
|
||||
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
|
||||
g.root_priv_key, g.root_pub_key, g.member_priv_key,
|
||||
g.simplex_name, gp.simplex_name,
|
||||
g.simplex_name, gp.simplex_name, g.simplex_name_verified_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
||||
@@ -113,7 +113,7 @@ createOrUpdateContactRequest
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
|
||||
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl, ct.simplex_name, cp.simplex_name,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl, ct.simplex_name, cp.simplex_name, ct.simplex_name_verified_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
|
||||
@@ -54,6 +54,7 @@ module Simplex.Chat.Store.Direct
|
||||
getContactIdBySimplexName,
|
||||
updateContactProfile,
|
||||
updateContactProfileWithConflict,
|
||||
setContactSimplexNameVerifiedAt,
|
||||
updateContactUserPreferences,
|
||||
updateContactAlias,
|
||||
updateContactConnectionAlias,
|
||||
@@ -322,7 +323,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash1 cReqHash2 = do
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
|
||||
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl, ct.simplex_name, cp.simplex_name,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl, ct.simplex_name, cp.simplex_name, ct.simplex_name_verified_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
@@ -573,24 +574,45 @@ updateContactProfile db user c p' = fst <$> updateContactProfileWithConflict db
|
||||
-- (user_id, simplex_name) — returning that row's display_name so the caller
|
||||
-- can emit CEvtSimplexNameConflict. Used by the incoming-XInfo path; local
|
||||
-- updates that don't expect conflicts can continue to use updateContactProfile.
|
||||
--
|
||||
-- Also clears contacts.simplex_name_verified_at when the peer's simplex_name
|
||||
-- claim changes (any value transition, including Nothing<->Just): the prior
|
||||
-- verification was tied to the prior claim and must be re-issued by the user.
|
||||
updateContactProfileWithConflict :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO (Contact, Maybe ContactName)
|
||||
updateContactProfileWithConflict db user@User {userId} c p'
|
||||
| displayName == newName = do
|
||||
displaced <- liftIO $ clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
|
||||
liftIO $ updateContactProfile_ db userId profileId p'
|
||||
pure (c {profile, mergedPreferences}, displaced)
|
||||
liftIO clearVerifiedAtIfClaimChanged
|
||||
pure (c' {profile, mergedPreferences}, displaced)
|
||||
| otherwise =
|
||||
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
||||
currentTs <- getCurrentTime
|
||||
displaced <- clearConflictingContactProfileSimplexName_ db userId (Just profileId) profileSimplexName
|
||||
updateContactProfile_' db userId profileId p' currentTs
|
||||
updateContactLDN_ db user contactId localDisplayName ldn currentTs
|
||||
pure $ Right (c {localDisplayName = ldn, profile, mergedPreferences}, displaced)
|
||||
clearVerifiedAtIfClaimChanged
|
||||
pure $ Right (c' {localDisplayName = ldn, profile, mergedPreferences}, displaced)
|
||||
where
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias, simplexName = prevClaim}, userPreferences} = c
|
||||
Profile {displayName = newName, simplexName = profileSimplexName, preferences} = p'
|
||||
profile = toLocalProfile profileId p' localAlias
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
|
||||
claimChanged = prevClaim /= profileSimplexName
|
||||
c' = if claimChanged then (c :: Contact) {simplexNameVerifiedAt = Nothing} else c
|
||||
clearVerifiedAtIfClaimChanged =
|
||||
when claimChanged $
|
||||
DB.execute db "UPDATE contacts SET simplex_name_verified_at = NULL WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
|
||||
-- | Records that the user successfully RSLV-verified the peer's simplex_name
|
||||
-- claim against the contact's stored connection link. Cleared back to NULL by
|
||||
-- updateContactProfileWithConflict whenever the peer's claim transitions.
|
||||
setContactSimplexNameVerifiedAt :: DB.Connection -> User -> ContactId -> UTCTime -> IO ()
|
||||
setContactSimplexNameVerifiedAt db User {userId} contactId ts =
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE contacts SET simplex_name_verified_at = ? WHERE user_id = ? AND contact_id = ?"
|
||||
(ts, userId, contactId)
|
||||
|
||||
updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
|
||||
updateContactUserPreferences db user@User {userId} c@Contact {contactId} userPreferences = do
|
||||
@@ -908,7 +930,8 @@ createContactFromRequest db user@User {userId, profile = LocalProfile {preferenc
|
||||
uiThemes = Nothing,
|
||||
chatDeleted = False,
|
||||
customData = Nothing,
|
||||
simplexName = Nothing
|
||||
simplexName = Nothing,
|
||||
simplexNameVerifiedAt = Nothing
|
||||
}
|
||||
pure (ct, conn)
|
||||
|
||||
@@ -955,7 +978,7 @@ getContact_ db vr user@User {userId} contactId deleted = do
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
|
||||
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl, ct.simplex_name, cp.simplex_name,
|
||||
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl, ct.simplex_name, cp.simplex_name, ct.simplex_name_verified_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
|
||||
@@ -47,6 +47,7 @@ module Simplex.Chat.Store.Groups
|
||||
getGroupInfoByGroupLinkHash,
|
||||
updateGroupProfile,
|
||||
updateGroupProfileWithConflict,
|
||||
setGroupSimplexNameVerifiedAt,
|
||||
clearConflictingGroupProfileSimplexName_,
|
||||
updateGroupPreferences,
|
||||
updateGroupProfileFromMember,
|
||||
@@ -425,7 +426,8 @@ createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays
|
||||
membersRequireAttention = 0,
|
||||
viaGroupLinkUri = Nothing,
|
||||
groupKeys,
|
||||
simplexName = Nothing
|
||||
simplexName = Nothing,
|
||||
simplexNameVerifiedAt = Nothing
|
||||
}
|
||||
|
||||
-- | creates a new group record for the group the current user was invited to, or returns an existing one
|
||||
@@ -503,7 +505,8 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
||||
membersRequireAttention = 0,
|
||||
viaGroupLinkUri = Nothing,
|
||||
groupKeys = Nothing,
|
||||
simplexName = Nothing
|
||||
simplexName = Nothing,
|
||||
simplexNameVerifiedAt = Nothing
|
||||
},
|
||||
groupMemberId
|
||||
)
|
||||
@@ -2393,13 +2396,14 @@ updateGroupProfile db user g p' = fst <$> updateGroupProfileWithConflict db user
|
||||
-- (user_id, simplex_name) — returning that row's display_name so the caller
|
||||
-- can emit CEvtSimplexNameConflict. Used by the XGrpInfo path.
|
||||
updateGroupProfileWithConflict :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO (GroupInfo, Maybe GroupName)
|
||||
updateGroupProfileWithConflict db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, shortDescr, description, image, publicGroup, simplexName, groupPreferences, memberAdmission}
|
||||
updateGroupProfileWithConflict db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, simplexName = prevClaim}} p'@GroupProfile {displayName = newName, fullName, shortDescr, description, image, publicGroup, simplexName, groupPreferences, memberAdmission}
|
||||
| displayName == newName = liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
profileId_ <- getGroupProfileId_
|
||||
displaced <- clearConflictingGroupProfileSimplexName_ db userId profileId_ simplexName
|
||||
updateGroupProfile_ currentTs
|
||||
pure ((g :: GroupInfo) {groupProfile = p', fullGroupPreferences}, displaced)
|
||||
clearVerifiedAtIfClaimChanged
|
||||
pure ((g' :: GroupInfo) {groupProfile = p', fullGroupPreferences}, displaced)
|
||||
| otherwise =
|
||||
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
||||
currentTs <- getCurrentTime
|
||||
@@ -2407,9 +2411,18 @@ updateGroupProfileWithConflict db user@User {userId} g@GroupInfo {groupId, local
|
||||
displaced <- clearConflictingGroupProfileSimplexName_ db userId profileId_ simplexName
|
||||
updateGroupProfile_ currentTs
|
||||
updateGroup_ ldn currentTs
|
||||
pure $ Right ((g :: GroupInfo) {localDisplayName = ldn, groupProfile = p', fullGroupPreferences}, displaced)
|
||||
clearVerifiedAtIfClaimChanged
|
||||
pure $ Right ((g' :: GroupInfo) {localDisplayName = ldn, groupProfile = p', fullGroupPreferences}, displaced)
|
||||
where
|
||||
fullGroupPreferences = mergeGroupPreferences groupPreferences
|
||||
claimChanged = prevClaim /= simplexName
|
||||
g' = if claimChanged then (g :: GroupInfo) {simplexNameVerifiedAt = Nothing} else g
|
||||
-- Mirrors updateContactProfileWithConflict: clear the verification when
|
||||
-- the peer's claim transitions to/from/between values; prior verification
|
||||
-- was bound to the prior claim.
|
||||
clearVerifiedAtIfClaimChanged =
|
||||
when claimChanged $
|
||||
DB.execute db "UPDATE groups SET simplex_name_verified_at = NULL WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
(groupType_, groupLink_) = case publicGroup of
|
||||
Just PublicGroupProfile {groupType, groupLink} -> (Just groupType, Just groupLink)
|
||||
Nothing -> (Nothing, Nothing)
|
||||
@@ -2475,6 +2488,14 @@ clearConflictingGroupProfileSimplexName_ db userId (Just profileId) (Just simple
|
||||
|]
|
||||
(userId, simplexName, profileId)
|
||||
|
||||
-- | Mirror of setContactSimplexNameVerifiedAt for groups.
|
||||
setGroupSimplexNameVerifiedAt :: DB.Connection -> User -> GroupId -> UTCTime -> IO ()
|
||||
setGroupSimplexNameVerifiedAt db User {userId} groupId ts =
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE groups SET simplex_name_verified_at = ? WHERE user_id = ? AND group_id = ?"
|
||||
(ts, userId, groupId)
|
||||
|
||||
updateGroupPreferences :: DB.Connection -> User -> GroupInfo -> GroupPreferences -> IO GroupInfo
|
||||
updateGroupPreferences db User {userId} g@GroupInfo {groupId, groupProfile = p} ps = do
|
||||
currentTs <- getCurrentTime
|
||||
@@ -2962,7 +2983,7 @@ createMemberContact
|
||||
simplexName = Nothing
|
||||
}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, preparedContact = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, groupDirectInv = Nothing, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing, simplexName = Nothing}
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, preparedContact = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, groupDirectInv = Nothing, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing, simplexName = Nothing, simplexNameVerifiedAt = Nothing}
|
||||
|
||||
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact db vr user contactId = do
|
||||
|
||||
@@ -37,6 +37,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260530_client_services
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260531_member_removed_at
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260603_simplex_name
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260604_simplex_name_profiles
|
||||
import Simplex.Chat.Store.Postgres.Migrations.M20260606_simplex_name_verified
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Text, Maybe Text)]
|
||||
@@ -73,7 +74,8 @@ schemaMigrations =
|
||||
("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
|
||||
("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
|
||||
("20260603_simplex_name", m20260603_simplex_name, Just down_m20260603_simplex_name),
|
||||
("20260604_simplex_name_profiles", m20260604_simplex_name_profiles, Just down_m20260604_simplex_name_profiles)
|
||||
("20260604_simplex_name_profiles", m20260604_simplex_name_profiles, Just down_m20260604_simplex_name_profiles),
|
||||
("20260606_simplex_name_verified", m20260606_simplex_name_verified, Just down_m20260606_simplex_name_verified)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.Postgres.Migrations.M20260606_simplex_name_verified where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
m20260606_simplex_name_verified :: Text
|
||||
m20260606_simplex_name_verified =
|
||||
[r|
|
||||
ALTER TABLE contacts ADD COLUMN simplex_name_verified_at TIMESTAMPTZ;
|
||||
ALTER TABLE groups ADD COLUMN simplex_name_verified_at TIMESTAMPTZ;
|
||||
|]
|
||||
|
||||
down_m20260606_simplex_name_verified :: Text
|
||||
down_m20260606_simplex_name_verified =
|
||||
[r|
|
||||
ALTER TABLE groups DROP COLUMN simplex_name_verified_at;
|
||||
ALTER TABLE contacts DROP COLUMN simplex_name_verified_at;
|
||||
|]
|
||||
@@ -160,6 +160,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260530_client_services
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260531_member_removed_at
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260603_simplex_name
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260604_simplex_name_profiles
|
||||
import Simplex.Chat.Store.SQLite.Migrations.M20260606_simplex_name_verified
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -319,7 +320,8 @@ schemaMigrations =
|
||||
("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
|
||||
("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
|
||||
("20260603_simplex_name", m20260603_simplex_name, Just down_m20260603_simplex_name),
|
||||
("20260604_simplex_name_profiles", m20260604_simplex_name_profiles, Just down_m20260604_simplex_name_profiles)
|
||||
("20260604_simplex_name_profiles", m20260604_simplex_name_profiles, Just down_m20260604_simplex_name_profiles),
|
||||
("20260606_simplex_name_verified", m20260606_simplex_name_verified, Just down_m20260606_simplex_name_verified)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -0,0 +1,26 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Store.SQLite.Migrations.M20260606_simplex_name_verified where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
-- contacts.simplex_name_verified_at and groups.simplex_name_verified_at record
|
||||
-- the timestamp when the user last verified that the peer's claimed simplex_name
|
||||
-- resolves (via RSLV) to the link stored locally for the contact/group.
|
||||
-- NULL means the claim is unverified and the UI should show an indicator.
|
||||
-- The column is cleared back to NULL whenever the simplex_name claim changes
|
||||
-- (updateContactProfileWithConflict / updateGroupProfileWithConflict).
|
||||
m20260606_simplex_name_verified :: Query
|
||||
m20260606_simplex_name_verified =
|
||||
[sql|
|
||||
ALTER TABLE contacts ADD COLUMN simplex_name_verified_at TEXT;
|
||||
ALTER TABLE groups ADD COLUMN simplex_name_verified_at TEXT;
|
||||
|]
|
||||
|
||||
down_m20260606_simplex_name_verified :: Query
|
||||
down_m20260606_simplex_name_verified =
|
||||
[sql|
|
||||
ALTER TABLE groups DROP COLUMN simplex_name_verified_at;
|
||||
ALTER TABLE contacts DROP COLUMN simplex_name_verified_at;
|
||||
|]
|
||||
@@ -94,6 +94,7 @@ CREATE TABLE contacts(
|
||||
grp_direct_inv_from_member_conn_id INTEGER REFERENCES connections(connection_id) ON DELETE SET NULL,
|
||||
grp_direct_inv_started_connection INTEGER NOT NULL DEFAULT 0,
|
||||
simplex_name TEXT,
|
||||
simplex_name_verified_at TEXT,
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
@@ -186,7 +187,8 @@ CREATE TABLE groups(
|
||||
relay_request_delay INTEGER NOT NULL DEFAULT 0,
|
||||
relay_request_execute_at TEXT NOT NULL DEFAULT '1970-01-01 00:00:00',
|
||||
relay_inactive_at TEXT,
|
||||
simplex_name TEXT, -- received
|
||||
simplex_name TEXT,
|
||||
simplex_name_verified_at TEXT, -- received
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
|
||||
@@ -544,14 +544,14 @@ type PreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Ma
|
||||
|
||||
type GroupDirectInvitationRow = (Maybe ConnReqInvitation, Maybe GroupId, Maybe GroupMemberId, Maybe Int64, BoolInt)
|
||||
|
||||
type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64, Maybe Text, Maybe Text)
|
||||
type ContactRow' = (ProfileId, ContactName, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64, Maybe Text, Maybe Text, Maybe UTCTime)
|
||||
|
||||
type ContactRow = Only ContactId :. ContactRow'
|
||||
|
||||
-- ct.simplex_name -> Contact.simplexName (user's locally-known label)
|
||||
-- cp.simplex_name -> LocalProfile.simplexName (peer's broadcast claim)
|
||||
toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
|
||||
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL, ctSimplexNameRaw, cpSimplexNameRaw)) :. connRow) =
|
||||
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL, ctSimplexNameRaw, cpSimplexNameRaw, simplexNameVerifiedAt)) :. connRow) =
|
||||
let simplexName = decodeSimplexName ctSimplexNameRaw
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = decodeSimplexName cpSimplexNameRaw, peerType, preferences, localAlias}
|
||||
activeConn = toMaybeConnection vr connRow
|
||||
@@ -560,7 +560,7 @@ toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, dis
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
|
||||
preparedContact = toPreparedContact preparedContactRow
|
||||
groupDirectInv = toGroupDirectInvitation groupDirectInvRow
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData, simplexName}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, groupDirectInv, chatTags, chatItemTTL, uiThemes, chatDeleted, customData, simplexName, simplexNameVerifiedAt}
|
||||
|
||||
toPreparedContact :: PreparedContactRow -> Maybe PreparedContact
|
||||
toPreparedContact (connFullLink, connShortLink, welcomeSharedMsgId, requestSharedMsgId) =
|
||||
@@ -728,7 +728,7 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
|
||||
|
||||
type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519)
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. (Maybe Text, Maybe Text) :. GroupMemberRow
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. (Maybe Text, Maybe Text, Maybe UTCTime) :. GroupMemberRow
|
||||
|
||||
type PublicGroupAccessRow = (Maybe Text, Maybe Text, Maybe BoolInt, Maybe BoolInt)
|
||||
|
||||
@@ -737,7 +737,7 @@ type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, Ver
|
||||
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences, Maybe Text)
|
||||
|
||||
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. (gSimplexNameRaw, gpSimplexNameRaw) :. userMemberRow) =
|
||||
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. (gSimplexNameRaw, gpSimplexNameRaw, simplexNameVerifiedAt) :. userMemberRow) =
|
||||
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
|
||||
fullGroupPreferences = mergeGroupPreferences groupPreferences
|
||||
@@ -752,7 +752,7 @@ toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName,
|
||||
businessChat = toBusinessChatInfo businessRow
|
||||
preparedGroup = toPreparedGroup preparedGroupRow
|
||||
groupSummary = GroupSummary {currentMembers, publicMemberCount}
|
||||
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, customData, membersRequireAttention, viaGroupLinkUri, groupKeys, simplexName}
|
||||
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, customData, membersRequireAttention, viaGroupLinkUri, groupKeys, simplexName, simplexNameVerifiedAt}
|
||||
|
||||
toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup
|
||||
toPreparedGroup = \case
|
||||
@@ -854,7 +854,7 @@ groupInfoQueryFields =
|
||||
g.use_relays, g.relay_own_status,
|
||||
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
|
||||
g.root_priv_key, g.root_pub_key, g.member_priv_key,
|
||||
g.simplex_name, gp.simplex_name,
|
||||
g.simplex_name, gp.simplex_name, g.simplex_name_verified_at,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
||||
@@ -210,7 +210,12 @@ data Contact = Contact
|
||||
uiThemes :: Maybe UIThemeEntityOverrides,
|
||||
chatDeleted :: Bool,
|
||||
customData :: Maybe CustomData,
|
||||
simplexName :: Maybe SimplexNameInfo
|
||||
simplexName :: Maybe SimplexNameInfo,
|
||||
-- | Timestamp of the most recent successful RSLV verification of the peer's
|
||||
-- simplex_name claim against this contact's connection link. NULL means the
|
||||
-- claim is unverified (UI should surface an indicator). Cleared back to NULL
|
||||
-- whenever simplex_name changes in updateContactProfileWithConflict.
|
||||
simplexNameVerifiedAt :: Maybe UTCTime
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -491,7 +496,10 @@ data GroupInfo = GroupInfo
|
||||
membersRequireAttention :: Int,
|
||||
viaGroupLinkUri :: Maybe ConnReqContact,
|
||||
groupKeys :: Maybe GroupKeys,
|
||||
simplexName :: Maybe SimplexNameInfo
|
||||
simplexName :: Maybe SimplexNameInfo,
|
||||
-- | See 'Contact.simplexNameVerifiedAt'. Verified against the channel link
|
||||
-- stored for the group; cleared by updateGroupProfileWithConflict.
|
||||
simplexNameVerifiedAt :: Maybe UTCTime
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
@@ -567,6 +567,16 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
|
||||
where
|
||||
entityLabel SNCEContact n = "@" <> n
|
||||
entityLabel SNCEGroup n = "#" <> n
|
||||
CEvtSimplexNameVerified u _chatRef ni _ts ->
|
||||
ttyUser u ["simplex name " <> plain (shortNameInfoStr ni) <> " verified"]
|
||||
CEvtSimplexNameVerifyFailed u _chatRef ni r ->
|
||||
ttyUser u ["simplex name " <> plain (shortNameInfoStr ni) <> " verification failed: " <> reason r]
|
||||
where
|
||||
reason SNVFLinkMismatch = "link mismatch"
|
||||
reason SNVFNameNotRegistered = "name not registered"
|
||||
reason (SNVFResolverError e) = "resolver error: " <> sShow e
|
||||
CEvtSimplexNameUnverified u _chatRef ni ->
|
||||
ttyUser u ["simplex name " <> plain (shortNameInfoStr ni) <> " is unverified"]
|
||||
where
|
||||
ttyUser :: User -> [StyledString] -> [StyledString]
|
||||
ttyUser user@User {showNtfs, activeUser, viewPwdHash} ss
|
||||
|
||||
@@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
@@ -7,11 +9,13 @@ import Data.Functor.Identity (Identity (..))
|
||||
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
|
||||
import Simplex.Chat.Library.Commands (ResolveError (..), firstNameLink, iterateResolvers, resolveErrorToChatError)
|
||||
import Simplex.Chat.Library.Commands (ResolveError (..), firstNameLink, iterateResolvers, linksMatch, resolveErrorToChatError)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Agent.Protocol (AgentErrorType (..), SimplexNameDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..))
|
||||
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), AgentErrorType (..), ConnShortLink, ConnectionLink (..), ConnectionMode (..), SConnectionMode (..), SimplexNameDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..))
|
||||
import Simplex.Messaging.Client (ProxyClientError (..))
|
||||
import Simplex.Messaging.Encoding.String (strDecode)
|
||||
import Simplex.Messaging.Protocol (BrokerErrorType (..), NameRecord (..), NetworkError (..), SMPServer, mkNameOwner, pattern SMPServer)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import Test.Hspec
|
||||
@@ -107,6 +111,52 @@ resolveNameTests = do
|
||||
case firstNameLink NTContact (Just channelLink) Nothing aliceNi of
|
||||
Left (ChatError (CESimplexNameNotFound _)) -> pure ()
|
||||
other -> expectationFailure $ "expected CESimplexNameNotFound, got " <> show other
|
||||
-- linksMatch is the byte-equal-after-normalize comparator that gates
|
||||
-- APIVerifySimplexName. The agent's simplex:/ scheme and the server-hostname
|
||||
-- scheme encode the same link, so a successful verification must accept
|
||||
-- either side using either scheme. A malformed RSLV link (anything that
|
||||
-- doesn't parse as a contact link) is rejected.
|
||||
describe "linksMatch" $ do
|
||||
let storedShort = CLShort sampleShortLinkServer
|
||||
it "matches an RSLV link in server scheme against a stored short-link" $
|
||||
linksMatch sampleShortLinkServerText storedShort `shouldBe` True
|
||||
it "matches across scheme normalization (simplex:/ vs https://)" $
|
||||
linksMatch sampleShortLinkSimplexText storedShort `shouldBe` True
|
||||
it "rejects a non-contact-link RSLV payload" $
|
||||
linksMatch "not-a-link" storedShort `shouldBe` False
|
||||
it "rejects a structurally different short-link" $
|
||||
linksMatch differentShortLinkText storedShort `shouldBe` False
|
||||
it "matches an invitation-shaped link only if both sides parse as contact" $
|
||||
-- invitation-typed RSLV link is not CMContact and must be rejected even
|
||||
-- if the bytes look superficially similar.
|
||||
linksMatch invitationLikeText storedShort `shouldBe` False
|
||||
|
||||
-- | Known-good short contact link in server-hostname scheme. Mirrors the
|
||||
-- canonical encoding from simplexmq's ConnectionRequestTests.hs:
|
||||
-- @CSLContact SLSServer CCTContact srv (LinkKey ...)@.
|
||||
sampleShortLinkServerText :: Text
|
||||
sampleShortLinkServerText = "https://smp.simplex.im/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
|
||||
|
||||
-- | The same link as 'sampleShortLinkServerText' but in the agent's
|
||||
-- simplex:/ scheme. normalize must collapse these to byte-equal forms.
|
||||
sampleShortLinkSimplexText :: Text
|
||||
sampleShortLinkSimplexText = "simplex:/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=smp.simplex.im%2Cjjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
|
||||
|
||||
-- | Structurally different short link (different LinkKey). Must NOT match.
|
||||
differentShortLinkText :: Text
|
||||
differentShortLinkText = "https://smp.simplex.im/a#YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWE?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
|
||||
|
||||
-- | An invitation-shaped link (path /i not /a). Even if the bytes happen to
|
||||
-- parse as some AConnectionLink, the SCMContact projection must fail.
|
||||
invitationLikeText :: Text
|
||||
invitationLikeText = "https://smp.simplex.im/i#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
|
||||
|
||||
-- | Parsed form of 'sampleShortLinkServerText' for use as the stored side
|
||||
-- of the linksMatch comparison.
|
||||
sampleShortLinkServer :: ConnShortLink 'CMContact
|
||||
sampleShortLinkServer = case strDecode (T.encodeUtf8 sampleShortLinkServerText) of
|
||||
Right (ACL SCMContact (CLShort l)) -> l
|
||||
other -> error $ "ResolveNameTests fixture failed to parse: " <> show other
|
||||
|
||||
-- | Wrap a resolver to record which servers it was called for.
|
||||
recording :: IORef [SMPServer] -> (SMPServer -> IO (Either AgentErrorType NameRecord)) -> SMPServer -> IO (Either AgentErrorType NameRecord)
|
||||
|
||||
Reference in New Issue
Block a user