core: update chat preferences (#1292)

* core: update chat preferences * refactor, types * rename types * rename types * make voice on by default * create new user with empty preferences * fix test
2026-04-25 16:22:13 +00:00 · 2022-11-04 17:05:21 +00:00
parent 1bf3154488
commit 89de5497ef
10 changed files with 455 additions and 154 deletions
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1161,9 +1161,9 @@ processChatCommand = \case
            let mergedProfile = userProfileToSend user' Nothing $ Just ct
            void (sendDirectContactMessage ct $ XInfo mergedProfile) `catchError` (toView . CRChatError)
          pure $ CRUserProfileUpdated (fromLocalProfile p) p'
-    updateContactPrefs :: User -> Contact -> ChatPreferences -> m ChatResponse
+    updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse
    updateContactPrefs user@User {userId} ct@Contact {contactId, activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
-      | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated ct -- nothing changed actually
+      | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated ct ct $ contactUserPreferences user ct -- nothing changed actually
      | otherwise = do
        withStore' $ \db -> updateContactUserPreferences db userId contactId contactUserPrefs'
        -- [incognito] filter out contacts with whom user has incognito connections
@@ -1172,7 +1172,7 @@ processChatCommand = \case
        let p' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct')
        withChatLock "updateProfile" . procCmd $ do
          void (sendDirectContactMessage ct' $ XInfo p') `catchError` (toView . CRChatError)
-          pure $ CRContactPrefsUpdated ct'
+          pure $ CRContactPrefsUpdated ct ct' $ contactUserPreferences user ct'

    isReady :: Contact -> Bool
    isReady ct =
@@ -2465,7 +2465,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
    xInfo :: Contact -> Profile -> m ()
    xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do
      c' <- withStore $ \db -> updateContactProfile db userId c p'
-      toView $ CRContactUpdated c c'
+      toView $ CRContactUpdated c c' $ contactUserPreferences user c'

    xInfoProbe :: Contact -> Probe -> m ()
    xInfoProbe c2 probe =
@@ -3023,15 +3023,10 @@ deleteAgentConnectionAsync' user connId (AgentConnId acId) = do
  withAgent $ \a -> deleteConnectionAsync a (aCorrId cmdId) acId

 userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Profile
-userProfileToSend user@User {profile} incognitoProfile ct =
-  let p = fromMaybe (fromLocalProfile profile) incognitoProfile
-      preferences = Just . mergeChatPreferences user $ userPreferences <$> ct
-   in (p :: Profile) {preferences}
-
-mergeChatPreferences :: User -> Maybe ChatPreferences -> ChatPreferences
-mergeChatPreferences User {profile = LocalProfile {preferences}} contactPrefs =
-  let ChatPreferences {voice = defaultVoice} = defaultChatPrefs
-   in ChatPreferences {voice = (contactPrefs >>= voice) <|> (preferences >>= voice) <|> defaultVoice}
+userProfileToSend user@User {profile = p} incognitoProfile ct =
+  let p' = fromMaybe (fromLocalProfile p) incognitoProfile
+      userPrefs = maybe (preferences' user) (const Nothing) incognitoProfile
+   in (p' :: Profile) {preferences = Just . toChatPrefs $ mergePreferences (userPreferences <$> ct) userPrefs}

 getCreateActiveUser :: SQLiteStore -> IO User
 getCreateActiveUser st = do
@@ -3054,7 +3049,7 @@ getCreateActiveUser st = do
        loop = do
          displayName <- getContactName
          fullName <- T.pack <$> getWithPrompt "full name (optional)"
-          withTransaction st (\db -> runExceptT $ createUser db Profile {displayName, fullName, image = Nothing, preferences = Just defaultChatPrefs} True) >>= \case
+          withTransaction st (\db -> runExceptT $ createUser db Profile {displayName, fullName, image = Nothing, preferences = Nothing} True) >>= \case
            Left SEDuplicateName -> do
              putStrLn "chosen display name is already used by another profile on this device, choose another one"
              loop
@@ -3311,7 +3306,7 @@ chatCommandP =
    groupProfile = do
      gName <- displayName
      fullName <- fullNameP gName
-      pure GroupProfile {displayName = gName, fullName, image = Nothing, preferences = Nothing}
+      pure GroupProfile {displayName = gName, fullName, image = Nothing, groupPreferences = Nothing}
    fullNameP name = do
      n <- (A.space *> A.takeByteString) <|> pure ""
      pure $ if B.null n then name else safeDecodeUtf8 n
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -166,7 +166,7 @@ data ChatCommand
  | APIGetCallInvitations
  | APICallStatus ContactId WebRTCCallStatus
  | APIUpdateProfile Profile
-  | APISetContactPrefs Int64 ChatPreferences
+  | APISetContactPrefs Int64 Preferences
  | APISetContactAlias ContactId LocalAlias
  | APISetConnectionAlias Int64 LocalAlias
  | APIParseMarkdown Text
@@ -296,7 +296,7 @@ data ChatResponse
  | CRInvitation {connReqInvitation :: ConnReqInvitation}
  | CRSentConfirmation
  | CRSentInvitation {customUserProfile :: Maybe Profile}
-  | CRContactUpdated {fromContact :: Contact, toContact :: Contact}
+  | CRContactUpdated {fromContact :: Contact, toContact :: Contact, preferences :: ContactUserPreferences}
  | CRContactsMerged {intoContact :: Contact, mergedContact :: Contact}
  | CRContactDeleted {contact :: Contact}
  | CRChatCleared {chatInfo :: AChatInfo}
@@ -322,7 +322,7 @@ data ChatResponse
  | CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
  | CRContactAliasUpdated {toContact :: Contact}
  | CRConnectionAliasUpdated {toConnection :: PendingContactConnection}
-  | CRContactPrefsUpdated {toContact :: Contact}
+  | CRContactPrefsUpdated {fromContact :: Contact, toContact :: Contact, preferences :: ContactUserPreferences}
  | CRContactConnecting {contact :: Contact}
  | CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
  | CRContactAnotherClient {contact :: Contact}
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -409,7 +409,7 @@ getUsers db =
        JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
      |]

-toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ChatPreferences) -> User
+toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User
 toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
  let profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""}
   in User {userId, userContactId, localDisplayName = displayName, profile, activeUser}
@@ -508,7 +508,7 @@ getProfileById db userId profileId =
      |]
      (userId, profileId)
  where
-    toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias, Maybe ChatPreferences) -> LocalProfile
+    toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias, Maybe Preferences) -> LocalProfile
    toProfile (displayName, fullName, image, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}

 createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection
@@ -641,7 +641,7 @@ updateContactProfile db userId c@Contact {contactId, localDisplayName, profile =
      updateContact_ db userId contactId localDisplayName ldn currentTs
      pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias}

-updateContactUserPreferences :: DB.Connection -> UserId -> Int64 -> ChatPreferences -> IO ()
+updateContactUserPreferences :: DB.Connection -> UserId -> Int64 -> Preferences -> IO ()
 updateContactUserPreferences db userId contactId userPreferences = do
  updatedAt <- getCurrentTime
  DB.execute
@@ -718,7 +718,7 @@ updateContact_ db userId contactId displayName newName updatedAt = do
    (newName, updatedAt, userId, contactId)
  DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId)

-type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Bool, Maybe Bool) :. (Maybe ChatPreferences, ChatPreferences, UTCTime, UTCTime)
+type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Bool, Maybe Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime)

 toContact :: ContactRow :. ConnectionRow -> Contact
 toContact (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
@@ -1098,7 +1098,7 @@ getContactRequest db userId contactRequestId =
      |]
      (userId, contactRequestId)

-type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData) :. (Maybe XContactId, Maybe ChatPreferences, UTCTime, UTCTime)
+type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime)

 toContactRequest :: ContactRequestRow -> UserContactRequest
 toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image) :. (xContactId, preferences, createdAt, updatedAt)) = do
@@ -1437,7 +1437,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
            WHERE c.user_id = ? AND c.contact_id = ?
          |]
          (userId, contactId)
-    toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool) :. (Maybe ChatPreferences, ChatPreferences, UTCTime, UTCTime)] -> Either StoreError Contact
+    toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime)] -> Either StoreError Contact
    toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)] =
      let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
          chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
@@ -1592,14 +1592,14 @@ updateConnectionStatus db Connection {connId} connStatus = do
 -- | creates completely new group with a single member - the current user
 createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo
 createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
-  let GroupProfile {displayName, fullName, image, preferences} = groupProfile
+  let GroupProfile {displayName, fullName, image, groupPreferences} = groupProfile
  currentTs <- getCurrentTime
  withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
    groupId <- liftIO $ do
      DB.execute
        db
        "INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
-        (displayName, fullName, image, userId, preferences, currentTs, currentTs)
+        (displayName, fullName, image, userId, groupPreferences, currentTs, currentTs)
      profileId <- insertedRowId db
      DB.execute
        db
@@ -1635,7 +1635,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
        DB.query db "SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1" (connRequest, userId)
    createGroupInvitation_ :: ExceptT StoreError IO (GroupInfo, GroupMemberId)
    createGroupInvitation_ = do
-      let GroupProfile {displayName, fullName, image, preferences} = groupProfile
+      let GroupProfile {displayName, fullName, image, groupPreferences} = groupProfile
      ExceptT $
        withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
          currentTs <- liftIO getCurrentTime
@@ -1643,7 +1643,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
            DB.execute
              db
              "INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
-              (displayName, fullName, image, userId, preferences, currentTs, currentTs)
+              (displayName, fullName, image, userId, groupPreferences, currentTs, currentTs)
            profileId <- insertedRowId db
            DB.execute
              db
@@ -1786,13 +1786,13 @@ getGroupInfoByName db user gName = do
  gId <- getGroupIdByName db user gName
  getGroupInfo db user gId

-type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe ChatPreferences, UTCTime, UTCTime) :. GroupMemberRow
+type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe GroupPreferences, UTCTime, UTCTime) :. GroupMemberRow

 toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
-toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, hostConnCustomUserProfileId, enableNtfs_, preferences, createdAt, updatedAt) :. userMemberRow) =
+toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, hostConnCustomUserProfileId, enableNtfs_, groupPreferences, createdAt, updatedAt) :. userMemberRow) =
  let membership = toGroupMember userContactId userMemberRow
      chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
-   in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image, preferences}, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt}
+   in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image, groupPreferences}, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt}

 getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
 getGroupMember db user@User {userId} groupId groupMemberId =
@@ -1884,9 +1884,9 @@ getGroupInvitation db user groupId =
      firstRow fromOnly (SEGroupNotFound groupId) $
        DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId)

-type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, LocalAlias, Maybe ChatPreferences))
+type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, LocalAlias, Maybe Preferences))

-type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe LocalAlias, Maybe ChatPreferences))
+type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe LocalAlias, Maybe Preferences))

 toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
 toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias, preferences)) =
@@ -2329,7 +2329,7 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
      |]
      (userId, groupMemberId)
  where
-    toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool) :. (Maybe ChatPreferences, ChatPreferences, UTCTime, UTCTime)) :. ConnectionRow -> Contact
+    toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime)) :. ConnectionRow -> Contact
    toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
      let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
          chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
@@ -3636,7 +3636,7 @@ getGroupInfo db User {userId, userContactId} groupId =
      (groupId, userId, userContactId)

 updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
-updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, preferences}} p'@GroupProfile {displayName = newName, fullName, image}
+updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, groupPreferences}} p'@GroupProfile {displayName = newName, fullName, image}
  | displayName == newName = liftIO $ do
    currentTs <- getCurrentTime
    updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
@@ -3659,7 +3659,7 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
            WHERE user_id = ? AND group_id = ?
          )
        |]
-        (newName, fullName, image, preferences, currentTs, userId, groupId)
+        (newName, fullName, image, groupPreferences, currentTs, userId, groupId)
    updateGroup_ ldn currentTs = do
      DB.execute
        db
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -40,7 +40,8 @@ runInputLoop ct cc = forever $ do
    CRChatCmdError _ -> when (isMessage cmd) $ echo s
    _ -> pure ()
  let testV = testView $ config cc
-  printToTerminal ct $ responseToView testV r
+  user <- readTVarIO $ currentUser cc
+  printToTerminal ct $ responseToView user testV r
  where
    echo s = printToTerminal ct [plain s]
    isMessage = \case
--- a/src/Simplex/Chat/Terminal/Output.hs
+++ b/src/Simplex/Chat/Terminal/Output.hs
@@ -75,8 +75,10 @@ withTermLock ChatTerminal {termLock} action = do
 runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
 runTerminalOutput ct cc = do
  let testV = testView $ config cc
-  forever $
-    atomically (readTBQueue $ outputQ cc) >>= printToTerminal ct . responseToView testV . snd
+  forever $ do
+    (_, r) <- atomically . readTBQueue $ outputQ cc
+    user <- readTVarIO $ currentUser cc
+    printToTerminal ct $ responseToView user testV r

 printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
 printToTerminal ct s =
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -19,6 +19,7 @@

 module Simplex.Chat.Types where

+import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
@@ -28,7 +29,7 @@ import Data.ByteString.Char8 (ByteString, pack, unpack)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
-import Data.Maybe (isJust)
+import Data.Maybe (fromMaybe, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -85,7 +86,7 @@ data Contact = Contact
    viaGroup :: Maybe Int64,
    contactUsed :: Bool,
    chatSettings :: ChatSettings,
-    userPreferences :: ChatPreferences,
+    userPreferences :: Preferences,
    createdAt :: UTCTime,
    updatedAt :: UTCTime
  }
@@ -102,7 +103,10 @@ contactConnId :: Contact -> ConnId
 contactConnId Contact {activeConn} = aConnId activeConn

 contactConnIncognito :: Contact -> Bool
-contactConnIncognito Contact {activeConn = Connection {customUserProfileId}} = isJust customUserProfileId
+contactConnIncognito = isJust . customUserProfileId'
+
+customUserProfileId' :: Contact -> Maybe Int64
+customUserProfileId' Contact {activeConn} = customUserProfileId (activeConn :: Connection)

 data ContactRef = ContactRef
  { contactId :: ContactId,
@@ -230,70 +234,277 @@ defaultChatSettings = ChatSettings {enableNtfs = True}
 pattern DisableNtfs :: ChatSettings
 pattern DisableNtfs = ChatSettings {enableNtfs = False}

-data ChatPreferences = ChatPreferences
-  { voice :: Maybe Preference
-  -- image :: Maybe Preference,
-  -- file :: Maybe Preference,
-  -- delete :: Maybe Preference,
-  -- acceptDelete :: Maybe Preference,
-  -- edit :: Maybe Preference,
-  -- receipts :: Maybe Preference
+data ChatFeature
+  = CFFullDelete
+  | -- | CFReceipts
+    CFVoice
+
+allChatFeatures :: [ChatFeature]
+allChatFeatures =
+  [ CFFullDelete,
+    -- CFReceipts,
+    CFVoice
+  ]
+
+chatPrefSel :: ChatFeature -> Preferences -> Maybe Preference
+chatPrefSel = \case
+  CFFullDelete -> fullDelete
+  -- CFReceipts -> receipts
+  CFVoice -> voice
+
+chatPrefName :: ChatFeature -> Text
+chatPrefName = \case
+  CFFullDelete -> "full message deletion"
+  -- CFReceipts -> "delivery receipts"
+  CFVoice -> "voice messages"
+
+class HasPreferences p where
+  preferences' :: p -> Maybe Preferences
+
+instance HasPreferences User where
+  preferences' User {profile = LocalProfile {preferences}} = preferences
+  {-# INLINE preferences' #-}
+
+instance HasPreferences Contact where
+  preferences' Contact {profile = LocalProfile {preferences}} = preferences
+  {-# INLINE preferences' #-}
+
+class PreferenceI p where
+  getPreference :: ChatFeature -> p -> Preference
+
+instance PreferenceI Preferences where
+  getPreference pt prefs = fromMaybe (getPreference pt defaultChatPrefs) (chatPrefSel pt prefs)
+
+instance PreferenceI (Maybe Preferences) where
+  getPreference pt prefs = fromMaybe (getPreference pt defaultChatPrefs) (chatPrefSel pt =<< prefs)
+
+instance PreferenceI FullPreferences where
+  getPreference = \case
+    CFFullDelete -> fullDelete
+    -- CFReceipts -> receipts
+    CFVoice -> voice
+  {-# INLINE getPreference #-}
+
+-- collection of optional chat preferences for the user and the contact
+data Preferences = Preferences
+  { fullDelete :: Maybe Preference,
+    -- receipts :: Maybe Preference,
+    voice :: Maybe Preference
  }
  deriving (Eq, Show, Generic, FromJSON)

-defaultChatPrefs :: ChatPreferences
-defaultChatPrefs = ChatPreferences {voice = Just Preference {enable = PSOff}}
+data GroupPreferences = GroupPreferences
+  { fullDelete :: Maybe GroupPreference,
+    -- receipts :: Maybe GroupPreference,
+    voice :: Maybe GroupPreference
+  }
+  deriving (Eq, Show, Generic, FromJSON)

-emptyChatPrefs :: ChatPreferences
-emptyChatPrefs = ChatPreferences {voice = Nothing}
-
-instance ToJSON ChatPreferences where
+instance ToJSON GroupPreferences where
  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}

-instance ToField ChatPreferences where
+instance ToField GroupPreferences where
  toField = toField . encodeJSON

-instance FromField ChatPreferences where
+instance FromField GroupPreferences where
+  fromField = fromTextField_ decodeJSON
+
+-- full collection of chat preferences defined in the app - it is used to ensure we include all preferences and to simplify processing
+-- if some of the preferences are not defined in Preferences, defaults from defaultChatPrefs are used here.
+data FullPreferences = FullPreferences
+  { fullDelete :: Preference,
+    -- receipts :: Preference,
+    voice :: Preference
+  }
+  deriving (Eq)
+
+-- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences
+data ContactUserPreferences = ContactUserPreferences
+  { fullDelete :: ContactUserPreference,
+    -- receipts :: ContactUserPreference,
+    voice :: ContactUserPreference
+  }
+  deriving (Show, Generic)
+
+data ContactUserPreference = ContactUserPreference
+  { enabled :: PrefEnabled,
+    userPreference :: ContactUserPref,
+    contactPreference :: Preference
+  }
+  deriving (Show, Generic)
+
+data ContactUserPref = CUPContact {preference :: Preference} | CUPUser {preference :: Preference}
+  deriving (Show, Generic)
+
+instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON ContactUserPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON ContactUserPref where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CUP"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
+
+toChatPrefs :: FullPreferences -> Preferences
+toChatPrefs FullPreferences {fullDelete, voice} =
+  Preferences
+    { fullDelete = Just fullDelete,
+      -- receipts = Just receipts,
+      voice = Just voice
+    }
+
+defaultChatPrefs :: FullPreferences
+defaultChatPrefs =
+  FullPreferences
+    { fullDelete = Preference {allow = FANo},
+      -- receipts = Preference {allow = FANo},
+      voice = Preference {allow = FAYes}
+    }
+
+emptyChatPrefs :: Preferences
+emptyChatPrefs = Preferences Nothing Nothing
+
+instance ToJSON Preferences where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+instance ToField Preferences where
+  toField = toField . encodeJSON
+
+instance FromField Preferences where
  fromField = fromTextField_ decodeJSON

 data Preference = Preference
-  {enable :: PrefSwitch}
+  {allow :: FeatureAllowed}
  deriving (Eq, Show, Generic, FromJSON)

-instance ToJSON Preference where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+data GroupPreference = GroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)

-data PrefSwitch = PSOn | PSOff -- for example it can be extended to include PSMutual, that is only enabled if it's enabled by another party
+instance ToJSON Preference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+data FeatureAllowed
+  = FAAlways -- allow unconditionally
+  | FAYes -- allow, if peer allows it
+  | FANo -- do not allow
  deriving (Eq, Show, Generic)

-instance FromField PrefSwitch where fromField = fromBlobField_ strDecode
+data GroupFeatureEnabled = FEOn | FEOff
+  deriving (Eq, Show, Generic)

-instance ToField PrefSwitch where toField = toField . strEncode
+instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode

-instance StrEncoding PrefSwitch where
+instance ToField FeatureAllowed where toField = toField . strEncode
+
+instance StrEncoding FeatureAllowed where
  strEncode = \case
-    PSOn -> "on"
-    PSOff -> "off"
+    FAAlways -> "always"
+    FAYes -> "yes"
+    FANo -> "no"
  strDecode = \case
-    "on" -> Right PSOn
-    "off" -> Right PSOff
-    r -> Left $ "bad PrefSwitch " <> B.unpack r
+    "always" -> Right FAAlways
+    "yes" -> Right FAYes
+    "no" -> Right FANo
+    r -> Left $ "bad FeatureAllowed " <> B.unpack r
  strP = strDecode <$?> A.takeByteString

-instance FromJSON PrefSwitch where
-  parseJSON = strParseJSON "PrefSwitch"
+instance FromJSON FeatureAllowed where
+  parseJSON = strParseJSON "FeatureAllowed"

-instance ToJSON PrefSwitch where
+instance ToJSON FeatureAllowed where
  toJSON = strToJSON
  toEncoding = strToJEncoding

+instance FromField GroupFeatureEnabled where fromField = fromBlobField_ strDecode
+
+instance ToField GroupFeatureEnabled where toField = toField . strEncode
+
+instance StrEncoding GroupFeatureEnabled where
+  strEncode = \case
+    FEOn -> "on"
+    FEOff -> "off"
+  strDecode = \case
+    "on" -> Right FEOn
+    "off" -> Right FEOff
+    r -> Left $ "bad GroupFeatureEnabled " <> B.unpack r
+  strP = strDecode <$?> A.takeByteString
+
+instance FromJSON GroupFeatureEnabled where
+  parseJSON = strParseJSON "GroupFeatureEnabled"
+
+instance ToJSON GroupFeatureEnabled where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+mergePreferences :: Maybe Preferences -> Maybe Preferences -> FullPreferences
+mergePreferences contactPrefs userPreferences =
+  FullPreferences
+    { fullDelete = pref CFFullDelete,
+      -- receipts = pref CFReceipts,
+      voice = pref CFVoice
+    }
+  where
+    pref pt =
+      let sel = chatPrefSel pt
+       in fromMaybe (getPreference pt defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel)
+
+mergeUserChatPrefs :: User -> Contact -> FullPreferences
+mergeUserChatPrefs user ct =
+  let userPrefs = if contactConnIncognito ct then Nothing else preferences' user
+   in mergePreferences (Just $ userPreferences ct) userPrefs
+
+data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
+  deriving (Show, Generic)
+
+instance ToJSON PrefEnabled where
+  toJSON = J.genericToJSON J.defaultOptions
+  toEncoding = J.genericToEncoding J.defaultOptions
+
+prefEnabled :: Preference -> Preference -> PrefEnabled
+prefEnabled Preference {allow = user} Preference {allow = contact} = case (user, contact) of
+  (FAAlways, FANo) -> PrefEnabled {forUser = False, forContact = True}
+  (FANo, FAAlways) -> PrefEnabled {forUser = True, forContact = False}
+  (_, FANo) -> PrefEnabled False False
+  (FANo, _) -> PrefEnabled False False
+  _ -> PrefEnabled True True
+
+contactUserPreferences :: User -> Contact -> ContactUserPreferences
+contactUserPreferences user ct =
+  ContactUserPreferences
+    { fullDelete = pref CFFullDelete,
+      -- receipts = pref CFReceipts,
+      voice = pref CFVoice
+    }
+  where
+    pref pt =
+      ContactUserPreference
+        { enabled = prefEnabled userPref ctPref,
+          -- incognito contact cannot have default user preference used
+          userPreference = if contactConnIncognito ct then CUPContact ctUserPref else maybe (CUPUser userPref) CUPContact ctUserPref_,
+          contactPreference = ctPref
+        }
+      where
+        ctUserPref = getPreference pt $ userPreferences ct
+        ctUserPref_ = chatPrefSel pt $ userPreferences ct
+        userPref = getPreference pt ctUserPrefs
+        ctPref = getPreference pt ctPrefs
+    ctUserPrefs = mergeUserChatPrefs user ct
+    ctPrefs = mergePreferences (preferences' ct) Nothing
+
+getContactUserPrefefence :: ChatFeature -> ContactUserPreferences -> ContactUserPreference
+getContactUserPrefefence = \case
+  CFFullDelete -> fullDelete
+  -- CFReceipts -> receipts
+  CFVoice -> voice
+
 data Profile = Profile
  { displayName :: ContactName,
    fullName :: Text,
    image :: Maybe ImageData,
-    preferences :: Maybe ChatPreferences
+    preferences :: Maybe Preferences
    -- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
    -- - contact_profile_id
    -- - incognito
@@ -314,7 +525,7 @@ data LocalProfile = LocalProfile
    displayName :: ContactName,
    fullName :: Text,
    image :: Maybe ImageData,
-    preferences :: Maybe ChatPreferences,
+    preferences :: Maybe Preferences,
    localAlias :: LocalAlias
  }
  deriving (Eq, Show, Generic, FromJSON)
@@ -338,7 +549,7 @@ data GroupProfile = GroupProfile
  { displayName :: GroupName,
    fullName :: Text,
    image :: Maybe ImageData,
-    preferences :: Maybe ChatPreferences
+    groupPreferences :: Maybe GroupPreferences
  }
  deriving (Eq, Show, Generic, FromJSON)

--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -18,7 +18,7 @@ import Data.Char (toUpper)
 import Data.Function (on)
 import Data.Int (Int64)
 import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
-import Data.Maybe (isJust, isNothing)
+import Data.Maybe (isJust, isNothing, mapMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (DiffTime)
@@ -49,11 +49,11 @@ import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (bshow)
 import System.Console.ANSI.Types

-serializeChatResponse :: ChatResponse -> String
-serializeChatResponse = unlines . map unStyle . responseToView False
+serializeChatResponse :: Maybe User -> ChatResponse -> String
+serializeChatResponse user_ = unlines . map unStyle . responseToView user_ False

-responseToView :: Bool -> ChatResponse -> [StyledString]
-responseToView testView = \case
+responseToView :: Maybe User -> Bool -> ChatResponse -> [StyledString]
+responseToView user_ testView = \case
  CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
  CRChatStarted -> ["chat started"]
  CRChatRunning -> ["chat is running"]
@@ -123,10 +123,14 @@ responseToView testView = \case
  CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
  CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
  CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
-  CRContactPrefsUpdated ct -> viewContactPrefsUpdated ct
+  CRContactPrefsUpdated {fromContact, toContact, preferences} -> case user_ of
+    Just user -> viewUserContactPrefsUpdated user fromContact toContact preferences
+    _ -> ["unexpected chat event CRContactPrefsUpdated without current user"]
  CRContactAliasUpdated c -> viewContactAliasUpdated c
  CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c
-  CRContactUpdated c c' -> viewContactUpdated c c'
+  CRContactUpdated {fromContact = c, toContact = c', preferences} -> case user_ of
+    Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c' preferences
+    _ -> ["unexpected chat event CRContactUpdated without current user"]
  CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
  CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
  CRRcvFileStart ci -> receivingFile_' "started" ci
@@ -694,25 +698,74 @@ viewSwitchPhase SPCompleted = "changed address"
 viewSwitchPhase phase = plain (strEncode phase) <> " changing address"

 viewUserProfileUpdated :: Profile -> Profile -> [StyledString]
-viewUserProfileUpdated Profile {displayName = n, fullName, image} Profile {displayName = n', fullName = fullName', image = image'}
-  | n == n' && fullName == fullName' && image == image' = []
-  | n == n' && fullName == fullName' = [if isNothing image' then "profile image removed" else "profile image updated"]
-  | n == n' = ["user full name " <> (if T.null fullName' || fullName' == n' then "removed" else "changed to " <> plain fullName') <> notified]
-  | otherwise = ["user profile is changed to " <> ttyFullName n' fullName' <> notified]
+viewUserProfileUpdated Profile {displayName = n, fullName, image, preferences} Profile {displayName = n', fullName = fullName', image = image', preferences = prefs'} =
+  profileUpdated <> viewPrefsUpdated preferences prefs'
  where
+    profileUpdated
+      | n == n' && fullName == fullName' && image == image' = []
+      | n == n' && fullName == fullName' = [if isNothing image' then "profile image removed" else "profile image updated"]
+      | n == n' = ["user full name " <> (if T.null fullName' || fullName' == n' then "removed" else "changed to " <> plain fullName') <> notified]
+      | otherwise = ["user profile is changed to " <> ttyFullName n' fullName' <> notified]
    notified = " (your contacts are notified)"

-viewContactPrefsUpdated :: Contact -> [StyledString]
-viewContactPrefsUpdated Contact {profile = LocalProfile {preferences}, userPreferences = ChatPreferences {voice = userVoice}} =
-  let contactVoice = preferences >>= voice
-   in ["preferences were updated: " <> "contact's voice messages are " <> viewPreference contactVoice <> ", user's voice messages are " <> viewPreference userVoice]
+viewUserContactPrefsUpdated :: User -> Contact -> Contact -> ContactUserPreferences -> [StyledString]
+viewUserContactPrefsUpdated user ct ct' cups
+  | null prefs = ["your preferences for " <> ttyContact' ct' <> " did not change"]
+  | otherwise = ("you updated preferences for " <> ttyContact' ct' <> ":") : prefs
+  where
+    prefs = viewContactPreferences user ct ct' cups

-viewPreference :: Maybe Preference -> StyledString
+viewContactPrefsUpdated :: User -> Contact -> Contact -> ContactUserPreferences -> [StyledString]
+viewContactPrefsUpdated user ct ct' cups
+  | null prefs = []
+  | otherwise = (ttyContact' ct' <> " updated preferences for you:") : prefs
+  where
+    prefs = viewContactPreferences user ct ct' cups
+
+viewContactPreferences :: User -> Contact -> Contact -> ContactUserPreferences -> [StyledString]
+viewContactPreferences user ct ct' cups =
+  mapMaybe (viewContactPref (mergeUserChatPrefs user ct) (mergeUserChatPrefs user ct') (preferences' ct) cups) allChatFeatures
+
+viewContactPref :: FullPreferences -> FullPreferences -> Maybe Preferences -> ContactUserPreferences -> ChatFeature -> Maybe StyledString
+viewContactPref userPrefs userPrefs' ctPrefs cups pt
+  | userPref == userPref' && ctPref == contactPreference = Nothing
+  | otherwise = Just $ plain (chatPrefName pt) <> ": " <> viewPrefEnabled enabled <> " (you allow: " <> viewCountactUserPref userPreference <> ", contact allows: " <> viewPreference contactPreference <> ")"
+  where
+    userPref = getPreference pt userPrefs
+    userPref' = getPreference pt userPrefs'
+    ctPref = getPreference pt ctPrefs
+    ContactUserPreference {enabled, userPreference, contactPreference} = getContactUserPrefefence pt cups
+
+viewPrefsUpdated :: Maybe Preferences -> Maybe Preferences -> [StyledString]
+viewPrefsUpdated ps ps'
+  | null prefs = []
+  | otherwise = "updated preferences:" : prefs
+  where
+    prefs = mapMaybe viewPref allChatFeatures
+    viewPref pt
+      | pref ps == pref ps' = Nothing
+      | otherwise = Just $ plain (chatPrefName pt) <> " allowed: " <> viewPreference (pref ps')
+      where
+        pref pss = getPreference pt $ mergePreferences pss Nothing
+
+viewPreference :: Preference -> StyledString
 viewPreference = \case
-  Just Preference {enable} -> case enable of
-    PSOn -> "on"
-    PSOff -> "off"
-  _ -> "unset"
+  Preference {allow} -> case allow of
+    FAAlways -> "always"
+    FAYes -> "yes"
+    FANo -> "no"
+
+viewCountactUserPref :: ContactUserPref -> StyledString
+viewCountactUserPref = \case
+  CUPUser p -> "default (" <> viewPreference p <> ")"
+  CUPContact p -> viewPreference p
+
+viewPrefEnabled :: PrefEnabled -> StyledString
+viewPrefEnabled = \case
+  PrefEnabled True True -> "enabled"
+  PrefEnabled False False -> "off"
+  PrefEnabled {forUser = True, forContact = False} -> "enabled for you"
+  PrefEnabled {forUser = False, forContact = True} -> "enabled for contact"

 viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> [StyledString]
 viewGroupUpdated