core: split preferences to separate file

simplex-chat.cabal

@@ -125,6 +125,8 @@ library
       Simplex.Chat.Terminal.Notification
       Simplex.Chat.Terminal.Output
       Simplex.Chat.Types
+      Simplex.Chat.Types.Preferences
+      Simplex.Chat.Types.Util
       Simplex.Chat.Util
       Simplex.Chat.View
   other-modules:

src/Simplex/Chat.hs

@@ -67,6 +67,8 @@ import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
+import Simplex.Chat.Types.Util
 import Simplex.FileTransfer.Client.Main (maxFileSize)
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
 import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)

src/Simplex/Chat/Call.hs

@@ -21,7 +21,8 @@ import Data.Time.Clock (UTCTime)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
-import Simplex.Chat.Types (Contact, ContactId, User, decodeJSON, encodeJSON)
+import Simplex.Chat.Types (Contact, ContactId, User)
+import Simplex.Chat.Types.Util (decodeJSON, encodeJSON)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)

src/Simplex/Chat/Controller.hs

@@ -47,6 +47,7 @@ import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink, UserMsgReceiptSettings)
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent (AgentClient)
 import Simplex.Messaging.Agent.Client (AgentLocks, ProtocolTestFailure)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)

src/Simplex/Chat/Markdown.hs

@@ -28,6 +28,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import GHC.Generics
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ConnReqScheme (..), ConnReqUriData (..), ConnectionRequestUri (..), SMPQueue (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, sumTypeJSON)

src/Simplex/Chat/Messages.hs

@@ -35,6 +35,7 @@ import Simplex.Chat.Markdown
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)

src/Simplex/Chat/Messages/CIContent.hs

@@ -29,6 +29,8 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
+import Simplex.Chat.Types.Util
 import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON)

src/Simplex/Chat/Protocol.hs

@@ -41,6 +41,7 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
 import Simplex.Chat.Call
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Util
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)

src/Simplex/Chat/Store/Connections.hs

@@ -23,6 +23,7 @@ import Simplex.Chat.Store.Groups
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow')
 
 getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity

src/Simplex/Chat/Store/Direct.hs

@@ -69,6 +69,7 @@ import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 

src/Simplex/Chat/Store/Groups.hs

@@ -97,6 +97,7 @@ import Simplex.Chat.Messages
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C

src/Simplex/Chat/Store/Profiles.hs

@@ -74,6 +74,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Crypto as C

src/Simplex/Chat/Store/Shared.hs

@@ -31,6 +31,7 @@ import GHC.Generics (Generic)
 import Simplex.Chat.Messages
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)

src/Simplex/Chat/Types.hs

@@ -13,9 +13,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
@@ -24,7 +22,6 @@
 
 module Simplex.Chat.Types where
 
-import Control.Applicative ((<|>))
 import Crypto.Number.Serialize (os2ip)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
@@ -33,27 +30,22 @@ import qualified Data.Aeson.Types as JT
 import qualified Data.Attoparsec.ByteString.Char8 as A
 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 (fromMaybe, isJust)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
-import Data.Typeable
+import Database.SQLite.Simple.FromField (FromField (..))
-import Database.SQLite.Simple (ResultError (..), SQLData (..))
-import Database.SQLite.Simple.FromField (FieldParser, FromField (..), returnError)
-import Database.SQLite.Simple.Internal (Field (..))
-import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
-import GHC.Records.Compat
+import Simplex.Chat.Types.Preferences
+import Simplex.Chat.Types.Util
 import Simplex.FileTransfer.Description (FileDigest)
 import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
+import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
-import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Util ((<$?>))
 
 class IsContact a where
   contactId' :: a -> ContactId
@@ -353,659 +345,14 @@ defaultChatSettings = ChatSettings
 pattern DisableNtfs :: ChatSettings
 pattern DisableNtfs <- ChatSettings {enableNtfs = False}
 
-data ChatFeature
-  = CFTimedMessages
-  | CFFullDelete
-  | CFReactions
-  | CFVoice
-  | CFCalls
-  deriving (Show, Generic)
-
-data SChatFeature (f :: ChatFeature) where
-  SCFTimedMessages :: SChatFeature 'CFTimedMessages
-  SCFFullDelete :: SChatFeature 'CFFullDelete
-  SCFReactions :: SChatFeature 'CFReactions
-  SCFVoice :: SChatFeature 'CFVoice
-  SCFCalls :: SChatFeature 'CFCalls
-
-deriving instance Show (SChatFeature f)
-
-data AChatFeature = forall f. FeatureI f => ACF (SChatFeature f)
-
-deriving instance Show AChatFeature
-
-chatFeatureNameText :: ChatFeature -> Text
-chatFeatureNameText = \case
-  CFTimedMessages -> "Disappearing messages"
-  CFFullDelete -> "Full deletion"
-  CFReactions -> "Message reactions"
-  CFVoice -> "Voice messages"
-  CFCalls -> "Audio/video calls"
-
-chatFeatureNameText' :: SChatFeature f -> Text
-chatFeatureNameText' = chatFeatureNameText . chatFeature
-
 featureAllowed :: SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
 featureAllowed feature forWhom Contact {mergedPreferences} =
   let ContactUserPreference {enabled} = getContactUserPreference feature mergedPreferences
    in forWhom enabled
 
-instance ToJSON ChatFeature where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CF"
-
-instance FromJSON ChatFeature where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CF"
-
-allChatFeatures :: [AChatFeature]
-allChatFeatures =
-  [ ACF SCFTimedMessages,
-    ACF SCFFullDelete,
-    ACF SCFReactions,
-    ACF SCFVoice,
-    ACF SCFCalls
-  ]
-
-chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
-chatPrefSel = \case
-  SCFTimedMessages -> timedMessages
-  SCFFullDelete -> fullDelete
-  SCFReactions -> reactions
-  SCFVoice -> voice
-  SCFCalls -> calls
-
-chatFeature :: SChatFeature f -> ChatFeature
-chatFeature = \case
-  SCFTimedMessages -> CFTimedMessages
-  SCFFullDelete -> CFFullDelete
-  SCFReactions -> CFReactions
-  SCFVoice -> CFVoice
-  SCFCalls -> CFCalls
-
-class PreferenceI p where
-  getPreference :: SChatFeature f -> p -> FeaturePreference f
-
-instance PreferenceI Preferences where
-  getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f prefs)
-
-instance PreferenceI (Maybe Preferences) where
-  getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs)
-
-instance PreferenceI FullPreferences where
-  getPreference = \case
-    SCFTimedMessages -> timedMessages
-    SCFFullDelete -> fullDelete
-    SCFReactions -> reactions
-    SCFVoice -> voice
-    SCFCalls -> calls
-  {-# INLINE getPreference #-}
-
-setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
-setPreference f allow_ prefs_ = setPreference_ f pref $ fromMaybe emptyChatPrefs prefs_
-  where
-    pref = setAllow <$> allow_
-    setAllow :: FeatureAllowed -> FeaturePreference f
-    setAllow = setField @"allow" (getPreference f prefs)
-    prefs = mergePreferences Nothing prefs_
-
-setPreference' :: SChatFeature f -> Maybe (FeaturePreference f) -> Maybe Preferences -> Preferences
-setPreference' f pref_ prefs_ = setPreference_ f pref_ $ fromMaybe emptyChatPrefs prefs_
-
-setPreference_ :: SChatFeature f -> Maybe (FeaturePreference f) -> Preferences -> Preferences
-setPreference_ f pref_ prefs =
-  case f of
-    SCFTimedMessages -> prefs {timedMessages = pref_}
-    SCFFullDelete -> prefs {fullDelete = pref_}
-    SCFReactions -> prefs {reactions = pref_}
-    SCFVoice -> prefs {voice = pref_}
-    SCFCalls -> prefs {calls = pref_}
-
--- collection of optional chat preferences for the user and the contact
-data Preferences = Preferences
-  { timedMessages :: Maybe TimedMessagesPreference,
-    fullDelete :: Maybe FullDeletePreference,
-    reactions :: Maybe ReactionsPreference,
-    voice :: Maybe VoicePreference,
-    calls :: Maybe CallsPreference
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-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 GroupFeature
-  = GFTimedMessages
-  | GFDirectMessages
-  | GFFullDelete
-  | GFReactions
-  | GFVoice
-  | GFFiles
-  deriving (Show, Generic)
-
-data SGroupFeature (f :: GroupFeature) where
-  SGFTimedMessages :: SGroupFeature 'GFTimedMessages
-  SGFDirectMessages :: SGroupFeature 'GFDirectMessages
-  SGFFullDelete :: SGroupFeature 'GFFullDelete
-  SGFReactions :: SGroupFeature 'GFReactions
-  SGFVoice :: SGroupFeature 'GFVoice
-  SGFFiles :: SGroupFeature 'GFFiles
-
-deriving instance Show (SGroupFeature f)
-
-data AGroupFeature = forall f. GroupFeatureI f => AGF (SGroupFeature f)
-
-deriving instance Show AGroupFeature
-
-groupFeatureNameText :: GroupFeature -> Text
-groupFeatureNameText = \case
-  GFTimedMessages -> "Disappearing messages"
-  GFDirectMessages -> "Direct messages"
-  GFFullDelete -> "Full deletion"
-  GFReactions -> "Message reactions"
-  GFVoice -> "Voice messages"
-  GFFiles -> "Files and media"
-
-groupFeatureNameText' :: SGroupFeature f -> Text
-groupFeatureNameText' = groupFeatureNameText . toGroupFeature
-
 groupFeatureAllowed :: GroupFeatureI f => SGroupFeature f -> GroupInfo -> Bool
 groupFeatureAllowed feature gInfo = groupFeatureAllowed' feature $ fullGroupPreferences gInfo
 
-groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferences -> Bool
-groupFeatureAllowed' feature prefs =
-  getField @"enable" (getGroupPreference feature prefs) == FEOn
-
-instance ToJSON GroupFeature where
-  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "GF"
-  toJSON = J.genericToJSON . enumJSON $ dropPrefix "GF"
-
-instance FromJSON GroupFeature where
-  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "GF"
-
-allGroupFeatures :: [AGroupFeature]
-allGroupFeatures =
-  [ AGF SGFTimedMessages,
-    AGF SGFDirectMessages,
-    AGF SGFFullDelete,
-    AGF SGFReactions,
-    AGF SGFVoice,
-    AGF SGFFiles
-  ]
-
-groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
-groupPrefSel = \case
-  SGFTimedMessages -> timedMessages
-  SGFDirectMessages -> directMessages
-  SGFFullDelete -> fullDelete
-  SGFReactions -> reactions
-  SGFVoice -> voice
-  SGFFiles -> files
-
-toGroupFeature :: SGroupFeature f -> GroupFeature
-toGroupFeature = \case
-  SGFTimedMessages -> GFTimedMessages
-  SGFDirectMessages -> GFDirectMessages
-  SGFFullDelete -> GFFullDelete
-  SGFReactions -> GFReactions
-  SGFVoice -> GFVoice
-  SGFFiles -> GFFiles
-
-class GroupPreferenceI p where
-  getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
-
-instance GroupPreferenceI GroupPreferences where
-  getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt prefs)
-
-instance GroupPreferenceI (Maybe GroupPreferences) where
-  getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
-
-instance GroupPreferenceI FullGroupPreferences where
-  getGroupPreference = \case
-    SGFTimedMessages -> timedMessages
-    SGFDirectMessages -> directMessages
-    SGFFullDelete -> fullDelete
-    SGFReactions -> reactions
-    SGFVoice -> voice
-    SGFFiles -> files
-  {-# INLINE getGroupPreference #-}
-
--- collection of optional group preferences
-data GroupPreferences = GroupPreferences
-  { timedMessages :: Maybe TimedMessagesGroupPreference,
-    directMessages :: Maybe DirectMessagesGroupPreference,
-    fullDelete :: Maybe FullDeleteGroupPreference,
-    reactions :: Maybe ReactionsGroupPreference,
-    voice :: Maybe VoiceGroupPreference,
-    files :: Maybe FilesGroupPreference
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupPreferences where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-instance ToField GroupPreferences where
-  toField = toField . encodeJSON
-
-instance FromField GroupPreferences where
-  fromField = fromTextField_ decodeJSON
-
-setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
-setGroupPreference f enable prefs_ = setGroupPreference_ f pref prefs
-  where
-    prefs = mergeGroupPreferences prefs_
-    pref :: GroupFeaturePreference f
-    pref = setField @"enable" (getGroupPreference f prefs) enable
-
-setGroupPreference' :: SGroupFeature f -> GroupFeaturePreference f -> Maybe GroupPreferences -> GroupPreferences
-setGroupPreference' f pref prefs_ = setGroupPreference_ f pref prefs
-  where
-    prefs = mergeGroupPreferences prefs_
-
-setGroupPreference_ :: SGroupFeature f -> GroupFeaturePreference f -> FullGroupPreferences -> GroupPreferences
-setGroupPreference_ f pref prefs =
-  toGroupPreferences $ case f of
-    SGFTimedMessages -> prefs {timedMessages = pref}
-    SGFDirectMessages -> prefs {directMessages = pref}
-    SGFFullDelete -> prefs {fullDelete = pref}
-    SGFReactions -> prefs {reactions = pref}
-    SGFVoice -> prefs {voice = pref}
-    SGFFiles -> prefs {files = pref}
-
-setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
-setGroupTimedMessagesPreference pref prefs_ =
-  toGroupPreferences $ prefs {timedMessages = pref}
-  where
-    prefs = mergeGroupPreferences prefs_
-
--- 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
-  { timedMessages :: TimedMessagesPreference,
-    fullDelete :: FullDeletePreference,
-    reactions :: ReactionsPreference,
-    voice :: VoicePreference,
-    calls :: CallsPreference
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FullPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-
--- full collection of group 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 GroupPreferences, defaults from defaultGroupPrefs are used here.
-data FullGroupPreferences = FullGroupPreferences
-  { timedMessages :: TimedMessagesGroupPreference,
-    directMessages :: DirectMessagesGroupPreference,
-    fullDelete :: FullDeleteGroupPreference,
-    reactions :: ReactionsGroupPreference,
-    voice :: VoiceGroupPreference,
-    files :: FilesGroupPreference
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-
--- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences
-data ContactUserPreferences = ContactUserPreferences
-  { timedMessages :: ContactUserPreference TimedMessagesPreference,
-    fullDelete :: ContactUserPreference FullDeletePreference,
-    reactions :: ContactUserPreference ReactionsPreference,
-    voice :: ContactUserPreference VoicePreference,
-    calls :: ContactUserPreference CallsPreference
-  }
-  deriving (Eq, Show, Generic)
-
-data ContactUserPreference p = ContactUserPreference
-  { enabled :: PrefEnabled,
-    userPreference :: ContactUserPref p,
-    contactPreference :: p
-  }
-  deriving (Eq, Show, Generic)
-
-data ContactUserPref p = CUPContact {preference :: p} | CUPUser {preference :: p}
-  deriving (Eq, Show, Generic)
-
-instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON p => ToJSON (ContactUserPreference p) where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON p => ToJSON (ContactUserPref p) where
-  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CUP"
-  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
-
-toChatPrefs :: FullPreferences -> Preferences
-toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} =
-  Preferences
-    { timedMessages = Just timedMessages,
-      fullDelete = Just fullDelete,
-      reactions = Just reactions,
-      voice = Just voice,
-      calls = Just calls
-    }
-
-defaultChatPrefs :: FullPreferences
-defaultChatPrefs =
-  FullPreferences
-    { timedMessages = TimedMessagesPreference {allow = FAYes, ttl = Nothing},
-      fullDelete = FullDeletePreference {allow = FANo},
-      reactions = ReactionsPreference {allow = FAYes},
-      voice = VoicePreference {allow = FAYes},
-      calls = CallsPreference {allow = FAYes}
-    }
-
-emptyChatPrefs :: Preferences
-emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing
-
-defaultGroupPrefs :: FullGroupPreferences
-defaultGroupPrefs =
-  FullGroupPreferences
-    { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400},
-      directMessages = DirectMessagesGroupPreference {enable = FEOff},
-      fullDelete = FullDeleteGroupPreference {enable = FEOff},
-      reactions = ReactionsGroupPreference {enable = FEOn},
-      voice = VoiceGroupPreference {enable = FEOn},
-      files = FilesGroupPreference {enable = FEOn}
-    }
-
-emptyGroupPrefs :: GroupPreferences
-emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing
-
-data TimedMessagesPreference = TimedMessagesPreference
-  { allow :: FeatureAllowed,
-    ttl :: Maybe Int
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON TimedMessagesPreference where
-  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
-  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
-
-data FullDeletePreference = FullDeletePreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON FullDeletePreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-data ReactionsPreference = ReactionsPreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON ReactionsPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-data VoicePreference = VoicePreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON VoicePreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-data CallsPreference = CallsPreference {allow :: FeatureAllowed}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON CallsPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureAllowed) => FeatureI f where
-  type FeaturePreference (f :: ChatFeature) = p | p -> f
-  sFeature :: SChatFeature f
-  prefParam :: FeaturePreference f -> Maybe Int
-
-instance HasField "allow" TimedMessagesPreference FeatureAllowed where
-  hasField p = (\allow -> p {allow}, allow (p :: TimedMessagesPreference))
-
-instance HasField "allow" FullDeletePreference FeatureAllowed where
-  hasField p = (\allow -> p {allow}, allow (p :: FullDeletePreference))
-
-instance HasField "allow" ReactionsPreference FeatureAllowed where
-  hasField p = (\allow -> p {allow}, allow (p :: ReactionsPreference))
-
-instance HasField "allow" VoicePreference FeatureAllowed where
-  hasField p = (\allow -> p {allow}, allow (p :: VoicePreference))
-
-instance HasField "allow" CallsPreference FeatureAllowed where
-  hasField p = (\allow -> p {allow}, allow (p :: CallsPreference))
-
-instance FeatureI 'CFTimedMessages where
-  type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
-  sFeature = SCFTimedMessages
-  prefParam TimedMessagesPreference {ttl} = ttl
-
-instance FeatureI 'CFFullDelete where
-  type FeaturePreference 'CFFullDelete = FullDeletePreference
-  sFeature = SCFFullDelete
-  prefParam _ = Nothing
-
-instance FeatureI 'CFReactions where
-  type FeaturePreference 'CFReactions = ReactionsPreference
-  sFeature = SCFReactions
-  prefParam _ = Nothing
-
-instance FeatureI 'CFVoice where
-  type FeaturePreference 'CFVoice = VoicePreference
-  sFeature = SCFVoice
-  prefParam _ = Nothing
-
-instance FeatureI 'CFCalls where
-  type FeaturePreference 'CFCalls = CallsPreference
-  sFeature = SCFCalls
-  prefParam _ = Nothing
-
-data GroupPreference = GroupPreference
-  {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-data TimedMessagesGroupPreference = TimedMessagesGroupPreference
-  { enable :: GroupFeatureEnabled,
-    ttl :: Maybe Int
-  }
-  deriving (Eq, Show, Generic, FromJSON)
-
-data DirectMessagesGroupPreference = DirectMessagesGroupPreference
-  {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-data FullDeleteGroupPreference = FullDeleteGroupPreference
-  {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-data ReactionsGroupPreference = ReactionsGroupPreference
-  {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-data VoiceGroupPreference = VoiceGroupPreference
-  {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-data FilesGroupPreference = FilesGroupPreference
-  {enable :: GroupFeatureEnabled}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON TimedMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON DirectMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON ReactionsGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON FullDeleteGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-instance ToJSON FilesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
-
-class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
-  type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
-  sGroupFeature :: SGroupFeature f
-  groupPrefParam :: GroupFeaturePreference f -> Maybe Int
-
-instance HasField "enable" GroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: GroupPreference))
-
-instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: TimedMessagesGroupPreference))
-
-instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: DirectMessagesGroupPreference))
-
-instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: ReactionsGroupPreference))
-
-instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: FullDeleteGroupPreference))
-
-instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: VoiceGroupPreference))
-
-instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
-  hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference))
-
-instance GroupFeatureI 'GFTimedMessages where
-  type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
-  sGroupFeature = SGFTimedMessages
-  groupPrefParam TimedMessagesGroupPreference {ttl} = ttl
-
-instance GroupFeatureI 'GFDirectMessages where
-  type GroupFeaturePreference 'GFDirectMessages = DirectMessagesGroupPreference
-  sGroupFeature = SGFDirectMessages
-  groupPrefParam _ = Nothing
-
-instance GroupFeatureI 'GFFullDelete where
-  type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference
-  sGroupFeature = SGFFullDelete
-  groupPrefParam _ = Nothing
-
-instance GroupFeatureI 'GFReactions where
-  type GroupFeaturePreference 'GFReactions = ReactionsGroupPreference
-  sGroupFeature = SGFReactions
-  groupPrefParam _ = Nothing
-
-instance GroupFeatureI 'GFVoice where
-  type GroupFeaturePreference 'GFVoice = VoiceGroupPreference
-  sGroupFeature = SGFVoice
-  groupPrefParam _ = Nothing
-
-instance GroupFeatureI 'GFFiles where
-  type GroupFeaturePreference 'GFFiles = FilesGroupPreference
-  sGroupFeature = SGFFiles
-  groupPrefParam _ = Nothing
-
-groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
-groupPrefStateText feature pref param =
-  let enabled = getField @"enable" pref
-      paramText = if enabled == FEOn then groupParamText_ feature param else ""
-   in groupFeatureNameText feature <> ": " <> safeDecodeUtf8 (strEncode enabled) <> paramText
-
-groupParamText_ :: GroupFeature -> Maybe Int -> Text
-groupParamText_ feature param = case feature of
-  GFTimedMessages -> maybe "" (\p -> " (" <> timedTTLText p <> ")") param
-  _ -> ""
-
-groupPreferenceText :: forall f. GroupFeatureI f => GroupFeaturePreference f -> Text
-groupPreferenceText pref =
-  let feature = toGroupFeature $ sGroupFeature @f
-   in groupPrefStateText feature pref $ groupPrefParam pref
-
-timedTTLText :: Int -> Text
-timedTTLText 0 = "0 sec"
-timedTTLText ttl = do
-  let (m', s) = ttl `quotRem` 60
-      (h', m) = m' `quotRem` 60
-      (d', h) = h' `quotRem` 24
-      (mm, d) = d' `quotRem` 30
-  T.pack . unwords $
-    [mms mm | mm /= 0] <> [ds d | d /= 0] <> [hs h | h /= 0] <> [ms m | m /= 0] <> [ss s | s /= 0]
-  where
-    ss s = show s <> " sec"
-    ms m = show m <> " min"
-    hs 1 = "1 hour"
-    hs h = show h <> " hours"
-    ds 1 = "1 day"
-    ds 7 = "1 week"
-    ds 14 = "2 weeks"
-    ds d = show d <> " days"
-    mms 1 = "1 month"
-    mms mm = show mm <> " months"
-
-toGroupPreference :: GroupFeatureI f => GroupFeaturePreference f -> GroupPreference
-toGroupPreference p = GroupPreference {enable = getField @"enable" p}
-
-data FeatureAllowed
-  = FAAlways -- allow unconditionally
-  | FAYes -- allow, if peer allows it
-  | FANo -- do not allow
-  deriving (Eq, Show, Generic)
-
-instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode
-
-instance ToField FeatureAllowed where toField = toField . strEncode
-
-instance StrEncoding FeatureAllowed where
-  strEncode = \case
-    FAAlways -> "always"
-    FAYes -> "yes"
-    FANo -> "no"
-  strDecode = \case
-    "always" -> Right FAAlways
-    "yes" -> Right FAYes
-    "no" -> Right FANo
-    r -> Left $ "bad FeatureAllowed " <> B.unpack r
-  strP = strDecode <$?> A.takeByteString
-
-instance FromJSON FeatureAllowed where
-  parseJSON = strParseJSON "FeatureAllowed"
-
-instance ToJSON FeatureAllowed where
-  toJSON = strToJSON
-  toEncoding = strToJEncoding
-
-data GroupFeatureEnabled = FEOn | FEOff
-  deriving (Eq, Show, Generic)
-
-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
-
-groupFeatureState :: GroupFeatureI f => GroupFeaturePreference f -> (GroupFeatureEnabled, Maybe Int)
-groupFeatureState p =
-  let enable = getField @"enable" p
-      param = if enable == FEOn then groupPrefParam p else Nothing
-   in (enable, param)
-
-mergePreferences :: Maybe Preferences -> Maybe Preferences -> FullPreferences
-mergePreferences contactPrefs userPreferences =
-  FullPreferences
-    { timedMessages = pref SCFTimedMessages,
-      fullDelete = pref SCFFullDelete,
-      reactions = pref SCFReactions,
-      voice = pref SCFVoice,
-      calls = pref SCFCalls
-    }
-  where
-    pref :: SChatFeature f -> FeaturePreference f
-    pref f =
-      let sel = chatPrefSel f
-       in fromMaybe (getPreference f defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel)
-
 mergeUserChatPrefs :: User -> Contact -> FullPreferences
 mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct)
 
@@ -1014,94 +361,6 @@ mergeUserChatPrefs' user connectedIncognito userPreferences =
   let userPrefs = if connectedIncognito then Nothing else preferences' user
    in mergePreferences (Just userPreferences) userPrefs
 
-mergeGroupPreferences :: Maybe GroupPreferences -> FullGroupPreferences
-mergeGroupPreferences groupPreferences =
-  FullGroupPreferences
-    { timedMessages = pref SGFTimedMessages,
-      directMessages = pref SGFDirectMessages,
-      fullDelete = pref SGFFullDelete,
-      reactions = pref SGFReactions,
-      voice = pref SGFVoice,
-      files = pref SGFFiles
-    }
-  where
-    pref :: SGroupFeature f -> GroupFeaturePreference f
-    pref pt = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPreferences >>= groupPrefSel pt)
-
-toGroupPreferences :: FullGroupPreferences -> GroupPreferences
-toGroupPreferences groupPreferences =
-  GroupPreferences
-    { timedMessages = pref SGFTimedMessages,
-      directMessages = pref SGFDirectMessages,
-      fullDelete = pref SGFFullDelete,
-      reactions = pref SGFReactions,
-      voice = pref SGFVoice,
-      files = pref SGFFiles
-    }
-  where
-    pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
-    pref f = Just $ getGroupPreference f groupPreferences
-
-data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
-  deriving (Eq, Show, Generic, FromJSON)
-
-instance ToJSON PrefEnabled where
-  toJSON = J.genericToJSON J.defaultOptions
-  toEncoding = J.genericToEncoding J.defaultOptions
-
-prefEnabled :: FeatureI f => Bool -> FeaturePreference f -> FeaturePreference f -> PrefEnabled
-prefEnabled asymmetric user contact = case (getField @"allow" user, getField @"allow" contact) of
-  (FAAlways, FANo) -> PrefEnabled {forUser = False, forContact = asymmetric}
-  (FANo, FAAlways) -> PrefEnabled {forUser = asymmetric, forContact = False}
-  (_, FANo) -> PrefEnabled False False
-  (FANo, _) -> PrefEnabled False False
-  _ -> PrefEnabled True True
-
-prefStateText :: ChatFeature -> FeatureAllowed -> Maybe Int -> Text
-prefStateText feature allowed param = case allowed of
-  FANo -> "cancelled " <> chatFeatureNameText feature
-  _ -> "offered " <> chatFeatureNameText feature <> paramText_ feature param
-
-featureStateText :: ChatFeature -> PrefEnabled -> Maybe Int -> Text
-featureStateText feature enabled param =
-  chatFeatureNameText feature <> ": " <> prefEnabledToText feature enabled param <> case enabled of
-    PrefEnabled {forUser = True} -> paramText_ feature param
-    _ -> ""
-
-paramText_ :: ChatFeature -> Maybe Int -> Text
-paramText_ feature param = case feature of
-  CFTimedMessages -> maybe "" (\p -> " (" <> timedTTLText p <> ")") param
-  _ -> ""
-
-prefEnabledToText :: ChatFeature -> PrefEnabled -> Maybe Int -> Text
-prefEnabledToText f enabled param = case enabled of
-  PrefEnabled True True -> enabledStr
-  PrefEnabled False False -> "off"
-  PrefEnabled {forUser = True, forContact = False} -> enabledStr <> " for you"
-  PrefEnabled {forUser = False, forContact = True} -> enabledStr <> " for contact"
-  where
-    enabledStr = case f of
-      CFTimedMessages -> if isJust param then "enabled" else "allowed"
-      _ -> "enabled"
-
-preferenceText :: forall f. FeatureI f => FeaturePreference f -> Text
-preferenceText p =
-  let feature = chatFeature $ sFeature @f
-      allowed = getField @"allow" p
-      paramText = if allowed == FAAlways || allowed == FAYes then paramText_ feature (prefParam p) else ""
-   in safeDecodeUtf8 (strEncode allowed) <> paramText
-
-featureState :: FeatureI f => ContactUserPreference (FeaturePreference f) -> (PrefEnabled, Maybe Int)
-featureState ContactUserPreference {enabled, userPreference} =
-  let param = if forUser enabled then prefParam $ preference userPreference else Nothing
-   in (enabled, param)
-
-preferenceState :: FeatureI f => FeaturePreference f -> (FeatureAllowed, Maybe Int)
-preferenceState pref =
-  let allow = getField @"allow" pref
-      param = if allow == FAAlways || allow == FAYes then prefParam pref else Nothing
-   in (allow, param)
-
 updateMergedPreferences :: User -> Contact -> Contact
 updateMergedPreferences user ct =
   let mergedPreferences = contactUserPreferences user (userPreferences ct) (preferences' ct) (contactConnIncognito ct)
@@ -1135,14 +394,6 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit
     ctUserPrefs = mergeUserChatPrefs' user connectedIncognito userPreferences
     ctPrefs = mergePreferences contactPreferences Nothing
 
-getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f)
-getContactUserPreference = \case
-  SCFTimedMessages -> timedMessages
-  SCFFullDelete -> fullDelete
-  SCFReactions -> reactions
-  SCFVoice -> voice
-  SCFCalls -> calls
-
 data Profile = Profile
   { displayName :: ContactName,
     fullName :: Text,
@@ -1433,14 +684,6 @@ instance ToJSON GroupMemberRole where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
-fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k
-fromBlobField_ p = \case
-  f@(Field (SQLBlob b) _) ->
-    case p b of
-      Right k -> Ok k
-      Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
-  f -> returnError ConversionFailed f "expecting SQLBlob column type"
-
 newtype Probe = Probe {unProbe :: ByteString}
   deriving (Eq, Show)
 
@@ -2194,12 +1437,6 @@ data XGrpMemIntroCont = XGrpMemIntroCont
   }
   deriving (Show)
 
-encodeJSON :: ToJSON a => a -> Text
-encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
-
-decodeJSON :: FromJSON a => Text -> Maybe a
-decodeJSON = J.decode . LB.fromStrict . encodeUtf8
-
 data ServerCfg p = ServerCfg
   { server :: ProtoServerWithAuth p,
     preset :: Bool,

src/Simplex/Chat/Types/Preferences.hs

@@ -0,0 +1,778 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use newtype instead of data" #-}
+
+module Simplex.Chat.Types.Preferences where
+
+import Control.Applicative ((<|>))
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as J
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe (fromMaybe, isJust)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
+import GHC.Generics (Generic)
+import GHC.Records.Compat
+import Simplex.Chat.Types.Util
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
+import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
+
+data ChatFeature
+  = CFTimedMessages
+  | CFFullDelete
+  | CFReactions
+  | CFVoice
+  | CFCalls
+  deriving (Show, Generic)
+
+data SChatFeature (f :: ChatFeature) where
+  SCFTimedMessages :: SChatFeature 'CFTimedMessages
+  SCFFullDelete :: SChatFeature 'CFFullDelete
+  SCFReactions :: SChatFeature 'CFReactions
+  SCFVoice :: SChatFeature 'CFVoice
+  SCFCalls :: SChatFeature 'CFCalls
+
+deriving instance Show (SChatFeature f)
+
+data AChatFeature = forall f. FeatureI f => ACF (SChatFeature f)
+
+deriving instance Show AChatFeature
+
+chatFeatureNameText :: ChatFeature -> Text
+chatFeatureNameText = \case
+  CFTimedMessages -> "Disappearing messages"
+  CFFullDelete -> "Full deletion"
+  CFReactions -> "Message reactions"
+  CFVoice -> "Voice messages"
+  CFCalls -> "Audio/video calls"
+
+chatFeatureNameText' :: SChatFeature f -> Text
+chatFeatureNameText' = chatFeatureNameText . chatFeature
+
+instance ToJSON ChatFeature where
+  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CF"
+  toJSON = J.genericToJSON . enumJSON $ dropPrefix "CF"
+
+instance FromJSON ChatFeature where
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CF"
+
+allChatFeatures :: [AChatFeature]
+allChatFeatures =
+  [ ACF SCFTimedMessages,
+    ACF SCFFullDelete,
+    ACF SCFReactions,
+    ACF SCFVoice,
+    ACF SCFCalls
+  ]
+
+chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
+chatPrefSel = \case
+  SCFTimedMessages -> timedMessages
+  SCFFullDelete -> fullDelete
+  SCFReactions -> reactions
+  SCFVoice -> voice
+  SCFCalls -> calls
+
+chatFeature :: SChatFeature f -> ChatFeature
+chatFeature = \case
+  SCFTimedMessages -> CFTimedMessages
+  SCFFullDelete -> CFFullDelete
+  SCFReactions -> CFReactions
+  SCFVoice -> CFVoice
+  SCFCalls -> CFCalls
+
+class PreferenceI p where
+  getPreference :: SChatFeature f -> p -> FeaturePreference f
+
+instance PreferenceI Preferences where
+  getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f prefs)
+
+instance PreferenceI (Maybe Preferences) where
+  getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs)
+
+instance PreferenceI FullPreferences where
+  getPreference = \case
+    SCFTimedMessages -> timedMessages
+    SCFFullDelete -> fullDelete
+    SCFReactions -> reactions
+    SCFVoice -> voice
+    SCFCalls -> calls
+  {-# INLINE getPreference #-}
+
+setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
+setPreference f allow_ prefs_ = setPreference_ f pref $ fromMaybe emptyChatPrefs prefs_
+  where
+    pref = setAllow <$> allow_
+    setAllow :: FeatureAllowed -> FeaturePreference f
+    setAllow = setField @"allow" (getPreference f prefs)
+    prefs = mergePreferences Nothing prefs_
+
+setPreference' :: SChatFeature f -> Maybe (FeaturePreference f) -> Maybe Preferences -> Preferences
+setPreference' f pref_ prefs_ = setPreference_ f pref_ $ fromMaybe emptyChatPrefs prefs_
+
+setPreference_ :: SChatFeature f -> Maybe (FeaturePreference f) -> Preferences -> Preferences
+setPreference_ f pref_ prefs =
+  case f of
+    SCFTimedMessages -> prefs {timedMessages = pref_}
+    SCFFullDelete -> prefs {fullDelete = pref_}
+    SCFReactions -> prefs {reactions = pref_}
+    SCFVoice -> prefs {voice = pref_}
+    SCFCalls -> prefs {calls = pref_}
+
+-- collection of optional chat preferences for the user and the contact
+data Preferences = Preferences
+  { timedMessages :: Maybe TimedMessagesPreference,
+    fullDelete :: Maybe FullDeletePreference,
+    reactions :: Maybe ReactionsPreference,
+    voice :: Maybe VoicePreference,
+    calls :: Maybe CallsPreference
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+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 GroupFeature
+  = GFTimedMessages
+  | GFDirectMessages
+  | GFFullDelete
+  | GFReactions
+  | GFVoice
+  | GFFiles
+  deriving (Show, Generic)
+
+data SGroupFeature (f :: GroupFeature) where
+  SGFTimedMessages :: SGroupFeature 'GFTimedMessages
+  SGFDirectMessages :: SGroupFeature 'GFDirectMessages
+  SGFFullDelete :: SGroupFeature 'GFFullDelete
+  SGFReactions :: SGroupFeature 'GFReactions
+  SGFVoice :: SGroupFeature 'GFVoice
+  SGFFiles :: SGroupFeature 'GFFiles
+
+deriving instance Show (SGroupFeature f)
+
+data AGroupFeature = forall f. GroupFeatureI f => AGF (SGroupFeature f)
+
+deriving instance Show AGroupFeature
+
+groupFeatureNameText :: GroupFeature -> Text
+groupFeatureNameText = \case
+  GFTimedMessages -> "Disappearing messages"
+  GFDirectMessages -> "Direct messages"
+  GFFullDelete -> "Full deletion"
+  GFReactions -> "Message reactions"
+  GFVoice -> "Voice messages"
+  GFFiles -> "Files and media"
+
+groupFeatureNameText' :: SGroupFeature f -> Text
+groupFeatureNameText' = groupFeatureNameText . toGroupFeature
+
+groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferences -> Bool
+groupFeatureAllowed' feature prefs =
+  getField @"enable" (getGroupPreference feature prefs) == FEOn
+
+instance ToJSON GroupFeature where
+  toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "GF"
+  toJSON = J.genericToJSON . enumJSON $ dropPrefix "GF"
+
+instance FromJSON GroupFeature where
+  parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "GF"
+
+allGroupFeatures :: [AGroupFeature]
+allGroupFeatures =
+  [ AGF SGFTimedMessages,
+    AGF SGFDirectMessages,
+    AGF SGFFullDelete,
+    AGF SGFReactions,
+    AGF SGFVoice,
+    AGF SGFFiles
+  ]
+
+groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
+groupPrefSel = \case
+  SGFTimedMessages -> timedMessages
+  SGFDirectMessages -> directMessages
+  SGFFullDelete -> fullDelete
+  SGFReactions -> reactions
+  SGFVoice -> voice
+  SGFFiles -> files
+
+toGroupFeature :: SGroupFeature f -> GroupFeature
+toGroupFeature = \case
+  SGFTimedMessages -> GFTimedMessages
+  SGFDirectMessages -> GFDirectMessages
+  SGFFullDelete -> GFFullDelete
+  SGFReactions -> GFReactions
+  SGFVoice -> GFVoice
+  SGFFiles -> GFFiles
+
+class GroupPreferenceI p where
+  getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
+
+instance GroupPreferenceI GroupPreferences where
+  getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt prefs)
+
+instance GroupPreferenceI (Maybe GroupPreferences) where
+  getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
+
+instance GroupPreferenceI FullGroupPreferences where
+  getGroupPreference = \case
+    SGFTimedMessages -> timedMessages
+    SGFDirectMessages -> directMessages
+    SGFFullDelete -> fullDelete
+    SGFReactions -> reactions
+    SGFVoice -> voice
+    SGFFiles -> files
+  {-# INLINE getGroupPreference #-}
+
+-- collection of optional group preferences
+data GroupPreferences = GroupPreferences
+  { timedMessages :: Maybe TimedMessagesGroupPreference,
+    directMessages :: Maybe DirectMessagesGroupPreference,
+    fullDelete :: Maybe FullDeleteGroupPreference,
+    reactions :: Maybe ReactionsGroupPreference,
+    voice :: Maybe VoiceGroupPreference,
+    files :: Maybe FilesGroupPreference
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON GroupPreferences where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+instance ToField GroupPreferences where
+  toField = toField . encodeJSON
+
+instance FromField GroupPreferences where
+  fromField = fromTextField_ decodeJSON
+
+setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
+setGroupPreference f enable prefs_ = setGroupPreference_ f pref prefs
+  where
+    prefs = mergeGroupPreferences prefs_
+    pref :: GroupFeaturePreference f
+    pref = setField @"enable" (getGroupPreference f prefs) enable
+
+setGroupPreference' :: SGroupFeature f -> GroupFeaturePreference f -> Maybe GroupPreferences -> GroupPreferences
+setGroupPreference' f pref prefs_ = setGroupPreference_ f pref prefs
+  where
+    prefs = mergeGroupPreferences prefs_
+
+setGroupPreference_ :: SGroupFeature f -> GroupFeaturePreference f -> FullGroupPreferences -> GroupPreferences
+setGroupPreference_ f pref prefs =
+  toGroupPreferences $ case f of
+    SGFTimedMessages -> prefs {timedMessages = pref}
+    SGFDirectMessages -> prefs {directMessages = pref}
+    SGFFullDelete -> prefs {fullDelete = pref}
+    SGFReactions -> prefs {reactions = pref}
+    SGFVoice -> prefs {voice = pref}
+    SGFFiles -> prefs {files = pref}
+
+setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
+setGroupTimedMessagesPreference pref prefs_ =
+  toGroupPreferences $ prefs {timedMessages = pref}
+  where
+    prefs = mergeGroupPreferences prefs_
+
+-- 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
+  { timedMessages :: TimedMessagesPreference,
+    fullDelete :: FullDeletePreference,
+    reactions :: ReactionsPreference,
+    voice :: VoicePreference,
+    calls :: CallsPreference
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON FullPreferences where toEncoding = J.genericToEncoding J.defaultOptions
+
+-- full collection of group 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 GroupPreferences, defaults from defaultGroupPrefs are used here.
+data FullGroupPreferences = FullGroupPreferences
+  { timedMessages :: TimedMessagesGroupPreference,
+    directMessages :: DirectMessagesGroupPreference,
+    fullDelete :: FullDeleteGroupPreference,
+    reactions :: ReactionsGroupPreference,
+    voice :: VoiceGroupPreference,
+    files :: FilesGroupPreference
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.defaultOptions
+
+-- merged preferences of user for a given contact - they differentiate between specific preferences for the contact and global user preferences
+data ContactUserPreferences = ContactUserPreferences
+  { timedMessages :: ContactUserPreference TimedMessagesPreference,
+    fullDelete :: ContactUserPreference FullDeletePreference,
+    reactions :: ContactUserPreference ReactionsPreference,
+    voice :: ContactUserPreference VoicePreference,
+    calls :: ContactUserPreference CallsPreference
+  }
+  deriving (Eq, Show, Generic)
+
+data ContactUserPreference p = ContactUserPreference
+  { enabled :: PrefEnabled,
+    userPreference :: ContactUserPref p,
+    contactPreference :: p
+  }
+  deriving (Eq, Show, Generic)
+
+data ContactUserPref p = CUPContact {preference :: p} | CUPUser {preference :: p}
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ContactUserPreferences where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON p => ToJSON (ContactUserPreference p) where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON p => ToJSON (ContactUserPref p) where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CUP"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
+
+toChatPrefs :: FullPreferences -> Preferences
+toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} =
+  Preferences
+    { timedMessages = Just timedMessages,
+      fullDelete = Just fullDelete,
+      reactions = Just reactions,
+      voice = Just voice,
+      calls = Just calls
+    }
+
+defaultChatPrefs :: FullPreferences
+defaultChatPrefs =
+  FullPreferences
+    { timedMessages = TimedMessagesPreference {allow = FAYes, ttl = Nothing},
+      fullDelete = FullDeletePreference {allow = FANo},
+      reactions = ReactionsPreference {allow = FAYes},
+      voice = VoicePreference {allow = FAYes},
+      calls = CallsPreference {allow = FAYes}
+    }
+
+emptyChatPrefs :: Preferences
+emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing
+
+defaultGroupPrefs :: FullGroupPreferences
+defaultGroupPrefs =
+  FullGroupPreferences
+    { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400},
+      directMessages = DirectMessagesGroupPreference {enable = FEOff},
+      fullDelete = FullDeleteGroupPreference {enable = FEOff},
+      reactions = ReactionsGroupPreference {enable = FEOn},
+      voice = VoiceGroupPreference {enable = FEOn},
+      files = FilesGroupPreference {enable = FEOn}
+    }
+
+emptyGroupPrefs :: GroupPreferences
+emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing
+
+data TimedMessagesPreference = TimedMessagesPreference
+  { allow :: FeatureAllowed,
+    ttl :: Maybe Int
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON TimedMessagesPreference where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+data FullDeletePreference = FullDeletePreference {allow :: FeatureAllowed}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON FullDeletePreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+data ReactionsPreference = ReactionsPreference {allow :: FeatureAllowed}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON ReactionsPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+data VoicePreference = VoicePreference {allow :: FeatureAllowed}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON VoicePreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+data CallsPreference = CallsPreference {allow :: FeatureAllowed}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON CallsPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureAllowed) => FeatureI f where
+  type FeaturePreference (f :: ChatFeature) = p | p -> f
+  sFeature :: SChatFeature f
+  prefParam :: FeaturePreference f -> Maybe Int
+
+instance HasField "allow" TimedMessagesPreference FeatureAllowed where
+  hasField p = (\allow -> p {allow}, allow (p :: TimedMessagesPreference))
+
+instance HasField "allow" FullDeletePreference FeatureAllowed where
+  hasField p = (\allow -> p {allow}, allow (p :: FullDeletePreference))
+
+instance HasField "allow" ReactionsPreference FeatureAllowed where
+  hasField p = (\allow -> p {allow}, allow (p :: ReactionsPreference))
+
+instance HasField "allow" VoicePreference FeatureAllowed where
+  hasField p = (\allow -> p {allow}, allow (p :: VoicePreference))
+
+instance HasField "allow" CallsPreference FeatureAllowed where
+  hasField p = (\allow -> p {allow}, allow (p :: CallsPreference))
+
+instance FeatureI 'CFTimedMessages where
+  type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
+  sFeature = SCFTimedMessages
+  prefParam TimedMessagesPreference {ttl} = ttl
+
+instance FeatureI 'CFFullDelete where
+  type FeaturePreference 'CFFullDelete = FullDeletePreference
+  sFeature = SCFFullDelete
+  prefParam _ = Nothing
+
+instance FeatureI 'CFReactions where
+  type FeaturePreference 'CFReactions = ReactionsPreference
+  sFeature = SCFReactions
+  prefParam _ = Nothing
+
+instance FeatureI 'CFVoice where
+  type FeaturePreference 'CFVoice = VoicePreference
+  sFeature = SCFVoice
+  prefParam _ = Nothing
+
+instance FeatureI 'CFCalls where
+  type FeaturePreference 'CFCalls = CallsPreference
+  sFeature = SCFCalls
+  prefParam _ = Nothing
+
+data GroupPreference = GroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)
+
+data TimedMessagesGroupPreference = TimedMessagesGroupPreference
+  { enable :: GroupFeatureEnabled,
+    ttl :: Maybe Int
+  }
+  deriving (Eq, Show, Generic, FromJSON)
+
+data DirectMessagesGroupPreference = DirectMessagesGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)
+
+data FullDeleteGroupPreference = FullDeleteGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)
+
+data ReactionsGroupPreference = ReactionsGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)
+
+data VoiceGroupPreference = VoiceGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)
+
+data FilesGroupPreference = FilesGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON GroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON TimedMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON DirectMessagesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON ReactionsGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON FullDeleteGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON FilesGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
+  type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
+  sGroupFeature :: SGroupFeature f
+  groupPrefParam :: GroupFeaturePreference f -> Maybe Int
+
+instance HasField "enable" GroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: GroupPreference))
+
+instance HasField "enable" TimedMessagesGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: TimedMessagesGroupPreference))
+
+instance HasField "enable" DirectMessagesGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: DirectMessagesGroupPreference))
+
+instance HasField "enable" ReactionsGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: ReactionsGroupPreference))
+
+instance HasField "enable" FullDeleteGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: FullDeleteGroupPreference))
+
+instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: VoiceGroupPreference))
+
+instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference))
+
+instance GroupFeatureI 'GFTimedMessages where
+  type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
+  sGroupFeature = SGFTimedMessages
+  groupPrefParam TimedMessagesGroupPreference {ttl} = ttl
+
+instance GroupFeatureI 'GFDirectMessages where
+  type GroupFeaturePreference 'GFDirectMessages = DirectMessagesGroupPreference
+  sGroupFeature = SGFDirectMessages
+  groupPrefParam _ = Nothing
+
+instance GroupFeatureI 'GFFullDelete where
+  type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference
+  sGroupFeature = SGFFullDelete
+  groupPrefParam _ = Nothing
+
+instance GroupFeatureI 'GFReactions where
+  type GroupFeaturePreference 'GFReactions = ReactionsGroupPreference
+  sGroupFeature = SGFReactions
+  groupPrefParam _ = Nothing
+
+instance GroupFeatureI 'GFVoice where
+  type GroupFeaturePreference 'GFVoice = VoiceGroupPreference
+  sGroupFeature = SGFVoice
+  groupPrefParam _ = Nothing
+
+instance GroupFeatureI 'GFFiles where
+  type GroupFeaturePreference 'GFFiles = FilesGroupPreference
+  sGroupFeature = SGFFiles
+  groupPrefParam _ = Nothing
+
+groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
+groupPrefStateText feature pref param =
+  let enabled = getField @"enable" pref
+      paramText = if enabled == FEOn then groupParamText_ feature param else ""
+   in groupFeatureNameText feature <> ": " <> safeDecodeUtf8 (strEncode enabled) <> paramText
+
+groupParamText_ :: GroupFeature -> Maybe Int -> Text
+groupParamText_ feature param = case feature of
+  GFTimedMessages -> maybe "" (\p -> " (" <> timedTTLText p <> ")") param
+  _ -> ""
+
+groupPreferenceText :: forall f. GroupFeatureI f => GroupFeaturePreference f -> Text
+groupPreferenceText pref =
+  let feature = toGroupFeature $ sGroupFeature @f
+   in groupPrefStateText feature pref $ groupPrefParam pref
+
+timedTTLText :: Int -> Text
+timedTTLText 0 = "0 sec"
+timedTTLText ttl = do
+  let (m', s) = ttl `quotRem` 60
+      (h', m) = m' `quotRem` 60
+      (d', h) = h' `quotRem` 24
+      (mm, d) = d' `quotRem` 30
+  T.pack . unwords $
+    [mms mm | mm /= 0] <> [ds d | d /= 0] <> [hs h | h /= 0] <> [ms m | m /= 0] <> [ss s | s /= 0]
+  where
+    ss s = show s <> " sec"
+    ms m = show m <> " min"
+    hs 1 = "1 hour"
+    hs h = show h <> " hours"
+    ds 1 = "1 day"
+    ds 7 = "1 week"
+    ds 14 = "2 weeks"
+    ds d = show d <> " days"
+    mms 1 = "1 month"
+    mms mm = show mm <> " months"
+
+toGroupPreference :: GroupFeatureI f => GroupFeaturePreference f -> GroupPreference
+toGroupPreference p = GroupPreference {enable = getField @"enable" p}
+
+data FeatureAllowed
+  = FAAlways -- allow unconditionally
+  | FAYes -- allow, if peer allows it
+  | FANo -- do not allow
+  deriving (Eq, Show, Generic)
+
+instance FromField FeatureAllowed where fromField = fromBlobField_ strDecode
+
+instance ToField FeatureAllowed where toField = toField . strEncode
+
+instance StrEncoding FeatureAllowed where
+  strEncode = \case
+    FAAlways -> "always"
+    FAYes -> "yes"
+    FANo -> "no"
+  strDecode = \case
+    "always" -> Right FAAlways
+    "yes" -> Right FAYes
+    "no" -> Right FANo
+    r -> Left $ "bad FeatureAllowed " <> B.unpack r
+  strP = strDecode <$?> A.takeByteString
+
+instance FromJSON FeatureAllowed where
+  parseJSON = strParseJSON "FeatureAllowed"
+
+instance ToJSON FeatureAllowed where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+data GroupFeatureEnabled = FEOn | FEOff
+  deriving (Eq, Show, Generic)
+
+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
+
+groupFeatureState :: GroupFeatureI f => GroupFeaturePreference f -> (GroupFeatureEnabled, Maybe Int)
+groupFeatureState p =
+  let enable = getField @"enable" p
+      param = if enable == FEOn then groupPrefParam p else Nothing
+   in (enable, param)
+
+mergePreferences :: Maybe Preferences -> Maybe Preferences -> FullPreferences
+mergePreferences contactPrefs userPreferences =
+  FullPreferences
+    { timedMessages = pref SCFTimedMessages,
+      fullDelete = pref SCFFullDelete,
+      reactions = pref SCFReactions,
+      voice = pref SCFVoice,
+      calls = pref SCFCalls
+    }
+  where
+    pref :: SChatFeature f -> FeaturePreference f
+    pref f =
+      let sel = chatPrefSel f
+       in fromMaybe (getPreference f defaultChatPrefs) $ (contactPrefs >>= sel) <|> (userPreferences >>= sel)
+
+mergeGroupPreferences :: Maybe GroupPreferences -> FullGroupPreferences
+mergeGroupPreferences groupPreferences =
+  FullGroupPreferences
+    { timedMessages = pref SGFTimedMessages,
+      directMessages = pref SGFDirectMessages,
+      fullDelete = pref SGFFullDelete,
+      reactions = pref SGFReactions,
+      voice = pref SGFVoice,
+      files = pref SGFFiles
+    }
+  where
+    pref :: SGroupFeature f -> GroupFeaturePreference f
+    pref pt = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPreferences >>= groupPrefSel pt)
+
+toGroupPreferences :: FullGroupPreferences -> GroupPreferences
+toGroupPreferences groupPreferences =
+  GroupPreferences
+    { timedMessages = pref SGFTimedMessages,
+      directMessages = pref SGFDirectMessages,
+      fullDelete = pref SGFFullDelete,
+      reactions = pref SGFReactions,
+      voice = pref SGFVoice,
+      files = pref SGFFiles
+    }
+  where
+    pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
+    pref f = Just $ getGroupPreference f groupPreferences
+
+data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON PrefEnabled where
+  toJSON = J.genericToJSON J.defaultOptions
+  toEncoding = J.genericToEncoding J.defaultOptions
+
+prefEnabled :: FeatureI f => Bool -> FeaturePreference f -> FeaturePreference f -> PrefEnabled
+prefEnabled asymmetric user contact = case (getField @"allow" user, getField @"allow" contact) of
+  (FAAlways, FANo) -> PrefEnabled {forUser = False, forContact = asymmetric}
+  (FANo, FAAlways) -> PrefEnabled {forUser = asymmetric, forContact = False}
+  (_, FANo) -> PrefEnabled False False
+  (FANo, _) -> PrefEnabled False False
+  _ -> PrefEnabled True True
+
+prefStateText :: ChatFeature -> FeatureAllowed -> Maybe Int -> Text
+prefStateText feature allowed param = case allowed of
+  FANo -> "cancelled " <> chatFeatureNameText feature
+  _ -> "offered " <> chatFeatureNameText feature <> paramText_ feature param
+
+featureStateText :: ChatFeature -> PrefEnabled -> Maybe Int -> Text
+featureStateText feature enabled param =
+  chatFeatureNameText feature <> ": " <> prefEnabledToText feature enabled param <> case enabled of
+    PrefEnabled {forUser = True} -> paramText_ feature param
+    _ -> ""
+
+paramText_ :: ChatFeature -> Maybe Int -> Text
+paramText_ feature param = case feature of
+  CFTimedMessages -> maybe "" (\p -> " (" <> timedTTLText p <> ")") param
+  _ -> ""
+
+prefEnabledToText :: ChatFeature -> PrefEnabled -> Maybe Int -> Text
+prefEnabledToText f enabled param = case enabled of
+  PrefEnabled True True -> enabledStr
+  PrefEnabled False False -> "off"
+  PrefEnabled {forUser = True, forContact = False} -> enabledStr <> " for you"
+  PrefEnabled {forUser = False, forContact = True} -> enabledStr <> " for contact"
+  where
+    enabledStr = case f of
+      CFTimedMessages -> if isJust param then "enabled" else "allowed"
+      _ -> "enabled"
+
+preferenceText :: forall f. FeatureI f => FeaturePreference f -> Text
+preferenceText p =
+  let feature = chatFeature $ sFeature @f
+      allowed = getField @"allow" p
+      paramText = if allowed == FAAlways || allowed == FAYes then paramText_ feature (prefParam p) else ""
+   in safeDecodeUtf8 (strEncode allowed) <> paramText
+
+featureState :: FeatureI f => ContactUserPreference (FeaturePreference f) -> (PrefEnabled, Maybe Int)
+featureState ContactUserPreference {enabled, userPreference} =
+  let param = if forUser enabled then prefParam $ preference userPreference else Nothing
+   in (enabled, param)
+
+preferenceState :: FeatureI f => FeaturePreference f -> (FeatureAllowed, Maybe Int)
+preferenceState pref =
+  let allow = getField @"allow" pref
+      param = if allow == FAAlways || allow == FAYes then prefParam pref else Nothing
+   in (allow, param)
+
+getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f)
+getContactUserPreference = \case
+  SCFTimedMessages -> timedMessages
+  SCFFullDelete -> fullDelete
+  SCFReactions -> reactions
+  SCFVoice -> voice
+  SCFCalls -> calls

src/Simplex/Chat/Types/Util.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Simplex.Chat.Types.Util where
+
+import Data.Aeson (ToJSON, FromJSON)
+import qualified Data.Aeson as J
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Typeable
+import Database.SQLite.Simple (ResultError (..), SQLData (..))
+import Database.SQLite.Simple.FromField (FieldParser, returnError)
+import Database.SQLite.Simple.Internal (Field (..))
+import Database.SQLite.Simple.Ok (Ok (Ok))
+import Simplex.Messaging.Util (safeDecodeUtf8)
+
+encodeJSON :: ToJSON a => a -> Text
+encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
+
+decodeJSON :: FromJSON a => Text -> Maybe a
+decodeJSON = J.decode . LB.fromStrict . encodeUtf8
+
+fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k
+fromBlobField_ p = \case
+  f@(Field (SQLBlob b) _) ->
+    case p b of
+      Right k -> Ok k
+      Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
+  f -> returnError ConversionFailed f "expecting SQLBlob column type"

src/Simplex/Chat/View.hs

@@ -42,6 +42,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import qualified Simplex.FileTransfer.Protocol as XFTP
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
 import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))

tests/ChatTests/Utils.hs

@@ -20,6 +20,7 @@ import qualified Data.Text as T
 import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig)
 import Simplex.Chat.Store.Profiles (getUserContactProfiles)
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Store.SQLite (withTransaction)
 import Simplex.Messaging.Encoding.String
 import System.Directory (doesFileExist)

tests/ProtocolTests.hs

@@ -10,6 +10,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
+import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet