diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 726d82f2f4..d02455f71e 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} @@ -1319,7 +1320,7 @@ processChatCommand = \case let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} r <- updateProfile_ user p' $ withStore' $ \db -> setUserProfileContactLink db user Nothing let user' = case r of - CRUserProfileUpdated u' _ _ _ _ -> u' + CRUserProfileUpdated u' _ _ _ -> u' _ -> user pure $ CRUserContactLinkDeleted user' DeleteMyAddress -> withUser $ \User {userId} -> @@ -1848,17 +1849,23 @@ processChatCommand = \case asks currentUser >>= atomically . (`writeTVar` Just user') withChatLock "updateProfile" . procCmd $ do ChatConfig {logLevel} <- asks config - (successes, failures) <- foldM (processAndCount user' logLevel) (0, 0) contacts - pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' successes failures + summary <- foldM (processAndCount user' logLevel) (UserProfileUpdateSummary 0 0 0 []) contacts + pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary where - processAndCount user' ll (s, f) ct = (processContact user' ct $> (s + 1, f)) `catchChatError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> (s, f + 1) - processContact user' ct = do + processAndCount user' ll (!s@UserProfileUpdateSummary {notChanged, updateSuccesses, updateFailures, changedContacts}) ct = do let mergedProfile = userProfileToSend user Nothing $ Just ct ct' = updateMergedPreferences user' ct mergedProfile' = userProfileToSend user' Nothing $ Just ct' - when (mergedProfile' /= mergedProfile) $ do - void $ sendDirectContactMessage ct' (XInfo mergedProfile') - when (directOrUsed ct') $ createSndFeatureItems user' ct ct' + if mergedProfile' == mergedProfile + then pure s {notChanged = notChanged + 1} + else + let cts' = ct' : changedContacts + in (notifyContact mergedProfile' ct' $> s {updateSuccesses = updateSuccesses + 1, changedContacts = cts'}) + `catchChatError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> s {updateFailures = updateFailures + 1, changedContacts = cts'} + where + notifyContact mergedProfile' ct' = do + void $ sendDirectContactMessage ct' (XInfo mergedProfile') + when (directOrUsed ct') $ createSndFeatureItems user' ct ct' updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse updateContactPrefs user@User {userId} ct@Contact {activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 5fd5b71f24..741cd1a18d 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -508,7 +508,7 @@ data ChatResponse | CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} | CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} | CRSndFileError {user :: User, chatItem :: AChatItem} - | CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile, successes :: Int, failures :: Int} + | CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile, updateSummary :: UserProfileUpdateSummary} | CRUserProfileImage {user :: User, profile :: Profile} | CRContactAliasUpdated {user :: User, toContact :: Contact} | CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection} @@ -708,6 +708,16 @@ instance ToJSON PendingSubStatus where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} +data UserProfileUpdateSummary = UserProfileUpdateSummary + { notChanged :: Int, + updateSuccesses :: Int, + updateFailures :: Int, + changedContacts :: [Contact] + } + deriving (Show, Generic) + +instance ToJSON UserProfileUpdateSummary where toEncoding = J.genericToEncoding J.defaultOptions + data ComposedMessage = ComposedMessage { filePath :: Maybe FilePath, quotedItemId :: Maybe ChatItemId, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ef3b4d1e07..adb2909ec7 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -163,7 +163,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts CRRcvFileCancelled u _ ft -> ttyUser u $ receivingFile_ "cancelled" ft - CRUserProfileUpdated u p p' s f -> ttyUser u $ viewUserProfileUpdated p p' s f + CRUserProfileUpdated u p p' summary -> ttyUser u $ viewUserProfileUpdated p p' summary CRUserProfileImage u p -> ttyUser u $ viewUserProfileImage p CRContactPrefsUpdated {user = u, fromContact, toContact} -> ttyUser u $ viewUserContactPrefsUpdated u fromContact toContact CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c @@ -1051,10 +1051,11 @@ viewSwitchPhase = \case SPSecured -> "secured new address" SPCompleted -> "changed address" -viewUserProfileUpdated :: Profile -> Profile -> Int -> Int -> [StyledString] -viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, preferences} Profile {displayName = n', fullName = fullName', image = image', contactLink = contactLink', preferences = prefs'} s f = +viewUserProfileUpdated :: Profile -> Profile -> UserProfileUpdateSummary -> [StyledString] +viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, preferences} Profile {displayName = n', fullName = fullName', image = image', contactLink = contactLink', preferences = prefs'} summary = profileUpdated <> viewPrefsUpdated preferences prefs' where + UserProfileUpdateSummary {updateSuccesses = s, updateFailures = f} = summary profileUpdated | n == n' && fullName == fullName' && image == image' && contactLink == contactLink' = [] | n == n' && fullName == fullName' && image == image' = [if isNothing contactLink' then "contact address removed" else "new contact address set"]