mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: chat preference for audio/video calls (#2188)
* core: chat preference for audio/video calls * correction Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * clean up --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
committed by
GitHub
parent
5b4c183466
commit
b6876712f0
@@ -21,7 +21,7 @@ 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, decodeJSON, encodeJSON, User)
|
||||
import Simplex.Chat.Types (Contact, ContactId, User, decodeJSON, encodeJSON)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
|
||||
|
||||
+39
-10
@@ -343,12 +343,14 @@ data ChatFeature
|
||||
| CFFullDelete
|
||||
| -- | CFReceipts
|
||||
CFVoice
|
||||
| CFCalls
|
||||
deriving (Show, Generic)
|
||||
|
||||
data SChatFeature (f :: ChatFeature) where
|
||||
SCFTimedMessages :: SChatFeature 'CFTimedMessages
|
||||
SCFFullDelete :: SChatFeature 'CFFullDelete
|
||||
SCFVoice :: SChatFeature 'CFVoice
|
||||
SCFCalls :: SChatFeature 'CFCalls
|
||||
|
||||
deriving instance Show (SChatFeature f)
|
||||
|
||||
@@ -361,6 +363,7 @@ chatFeatureNameText = \case
|
||||
CFTimedMessages -> "Disappearing messages"
|
||||
CFFullDelete -> "Full deletion"
|
||||
CFVoice -> "Voice messages"
|
||||
CFCalls -> "Audio/video calls"
|
||||
|
||||
chatFeatureNameText' :: SChatFeature f -> Text
|
||||
chatFeatureNameText' = chatFeatureNameText . chatFeature
|
||||
@@ -382,7 +385,8 @@ allChatFeatures =
|
||||
[ ACF SCFTimedMessages,
|
||||
ACF SCFFullDelete,
|
||||
-- CFReceipts,
|
||||
ACF SCFVoice
|
||||
ACF SCFVoice,
|
||||
ACF SCFCalls
|
||||
]
|
||||
|
||||
chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
|
||||
@@ -391,12 +395,14 @@ chatPrefSel = \case
|
||||
SCFFullDelete -> fullDelete
|
||||
-- CFReceipts -> receipts
|
||||
SCFVoice -> voice
|
||||
SCFCalls -> calls
|
||||
|
||||
chatFeature :: SChatFeature f -> ChatFeature
|
||||
chatFeature = \case
|
||||
SCFTimedMessages -> CFTimedMessages
|
||||
SCFFullDelete -> CFFullDelete
|
||||
SCFVoice -> CFVoice
|
||||
SCFCalls -> CFCalls
|
||||
|
||||
class PreferenceI p where
|
||||
getPreference :: SChatFeature f -> p -> FeaturePreference f
|
||||
@@ -413,6 +419,7 @@ instance PreferenceI FullPreferences where
|
||||
SCFFullDelete -> fullDelete
|
||||
-- CFReceipts -> receipts
|
||||
SCFVoice -> voice
|
||||
SCFCalls -> calls
|
||||
{-# INLINE getPreference #-}
|
||||
|
||||
setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
|
||||
@@ -432,13 +439,15 @@ setPreference_ f pref_ prefs =
|
||||
SCFTimedMessages -> prefs {timedMessages = pref_}
|
||||
SCFFullDelete -> prefs {fullDelete = 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,
|
||||
-- receipts :: Maybe SimplePreference,
|
||||
voice :: Maybe VoicePreference
|
||||
voice :: Maybe VoicePreference,
|
||||
calls :: Maybe CallsPreference
|
||||
}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
@@ -591,7 +600,8 @@ data FullPreferences = FullPreferences
|
||||
{ timedMessages :: TimedMessagesPreference,
|
||||
fullDelete :: FullDeletePreference,
|
||||
-- receipts :: SimplePreference,
|
||||
voice :: VoicePreference
|
||||
voice :: VoicePreference,
|
||||
calls :: CallsPreference
|
||||
}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
@@ -615,7 +625,8 @@ data ContactUserPreferences = ContactUserPreferences
|
||||
{ timedMessages :: ContactUserPreference TimedMessagesPreference,
|
||||
fullDelete :: ContactUserPreference FullDeletePreference,
|
||||
-- receipts :: ContactUserPreference,
|
||||
voice :: ContactUserPreference VoicePreference
|
||||
voice :: ContactUserPreference VoicePreference,
|
||||
calls :: ContactUserPreference CallsPreference
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
@@ -638,12 +649,13 @@ instance ToJSON p => ToJSON (ContactUserPref p) where
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CUP"
|
||||
|
||||
toChatPrefs :: FullPreferences -> Preferences
|
||||
toChatPrefs FullPreferences {fullDelete, voice, timedMessages} =
|
||||
toChatPrefs FullPreferences {fullDelete, voice, timedMessages, calls} =
|
||||
Preferences
|
||||
{ timedMessages = Just timedMessages,
|
||||
fullDelete = Just fullDelete,
|
||||
-- receipts = Just receipts,
|
||||
voice = Just voice
|
||||
voice = Just voice,
|
||||
calls = Just calls
|
||||
}
|
||||
|
||||
defaultChatPrefs :: FullPreferences
|
||||
@@ -652,11 +664,12 @@ defaultChatPrefs =
|
||||
{ timedMessages = TimedMessagesPreference {allow = FANo, ttl = Nothing},
|
||||
fullDelete = FullDeletePreference {allow = FANo},
|
||||
-- receipts = SimplePreference {allow = FANo},
|
||||
voice = VoicePreference {allow = FAYes}
|
||||
voice = VoicePreference {allow = FAYes},
|
||||
calls = CallsPreference {allow = FAYes}
|
||||
}
|
||||
|
||||
emptyChatPrefs :: Preferences
|
||||
emptyChatPrefs = Preferences Nothing Nothing Nothing
|
||||
emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing
|
||||
|
||||
defaultGroupPrefs :: FullGroupPreferences
|
||||
defaultGroupPrefs =
|
||||
@@ -691,6 +704,11 @@ data VoicePreference = VoicePreference {allow :: FeatureAllowed}
|
||||
|
||||
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
|
||||
@@ -705,6 +723,9 @@ instance HasField "allow" FullDeletePreference FeatureAllowed where
|
||||
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
|
||||
@@ -720,6 +741,11 @@ instance FeatureI 'CFVoice where
|
||||
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)
|
||||
@@ -897,7 +923,8 @@ mergePreferences contactPrefs userPreferences =
|
||||
{ timedMessages = pref SCFTimedMessages,
|
||||
fullDelete = pref SCFFullDelete,
|
||||
-- receipts = pref CFReceipts,
|
||||
voice = pref SCFVoice
|
||||
voice = pref SCFVoice,
|
||||
calls = pref SCFCalls
|
||||
}
|
||||
where
|
||||
pref :: SChatFeature f -> FeaturePreference f
|
||||
@@ -1006,7 +1033,8 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit
|
||||
{ timedMessages = pref SCFTimedMessages,
|
||||
fullDelete = pref SCFFullDelete,
|
||||
-- receipts = pref CFReceipts,
|
||||
voice = pref SCFVoice
|
||||
voice = pref SCFVoice,
|
||||
calls = pref SCFCalls
|
||||
}
|
||||
where
|
||||
pref :: FeatureI f => SChatFeature f -> ContactUserPreference (FeaturePreference f)
|
||||
@@ -1033,6 +1061,7 @@ getContactUserPreference = \case
|
||||
SCFFullDelete -> fullDelete
|
||||
-- CFReceipts -> receipts
|
||||
SCFVoice -> voice
|
||||
SCFCalls -> calls
|
||||
|
||||
data Profile = Profile
|
||||
{ displayName :: ContactName,
|
||||
|
||||
Reference in New Issue
Block a user