dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-13 04:15:43 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: timed messages terminal api, tests (#1591)

Browse Source
This commit is contained in:
JRoberts
2022-12-17 14:49:03 +04:00
committed by GitHub
parent b4de9c266b
commit f128ebac87
4 changed files with 132 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+16
View File
@@ -4,6 +4,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
@@ -267,6 +268,9 @@ data ChatCommand
| SetUserFeature AChatFeature FeatureAllowed
| SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)
| SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled
| SetUserTimedMessages Bool
| SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
| SetGroupTimedMessages GroupName (Maybe Int)
| QuitChat
| ShowVersion
| DebugLocks
@@ -512,6 +516,18 @@ data ServerAddress = ServerAddress
instance ToJSON ServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
data TimedMessagesEnabled
= TMEEnableSetTTL Int
| TMEEnableKeepTTL
| TMEDisableKeepTTL
deriving (Show)
tmeToPref :: Maybe Int -> TimedMessagesEnabled -> TimedMessagesPreference
tmeToPref currentTTL tme = uncurry TimedMessagesPreference $ case tme of
TMEEnableSetTTL ttl -> (FAYes, Just ttl)
TMEEnableKeepTTL -> (FAYes, currentTTL)
TMEDisableKeepTTL -> (FANo, currentTTL)
data ChatError
= ChatError {errorType :: ChatErrorType}
| ChatErrorAgent {agentError :: AgentErrorType}
src/Simplex/Chat/Types.hs
+31 -9
View File
@@ -338,17 +338,25 @@ instance PreferenceI FullPreferences where
{-# INLINE getPreference #-}
setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
setPreference f allow_ prefs_ =
let pref = setAllow <$> allow_
in case f of
SCFTimedMessages -> prefs {timedMessages = pref}
SCFFullDelete -> prefs {fullDelete = pref}
SCFVoice -> prefs {voice = pref}
setPreference f allow_ prefs_ = setPreference_ f pref prefs
where
pref = setAllow <$> allow_
setAllow :: FeatureAllowed -> FeaturePreference f
setAllow = setField @"allow" (getPreference f prefs)
prefs = toChatPrefs $ mergePreferences Nothing prefs_
setPreference' :: SChatFeature f -> Maybe (FeaturePreference f) -> Maybe Preferences -> Preferences
setPreference' f pref_ prefs_ = setPreference_ f pref_ prefs
where
prefs = toChatPrefs $ mergePreferences Nothing prefs_
setPreference_ :: SChatFeature f -> Maybe (FeaturePreference f) -> Preferences -> Preferences
setPreference_ f pref_ prefs =
case f of
SCFTimedMessages -> prefs {timedMessages = pref_}
SCFFullDelete -> prefs {fullDelete = pref_}
SCFVoice -> prefs {voice = pref_}
-- collection of optional chat preferences for the user and the contact
data Preferences = Preferences
{ timedMessages :: Maybe TimedMessagesPreference,
@@ -473,16 +481,30 @@ instance FromField GroupPreferences where
fromField = fromTextField_ decodeJSON
setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
setGroupPreference f enable prefs_ =
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}
SGFVoice -> prefs {voice = pref}
SGFFullDelete -> prefs {fullDelete = pref}
setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
setGroupTimedMessagesPreference pref prefs_ =
toGroupPreferences $ prefs {timedMessages = pref}
where
prefs = mergeGroupPreferences prefs_
pref :: GroupFeaturePreference f
pref = setField @"enable" (getGroupPreference f prefs) enable
-- 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.