From 5e1247e6cfd8194d508b5acb72c08cc5acca583c Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 28 Jun 2026 14:59:46 +0000 Subject: [PATCH] change field for name --- src/Simplex/Chat/Core.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 28 +++++++++++++-------------- src/Simplex/Chat/Library/Internal.hs | 16 +++++++-------- src/Simplex/Chat/Names.hs | 27 +++++++++++++++++++++++++- src/Simplex/Chat/ProfileGenerator.hs | 2 +- src/Simplex/Chat/Store/Connections.hs | 3 ++- src/Simplex/Chat/Store/Direct.hs | 21 ++++++++++---------- src/Simplex/Chat/Store/Profiles.hs | 9 +++++---- src/Simplex/Chat/Store/Shared.hs | 14 +++++++------- src/Simplex/Chat/Types.hs | 25 ++++++++++++------------ src/Simplex/Chat/View.hs | 11 ++++++----- 11 files changed, 92 insertions(+), 66 deletions(-) diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 752dfbf6ec..957812f6e9 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -140,7 +140,7 @@ createActiveUser cc CoreChatOpts {chatRelay} = \case displayName <- T.pack <$> withPrompt "display name" getLine createUser loop False $ mkProfile displayName where - mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing} + mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, simplexName = Nothing} createUser onError clientService p = execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False, userChatRelay = BoolDef chatRelay, clientService = BoolDef clientService}) 0 `runReaderT` cc >>= \case Right (CRActiveUser user) -> pure user diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 98f9592583..55d06e4af2 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -56,7 +56,7 @@ import qualified Data.UUID as UUID import qualified Data.UUID.V4 as V4 import Simplex.Chat.Library.Subscriber import Simplex.Chat.Badges (BadgeCredential (..), LocalBadge (..), ProofPresHeader (..), maxXFTPFileSize, mkBadgeStatus, proofPresHeaderLink, verifyCredential) -import Simplex.Chat.Names (NameClaimProof (..), signNameProof, verifyNameProofSig) +import Simplex.Chat.Names (NameClaimProof (..), claimName, claimProof, mkSimplexNameClaim, signNameProof, verifyNameProofSig) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Delivery (DeliveryJobScope (..), DeliveryJobSpec (..), DeliveryWorkerScope (..)) @@ -1492,8 +1492,8 @@ processChatCommand cxt nm = \case withCurrentCall contactId $ \user ct call -> updateCallItemStatus user ct call receivedStatus Nothing $> Just call APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile) - APISetUserName userId name_ -> withUserId userId $ \user@User {profile = oldLP@LocalProfile {contactLink, contactDomain}} -> - if contactDomain == name_ + APISetUserName userId name_ -> withUserId userId $ \user@User {profile = oldLP@LocalProfile {contactLink, simplexName}} -> + if (claimName <$> simplexName) == name_ then pure $ CRUserProfileNoChange user else do -- setting a name needs an address (creating its short link if missing) that the name resolves to; clearing just drops it @@ -1507,7 +1507,7 @@ processChatCommand cxt nm = \case -- the registry resolves a name to short links; require it to point to our address's short link unless (maybe False (`nameResolvesTo` nrSimplexContact) sl) $ throwCmdError "name is not registered to your address" pure $ Just $ maybe (CLFull fl) CLShort sl - let p' = (fromLocalProfile oldLP :: Profile) {contactDomain = StrJSON <$> name_, contactLink = contactLink'} + let p' = (fromLocalProfile oldLP :: Profile) {simplexName = mkSimplexNameClaim name_ Nothing, contactLink = contactLink'} updateProfile_ user p' True $ withFastStore $ \db -> do user' <- updateUserProfile db user p' liftIO $ setUserSimplexName db user' name_ @@ -1999,7 +1999,7 @@ processChatCommand cxt nm = \case EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId ChatHelp section -> pure $ CRChatHelp section Welcome -> withUser $ pure . CRWelcome - APIAddContact userId incognito -> withUserId userId $ \user@User {profile = LocalProfile {contactDomain = userName_}} -> do + APIAddContact userId incognito -> withUserId userId $ \user@User {profile = LocalProfile {simplexName}} -> do -- [incognito] generate profile for connection incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode @@ -2013,7 +2013,7 @@ processChatCommand cxt nm = \case unless (isJust incognitoProfile) $ do addressKey_ <- withFastStore' $ \db -> getUserAddressSigKey db user let CCLink _ inviteSLnk_ = ccLink' - proofProfile = signAddressNameProof (ACSL SCMInvitation <$> inviteSLnk_) addressKey_ userName_ linkProfile + proofProfile = signAddressNameProof (ACSL SCMInvitation <$> inviteSLnk_) addressKey_ (claimName <$> simplexName) linkProfile when (proofProfile /= linkProfile) $ void $ updatePCCShortLinkData conn proofProfile pure $ CRInvitation user ccLink' conn AddContact incognito -> withUser $ \User {userId} -> @@ -3861,10 +3861,10 @@ processChatCommand cxt nm = \case fmap $ \SndMessage {msgId, msgBody} -> (conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId])) setMyAddressData :: User -> UserContactLink -> CM UserContactLink - setMyAddressData user@User {userChatRelay, profile = LocalProfile {contactDomain = userName_}} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do + setMyAddressData user@User {userChatRelay, profile = LocalProfile {simplexName}} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink sLnk_, addressSettings} = do conn <- withFastStore $ \db -> getUserAddressConnection db cxt user rootKey_ <- withFastStore' $ \db -> getUserAddressSigKey db user - shortLinkProfile <- signAddressNameProof (ACSL SCMContact <$> sLnk_) rootKey_ userName_ <$> presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True) + shortLinkProfile <- signAddressNameProof (ACSL SCMContact <$> sLnk_) rootKey_ (claimName <$> simplexName) <$> presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True) -- TODO [short links] do not save address to server if data did not change, spinners, error handling let userData | isTrue userChatRelay = relayShortLinkData shortLinkProfile @@ -4206,8 +4206,8 @@ processChatCommand cxt nm = \case ov = verifyLinkOwner rootKey owners l' sig_ plan <- contactRequestPlan user cReq contactSLinkData_ ov case (nl, plan) of - (CTName ni, CPContactAddress (CAPOk (Just ContactShortLinkData {profile = p@Profile {contactDomain = cd, contactDomainProof = cdp}}) _)) -> do - domainVerified <- verifyNameClaim ni (unStrJSON <$> cd) cdp (ACSL SCMContact l') rootKey owners + (CTName ni, CPContactAddress (CAPOk (Just ContactShortLinkData {profile = p@Profile {simplexName}}) _)) -> do + domainVerified <- verifyNameClaim ni (claimName <$> simplexName) (claimProof =<< simplexName) (ACSL SCMContact l') rootKey owners ct <- withStore $ \db -> createPreparedContact db cxt user p (con l' cReq) Nothing domainVerified pure (con l' cReq, CPContactAddress (CAPKnown ct)) _ -> pure (con l' cReq, plan) @@ -4859,9 +4859,9 @@ verifyEntityName user nm claim_ connLink_ proof_ noNameErr persist = do apiVerifyContactName :: User -> NetworkRequestMode -> ContactId -> CM ChatResponse apiVerifyContactName user nm contactId = do cxt <- chatStoreCxt - Contact {profile = LocalProfile {contactDomain, contactDomainProof}, preparedContact} <- withFastStore $ \db -> getContact db cxt user contactId + Contact {profile = LocalProfile {simplexName}, preparedContact} <- withFastStore $ \db -> getContact db cxt user contactId let connLink_ = preparedContact >>= \PreparedContact {connLinkToConnect = ACCL m (CCLink _ sLnk_)} -> ACSL m <$> sLnk_ - reason <- verifyEntityName user nm contactDomain connLink_ contactDomainProof "contact has no name to verify" $ + reason <- verifyEntityName user nm (claimName <$> simplexName) connLink_ (claimProof =<< simplexName) "contact has no name to verify" $ \v -> withStore' $ \db -> setContactDomainVerified db user contactId v ct' <- withFastStore $ \db -> getContact db cxt user contactId pure $ CRContactNameVerified user ct' reason @@ -5724,7 +5724,7 @@ chatCommandP = newUserP relay = do (cName, shortDescr) <- profileNameDescr service <- (" service=" *> onOffP) <|> pure False - let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing} + let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, simplexName = Nothing} pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef relay, clientService = BoolDef service} newBotUserP = do files_ <- optional $ "files=" *> onOffP <* A.space @@ -5733,7 +5733,7 @@ chatCommandP = let preferences = case files_ of Just True -> Nothing _ -> Just (emptyChatPrefs :: Preferences) {files = Just FilesPreference {allow = FANo}} - profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing} + profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences, badge = Nothing, simplexName = Nothing} pure NewUser {profile, pastTimestamp = False, userChatRelay = BoolDef False, clientService = BoolDef service} jsonP :: J.FromJSON a => Parser a jsonP = J.eitherDecodeStrict' <$?> A.takeByteString diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index f032c63b2c..b25af6fd5c 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -54,7 +54,7 @@ import Data.Time (addUTCTime) import Data.Time.Calendar (fromGregorian) import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds, secondsToDiffTime) import Simplex.Chat.Badges (BadgeCredential (..), ProofPresHeader (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), badgeProof, mkBadgeStatus, verifyBadge) -import Simplex.Chat.Names (signNameProof) +import Simplex.Chat.Names (SimplexNameClaim (..), claimName, mkSimplexNameClaim, signNameProof) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Files @@ -1244,11 +1244,11 @@ memberInfo g m@GroupMember {memberId, memberRole, memberProfile, memberPubKey, a } redactedMemberProfile :: GroupInfo -> GroupMember -> Profile -> Profile -redactedMemberProfile g m Profile {displayName, fullName, shortDescr, image, contactLink = lnk, peerType, badge, contactDomain = d} = - Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, image, contactLink, preferences = Nothing, peerType, badge, contactDomain, contactDomainProof = Nothing} +redactedMemberProfile g m Profile {displayName, fullName, shortDescr, image, contactLink = lnk, peerType, badge, simplexName} = + Profile {displayName, fullName, shortDescr = removeSimplexLink =<< shortDescr, image, contactLink, preferences = Nothing, peerType, badge, simplexName = redactedName} where contactLink = if allowSimplexLinks then lnk else Nothing - contactDomain = if allowDirect then d else Nothing + redactedName = mkSimplexNameClaim (if allowDirect then claimName <$> simplexName else Nothing) Nothing allowDirect = groupFeatureMemberAllowed SGFDirectMessages m g allowSimplexLinks = groupFeatureMemberAllowed SGFSimplexLinks m g && allowDirect removeSimplexLink s @@ -2059,7 +2059,7 @@ presentUserBadge User {profile = LocalProfile {localBadge}} incognitoProfile p = -- the link the profile is saved to. No-op without a name, key, or link. signAddressNameProof :: Maybe AConnShortLink -> Maybe C.PrivateKeyEd25519 -> Maybe SimplexNameInfo -> Profile -> Profile signAddressNameProof (Just lnk) (Just rootKey) (Just name) p = - p {contactDomainProof = Just $ signNameProof rootKey Nothing name (PHSimplexLink lnk)} + p {simplexName = Just $ SimplexNameClaim name (Just $ signNameProof rootKey Nothing name (PHSimplexLink lnk))} signAddressNameProof _ _ _ p = p -- receiving side of contact/invitation link data: verify the badge proof from the link profile @@ -3103,8 +3103,7 @@ simplexTeamContactProfile = peerType = Nothing, preferences = Nothing, badge = Nothing, - contactDomain = Nothing, - contactDomainProof = Nothing + simplexName = Nothing } simplexStatusContactProfile :: Profile @@ -3118,8 +3117,7 @@ simplexStatusContactProfile = peerType = Just CPTBot, preferences = Nothing, badge = Nothing, - contactDomain = Nothing, - contactDomainProof = Nothing + simplexName = Nothing } timeItToView :: String -> CM' a -> CM' a diff --git a/src/Simplex/Chat/Names.hs b/src/Simplex/Chat/Names.hs index 194e17934e..79ae14dc11 100644 --- a/src/Simplex/Chat/Names.hs +++ b/src/Simplex/Chat/Names.hs @@ -8,7 +8,12 @@ {-# LANGUAGE TemplateHaskell #-} module Simplex.Chat.Names - ( NameClaimProof (..), + ( SimplexNameClaim (..), + mkSimplexNameClaim, + claimName, + claimProof, + setClaimProof, + NameClaimProof (..), signNameProof, verifyNameProofSig, ) @@ -67,3 +72,23 @@ $(JQ.deriveJSON defaultJSON ''NameClaimProof) instance ToField NameClaimProof where toField = toField . encodeJSON instance FromField NameClaimProof where fromField = fromTextField_ decodeJSON + +data SimplexNameClaim = SimplexNameClaim + { name :: SimplexNameInfo, + proof :: Maybe NameClaimProof + } + deriving (Eq, Show) + +mkSimplexNameClaim :: Maybe SimplexNameInfo -> Maybe NameClaimProof -> Maybe SimplexNameClaim +mkSimplexNameClaim name_ proof_ = (`SimplexNameClaim` proof_) <$> name_ + +claimName :: SimplexNameClaim -> SimplexNameInfo +claimName (SimplexNameClaim n _) = n + +claimProof :: SimplexNameClaim -> Maybe NameClaimProof +claimProof (SimplexNameClaim _ p) = p + +setClaimProof :: Maybe NameClaimProof -> SimplexNameClaim -> SimplexNameClaim +setClaimProof p (SimplexNameClaim n _) = SimplexNameClaim n p + +$(JQ.deriveJSON defaultJSON ''SimplexNameClaim) diff --git a/src/Simplex/Chat/ProfileGenerator.hs b/src/Simplex/Chat/ProfileGenerator.hs index e52f7d58ee..722c7c5f62 100644 --- a/src/Simplex/Chat/ProfileGenerator.hs +++ b/src/Simplex/Chat/ProfileGenerator.hs @@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile generateRandomProfile = do adjective <- pick adjectives noun <- pickNoun adjective 2 - pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing} + pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing, badge = Nothing, simplexName = Nothing} where pick :: [a] -> IO a pick xs = (xs !!) <$> randomRIO (0, length xs - 1) diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index a4be2d81e0..fef10a4d93 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -35,6 +35,7 @@ import Simplex.Chat.Protocol import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Groups import Simplex.Chat.Store.Shared +import Simplex.Chat.Names (mkSimplexNameClaim) import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (ConnId) import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', fromOnlyBI, maybeFirstRow) @@ -125,7 +126,7 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do (userId, contactId, CSActive) toContact' :: UTCTime -> Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact toContact' currentTs 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) :. badgeRow :. (cpContactDomain, cpContactDomainVerification, cpContactDomainProof)) = - let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, contactDomainProof = cpContactDomainProof, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias} + let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = mkSimplexNameClaim cpContactDomain cpContactDomainProof, contactDomainVerification = unBI <$> cpContactDomainVerification, peerType, localBadge = rowToBadge currentTs badgeRow, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn activeConn = Just conn diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 23da14a29a..7b93599641 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -110,6 +110,7 @@ import Data.Type.Equality import Simplex.Chat.Badges (badgeToRow) import Simplex.Chat.Messages import Simplex.Chat.Store.Shared +import Simplex.Chat.Names (claimName, claimProof, mkSimplexNameClaim, setClaimProof) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.UITheme @@ -568,11 +569,11 @@ updateContactProfile db cxt user@User {userId} c p' = do profile = toLocalProfile profileId p'' localAlias currentTs badgeVerified nameVerified updateContactProfile' currentTs badgeVerified profile where - Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, contactDomain = prevDomain, contactDomainVerification = prevVerification, contactDomainProof = prevProof}, userPreferences} = c - Profile {displayName = newName, contactDomain, preferences} = p' + Contact {contactId, localDisplayName, profile = lp@LocalProfile {profileId, displayName, localAlias, simplexName = prevClaim, contactDomainVerification = prevVerification}, userPreferences} = c + Profile {displayName = newName, simplexName, preferences} = p' mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c - claimChanged = prevDomain /= (unStrJSON <$> contactDomain) - p'' = (p' :: Profile) {contactDomainProof = if claimChanged then Nothing else prevProof} + claimChanged = (claimName <$> prevClaim) /= (claimName <$> simplexName) + p'' = (p' :: Profile) {simplexName = setClaimProof (if claimChanged then Nothing else claimProof =<< prevClaim) <$> simplexName} clearVerificationIfClaimChanged = when claimChanged $ DB.execute db "UPDATE contact_profiles SET contact_domain_verification = NULL WHERE user_id = ? AND contact_profile_id = ?" (userId, profileId) @@ -729,7 +730,7 @@ updateContactProfile_ db userId profileId profile badgeVerified = do updateContactProfile_' db userId profileId profile badgeVerified currentTs updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO () -updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainProof, preferences, peerType, badge} badgeVerified updatedAt = +updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, simplexName, preferences, peerType, badge} badgeVerified updatedAt = DB.execute db [sql| @@ -740,7 +741,7 @@ updateContactProfile_' db userId profileId Profile {displayName, fullName, short contact_domain_proof = ? WHERE user_id = ? AND contact_profile_id = ? |] - ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. ((unStrJSON <$> contactDomain), contactDomainProof) :. (userId, profileId)) + ((displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt) :. badgeToRow badge badgeVerified :. (claimName <$> simplexName, claimProof =<< simplexName) :. (userId, profileId)) -- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs) updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO () @@ -749,7 +750,7 @@ updateMemberContactProfileReset_ db userId profileId profile badgeVerified = do updateMemberContactProfileReset_' db userId profileId profile badgeVerified currentTs updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO () -updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, contactDomainProof, badge} badgeVerified updatedAt = +updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, shortDescr, image, simplexName, badge} badgeVerified updatedAt = DB.execute db [sql| @@ -760,7 +761,7 @@ updateMemberContactProfileReset_' db userId profileId Profile {displayName, full contact_domain_proof = ? WHERE user_id = ? AND contact_profile_id = ? |] - ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. ((unStrJSON <$> contactDomain), contactDomainProof) :. (userId, profileId)) + ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (claimName <$> simplexName, claimProof =<< simplexName) :. (userId, profileId)) -- update only member profile fields (when member has associated contact - we keep contactLink and prefs) updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> IO () @@ -769,7 +770,7 @@ updateMemberContactProfile_ db userId profileId profile badgeVerified = do updateMemberContactProfile_' db userId profileId profile badgeVerified currentTs updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> Maybe Bool -> UTCTime -> IO () -updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactDomain, contactDomainProof, badge} badgeVerified updatedAt = +updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, simplexName, badge} badgeVerified updatedAt = DB.execute db [sql| @@ -780,7 +781,7 @@ updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, contact_domain_proof = ? WHERE user_id = ? AND contact_profile_id = ? |] - ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. ((unStrJSON <$> contactDomain), contactDomainProof) :. (userId, profileId)) + ((displayName, fullName, shortDescr, image, updatedAt) :. badgeToRow badge badgeVerified :. (claimName <$> simplexName, claimProof =<< simplexName) :. (userId, profileId)) updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO () updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 63caa5ffcd..17cc1e902c 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -107,6 +107,7 @@ import Simplex.Chat.Operators import Simplex.Chat.Protocol import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Shared +import Simplex.Chat.Names (claimName, mkSimplexNameClaim) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared @@ -393,7 +394,7 @@ setUserSimplexName db user@User {userId, profile = p@LocalProfile {profileId}} n db "UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user_id = ? AND contact_profile_id = ?" (name_, ts, userId, profileId) - pure (user :: User) {profile = p {contactDomain = name_}} + pure (user :: User) {profile = p {simplexName = mkSimplexNameClaim name_ Nothing}} setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do @@ -424,7 +425,7 @@ getUserContactProfiles db User {userId} = (Only userId) where toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe SimplexNameInfo, Maybe Preferences) -> Profile - toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, contactDomain, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain = StrJSON <$> contactDomain, peerType, preferences, badge = Nothing, contactDomainProof = Nothing} + toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, contactDomain, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, simplexName = mkSimplexNameClaim contactDomain Nothing, peerType, preferences, badge = Nothing} createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> C.PrivateKeyEd25519 -> ExceptT StoreError IO () createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode linkPrivSigKey = @@ -563,12 +564,12 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) = DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND conn_req_contact IN (?,?)") (userId, cReqSchema1, cReqSchema2) getUserContactLinkViaTarget :: DB.Connection -> User -> ContactNameOrLink -> IO (Maybe UserContactLink) -getUserContactLinkViaTarget db User {userId, profile = LocalProfile {contactDomain}} = \case +getUserContactLinkViaTarget db User {userId, profile = LocalProfile {simplexName}} = \case CTLink shortLink -> maybeFirstRow toUserContactLink $ DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND short_link_contact = ?") (userId, shortLink) CTName ni - | contactDomain == Just ni -> + | (claimName <$> simplexName) == Just ni -> maybeFirstRow toUserContactLink $ DB.query db (userContactLinkQuery <> " WHERE user_id = ? AND group_id IS NULL AND short_link_contact IS NOT NULL") (Only userId) | otherwise -> pure Nothing diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 7ad9bdcb30..84083275d5 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -34,7 +34,7 @@ import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime (..), getCurrentTime) import Data.Type.Equality import Simplex.Chat.Badges (BadgeRow, badgeToRow, rowToBadge, verifyBadge_) -import Simplex.Chat.Names (NameClaimProof) +import Simplex.Chat.Names (NameClaimProof, claimName, claimProof, mkSimplexNameClaim) import Simplex.Chat.Messages import Simplex.Chat.Remote.Types import Simplex.Chat.Types @@ -417,13 +417,13 @@ createContact db cxt user profile = do void $ createContact_ db cxt user profile emptyChatPrefs Nothing "" currentTs createContact_ :: DB.Connection -> StoreCxt -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> UTCTime -> ExceptT StoreError IO ContactId -createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainProof, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs = +createContact_ db cxt User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, simplexName, peerType, badge, preferences} ctUserPreferences prepared localAlias currentTs = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do badgeVerified <- verifyBadge_ (badgeKeys cxt) badge DB.execute db "INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at, badge_proof, badge_pres_header, badge_expiry, badge_type, badge_verified, badge_extra, badge_master_key, badge_signature, badge_key_idx, contact_domain, contact_domain_proof) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" - ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. ((unStrJSON <$> contactDomain), contactDomainProof)) + ((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs) :. badgeToRow badge badgeVerified :. (claimName <$> simplexName, claimProof =<< simplexName)) profileId <- insertedRowId db DB.execute db @@ -496,7 +496,7 @@ type ContactRow = Only ContactId :. ContactRow' toContact :: UTCTime -> StoreCxt -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact toContact now cxt 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) :. badgeRow :. (cpContactDomain, cpContactDomainVerification, cpContactDomainProof)) :. connRow) = - let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain = cpContactDomain, contactDomainVerification = unBI <$> cpContactDomainVerification, contactDomainProof = cpContactDomainProof, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias} + let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = mkSimplexNameClaim cpContactDomain cpContactDomainProof, contactDomainVerification = unBI <$> cpContactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, preferences, localAlias} activeConn = toMaybeConnection cxt connRow chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite} incognito = maybe False connIncognito activeConn @@ -539,7 +539,7 @@ type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe toContactRequest :: UTCTime -> ContactRequestRow -> UserContactRequest toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer) :. badgeRow :. (contactDomain, contactDomainVerification, contactDomainProof)) = do - let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, contactDomainProof, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias} + let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = mkSimplexNameClaim contactDomain contactDomainProof, contactDomainVerification = unBI <$> contactDomainVerification, peerType, preferences, localBadge = rowToBadge now badgeRow, localAlias} cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer in UserContactRequest {contactRequestId, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt} @@ -558,7 +558,7 @@ toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. ( toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. (contactDomain, contactDomainVerification, contactDomainProof)) = User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes} where - profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, contactDomainProof, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""} + profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = mkSimplexNameClaim contactDomain contactDomainProof, contactDomainVerification = unBI <$> contactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""} fullPreferences = fullPreferences' userPreferences viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_ @@ -772,7 +772,7 @@ toContactMember now cxt User {userContactId} (memberRow :. connRow) = rowToLocalProfile :: UTCTime -> ProfileRow -> LocalProfile rowToLocalProfile now ((profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) :. badgeRow :. (contactDomain, contactDomainVerification, contactDomainProof)) = - LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, contactDomain, contactDomainVerification = unBI <$> contactDomainVerification, contactDomainProof, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences} + LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, simplexName = mkSimplexNameClaim contactDomain contactDomainProof, contactDomainVerification = unBI <$> contactDomainVerification, peerType, localBadge = rowToBadge now badgeRow, localAlias, preferences} toBusinessChatInfo :: BusinessChatInfoRow -> Maybe BusinessChatInfo toBusinessChatInfo (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId} diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index e8cba67d40..9c38a46e4c 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -52,7 +52,7 @@ import Data.Type.Equality (testEquality, (:~:) (Refl)) import Data.Typeable (Typeable) import Data.Word (Word16) import Simplex.Chat.Badges (BadgeInfo (..), BadgeProof (..), BadgeStatus (..), LocalBadge (..), localBadgeInfo, localBadgeStatus, mkBadgeStatus, verifyBadge) -import Simplex.Chat.Names (NameClaimProof (..)) +import Simplex.Chat.Names (NameClaimProof (..), SimplexNameClaim, setClaimProof) import Simplex.Messaging.Crypto.BBS (BBSPublicKey) import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared @@ -698,8 +698,7 @@ data Profile = Profile preferences :: Maybe Preferences, peerType :: Maybe ChatPeerType, badge :: Maybe BadgeProof, - contactDomain :: Maybe (StrJSON "SimplexNameInfo" SimplexNameInfo), - contactDomainProof :: Maybe NameClaimProof + simplexName :: Maybe SimplexNameClaim -- fields that should not be read into this data type to prevent sending them as part of profile to contacts: -- - contact_profile_id -- - incognito @@ -732,7 +731,7 @@ instance TextEncoding ChatPeerType where profileFromName :: ContactName -> Profile profileFromName displayName = - Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, contactDomain = Nothing, contactDomainProof = Nothing} + Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing, badge = Nothing, simplexName = Nothing} -- check if profiles match ignoring preferences profilesMatch :: LocalProfile -> LocalProfile -> Bool @@ -745,8 +744,9 @@ profilesMatch -- so compare badges by disclosed info (not proof bytes) - a re-presentation of the same badge is a no-op sameProfileContent :: Profile -> Profile -> Bool sameProfileContent p@Profile {badge = b} p'@Profile {badge = b'} = - p {badge = Nothing, contactDomainProof = Nothing} == p' {badge = Nothing, contactDomainProof = Nothing} && (proofInfo <$> b) == (proofInfo <$> b') + clearProofs p == clearProofs p' && (proofInfo <$> b) == (proofInfo <$> b') where + clearProofs pr@Profile {simplexName} = pr {badge = Nothing, simplexName = setClaimProof Nothing <$> simplexName} proofInfo :: BadgeProof -> BadgeInfo proofInfo (BadgeProof _ _ _ info) = info @@ -783,9 +783,8 @@ data LocalProfile = LocalProfile peerType :: Maybe ChatPeerType, localBadge :: Maybe LocalBadge, localAlias :: LocalAlias, - contactDomain :: Maybe SimplexNameInfo, - contactDomainVerification :: Maybe Bool, - contactDomainProof :: Maybe NameClaimProof + simplexName :: Maybe SimplexNameClaim, + contactDomainVerification :: Maybe Bool } deriving (Eq, Show) @@ -793,15 +792,15 @@ localProfileId :: LocalProfile -> ProfileId localProfileId LocalProfile {profileId} = profileId toLocalProfile :: ProfileId -> Profile -> LocalAlias -> UTCTime -> Maybe Bool -> Maybe Bool -> LocalProfile -toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge, contactDomain, contactDomainProof} localAlias now badgeVerified contactDomainVerification = - LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias, contactDomain = unStrJSON <$> contactDomain, contactDomainVerification, contactDomainProof} +toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge, simplexName} localAlias now badgeVerified contactDomainVerification = + LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, localAlias, simplexName, contactDomainVerification} where localBadge = (\b@(BadgeProof _ _ _ info) -> PeerBadge b (mkBadgeStatus now badgeVerified info)) <$> badge fromLocalProfile :: LocalProfile -> Profile -fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, contactDomain} = - -- contactDomainProof is generated on send - Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, contactDomain = StrJSON <$> contactDomain, contactDomainProof = Nothing} +fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localBadge, simplexName} = + -- the name proof is re-signed on each send + Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType, badge = localBadge >>= wireBadge, simplexName = setClaimProof Nothing <$> simplexName} where wireBadge :: LocalBadge -> Maybe BadgeProof wireBadge = \case diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ef8a829892..055c1d4bb6 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -52,6 +52,7 @@ import Simplex.Chat.Remote.AppVersion (AppVersion (..), pattern AppVersionRange) import Simplex.Chat.Remote.Types import Simplex.Chat.Store (AddressSettings (..), AutoAccept (..), StoreError (..), UserContactLink (..)) import Simplex.Chat.Styled +import Simplex.Chat.Names (claimName, claimProof) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared @@ -147,7 +148,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte CRContactRatchetSyncStarted {} -> ["connection synchronization started"] CRGroupMemberRatchetSyncStarted {} -> ["connection synchronization started"] CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] - CRContactNameVerified u (Contact {profile = LocalProfile {contactDomain}}) result -> ttyUser u $ viewNameVerified contactDomain result + CRContactNameVerified u (Contact {profile = LocalProfile {simplexName}}) result -> ttyUser u $ viewNameVerified (claimName <$> simplexName) result CRGroupNameVerified u g result -> ttyUser u $ viewNameVerified (groupDomainName g) result CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView @@ -1809,12 +1810,12 @@ viewContactBadge = maybe [] $ \lb -> in [plain (textEncode badgeType <> " badge - " <> st), plain expiry] viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] -viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, contactDomain, contactDomainVerification, contactDomainProof}, activeConn, uiThemes, customData} stats incognitoProfile = +viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink, localBadge, simplexName, contactDomainVerification}, activeConn, uiThemes, customData} stats incognitoProfile = ["contact ID: " <> sShow contactId] <> viewContactBadge localBadge <> maybe [] viewConnectionStats stats <> maybe [] (\l -> ["contact address: " <> plain (strEncode (simplexChatContact' l))]) contactLink - <> simplexNameStatus contactDomain contactDomainVerification (isJust contactDomainProof) + <> simplexNameStatus (claimName <$> simplexName) contactDomainVerification (isJust (claimProof =<< simplexName)) <> maybe ["you've shared main profile with this contact"] (\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p]) @@ -2225,8 +2226,8 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case Just _ -> maybe True (\c -> connStatus c == ConnPrepared) activeConn _ -> False contactNameLine :: Contact -> [StyledString] - contactNameLine Contact {profile = LocalProfile {contactDomain, contactDomainVerification, contactDomainProof}} = - simplexNameStatus contactDomain contactDomainVerification (isJust contactDomainProof) + contactNameLine Contact {profile = LocalProfile {simplexName, contactDomainVerification}} = + simplexNameStatus (claimName <$> simplexName) contactDomainVerification (isJust (claimProof =<< simplexName)) groupNameLine :: GroupInfo -> [StyledString] groupNameLine g'@GroupInfo {groupDomainVerification, groupProfile = GroupProfile {publicGroup}} = simplexNameStatus (groupDomainName g') groupDomainVerification (isJust (publicGroup >>= publicGroupAccess >>= groupDomainProof))