blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

group history preference

Browse Source
This commit is contained in:
spaced4ndy
2023-12-21 15:23:14 +04:00
parent ca3ba1c121
commit f90d4ad8fa
5 changed files with 121 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+8 -2
View File
@@ -3571,7 +3571,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
members <- withStore' $ \db -> getGroupMembers db user gInfo
void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
sendIntroductions members
sendHistory
when (groupFeatureAllowed SGFHistory gInfo) sendHistory
where
sendXGrpLinkMem = do
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
@@ -6352,6 +6352,7 @@ chatCommandP =
"/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
"/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
"/set files #" *> (SetGroupFeature (AGF SGFFiles) <$> displayName <*> (A.space *> strP)),
"/set history #" *> (SetGroupFeature (AGF SGFHistory) <$> displayName <*> (A.space *> strP)),
"/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)),
"/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP),
"/set delete #" *> (SetGroupFeature (AGF SGFFullDelete) <$> displayName <*> (A.space *> strP)),
@@ -6439,7 +6440,12 @@ chatCommandP =
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
groupProfile = do
(gName, fullName) <- profileNames
let groupPreferences = Just (emptyGroupPrefs :: GroupPreferences) {directMessages = Just DirectMessagesGroupPreference {enable = FEOn}}
let groupPreferences =
Just
(emptyGroupPrefs :: GroupPreferences)
{ directMessages = Just DirectMessagesGroupPreference {enable = FEOn},
history = Just HistoryGroupPreference {enable = FEOn}
}
pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences}
fullNameP = A.space *> textP <|> pure ""
textP = safeDecodeUtf8 <$> A.takeByteString
src/Simplex/Chat/Help.hs
+2 -1
View File
@@ -155,7 +155,8 @@ groupsHelpInfo =
"",
green "Group chat preferences:",
indent <> highlight "/set voice #<group> on/off " <> " - enable/disable voice messages",
-- indent <> highlight "/set files #<group> on/off " <> " - enable/disable files and media (other than voice)",
indent <> highlight "/set files #<group> on/off " <> " - enable/disable files and media (other than voice)",
indent <> highlight "/set history #<group> on/off " <> " - enable/disable sending recent history to new members",
indent <> highlight "/set delete #<group> on/off " <> " - enable/disable full message deletion",
indent <> highlight "/set direct #<group> on/off " <> " - enable/disable direct messages to other members",
indent <> highlight "/set disappear #<group> on <time> " <> " - enable disappearing messages with <time>:",
src/Simplex/Chat/Types/Preferences.hs
+34 -7
View File
@@ -149,6 +149,7 @@ data GroupFeature
| GFReactions
| GFVoice
| GFFiles
| GFHistory
deriving (Show)
data SGroupFeature (f :: GroupFeature) where
@@ -158,6 +159,7 @@ data SGroupFeature (f :: GroupFeature) where
SGFReactions :: SGroupFeature 'GFReactions
SGFVoice :: SGroupFeature 'GFVoice
SGFFiles :: SGroupFeature 'GFFiles
SGFHistory :: SGroupFeature 'GFHistory
deriving instance Show (SGroupFeature f)
@@ -173,6 +175,7 @@ groupFeatureNameText = \case
GFReactions -> "Message reactions"
GFVoice -> "Voice messages"
GFFiles -> "Files and media"
GFHistory -> "History"
groupFeatureNameText' :: SGroupFeature f -> Text
groupFeatureNameText' = groupFeatureNameText . toGroupFeature
@@ -188,7 +191,8 @@ allGroupFeatures =
AGF SGFFullDelete,
AGF SGFReactions,
AGF SGFVoice,
AGF SGFFiles
AGF SGFFiles,
AGF SGFHistory
]
groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
@@ -199,6 +203,7 @@ groupPrefSel f ps = case f of
SGFReactions -> ps.reactions
SGFVoice -> ps.voice
SGFFiles -> ps.files
SGFHistory -> ps.history
toGroupFeature :: SGroupFeature f -> GroupFeature
toGroupFeature = \case
@@ -208,6 +213,7 @@ toGroupFeature = \case
SGFReactions -> GFReactions
SGFVoice -> GFVoice
SGFFiles -> GFFiles
SGFHistory -> GFHistory
class GroupPreferenceI p where
getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
@@ -226,6 +232,7 @@ instance GroupPreferenceI FullGroupPreferences where
SGFReactions -> ps.reactions
SGFVoice -> ps.voice
SGFFiles -> ps.files
SGFHistory -> ps.history
{-# INLINE getGroupPreference #-}
-- collection of optional group preferences
@@ -235,7 +242,8 @@ data GroupPreferences = GroupPreferences
fullDelete :: Maybe FullDeleteGroupPreference,
reactions :: Maybe ReactionsGroupPreference,
voice :: Maybe VoiceGroupPreference,
files :: Maybe FilesGroupPreference
files :: Maybe FilesGroupPreference,
history :: Maybe HistoryGroupPreference
}
deriving (Eq, Show)
@@ -260,6 +268,7 @@ setGroupPreference_ f pref prefs =
SGFReactions -> prefs {reactions = pref}
SGFVoice -> prefs {voice = pref}
SGFFiles -> prefs {files = pref}
SGFHistory -> prefs {history = pref}
setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
setGroupTimedMessagesPreference pref prefs_ =
@@ -286,7 +295,8 @@ data FullGroupPreferences = FullGroupPreferences
fullDelete :: FullDeleteGroupPreference,
reactions :: ReactionsGroupPreference,
voice :: VoiceGroupPreference,
files :: FilesGroupPreference
files :: FilesGroupPreference,
history :: HistoryGroupPreference
}
deriving (Eq, Show)
@@ -341,11 +351,12 @@ defaultGroupPrefs =
fullDelete = FullDeleteGroupPreference {enable = FEOff},
reactions = ReactionsGroupPreference {enable = FEOn},
voice = VoiceGroupPreference {enable = FEOn},
files = FilesGroupPreference {enable = FEOn}
files = FilesGroupPreference {enable = FEOn},
history = HistoryGroupPreference {enable = FEOff}
}
emptyGroupPrefs :: GroupPreferences
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data TimedMessagesPreference = TimedMessagesPreference
{ allow :: FeatureAllowed,
@@ -440,6 +451,10 @@ data FilesGroupPreference = FilesGroupPreference
{enable :: GroupFeatureEnabled}
deriving (Eq, Show)
data HistoryGroupPreference = HistoryGroupPreference
{enable :: GroupFeatureEnabled}
deriving (Eq, Show)
class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
sGroupFeature :: SGroupFeature f
@@ -466,6 +481,9 @@ instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
hasField p = (\enable -> p {enable}, p.enable)
instance GroupFeatureI 'GFTimedMessages where
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
sGroupFeature = SGFTimedMessages
@@ -496,6 +514,11 @@ instance GroupFeatureI 'GFFiles where
sGroupFeature = SGFFiles
groupPrefParam _ = Nothing
instance GroupFeatureI 'GFHistory where
type GroupFeaturePreference 'GFHistory = HistoryGroupPreference
sGroupFeature = SGFHistory
groupPrefParam _ = Nothing
groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
groupPrefStateText feature pref param =
let enabled = getField @"enable" pref
@@ -618,7 +641,8 @@ mergeGroupPreferences groupPreferences =
fullDelete = pref SGFFullDelete,
reactions = pref SGFReactions,
voice = pref SGFVoice,
files = pref SGFFiles
files = pref SGFFiles,
history = pref SGFHistory
}
where
pref :: SGroupFeature f -> GroupFeaturePreference f
@@ -632,7 +656,8 @@ toGroupPreferences groupPreferences =
fullDelete = pref SGFFullDelete,
reactions = pref SGFReactions,
voice = pref SGFVoice,
files = pref SGFFiles
files = pref SGFFiles,
history = pref SGFHistory
}
where
pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
@@ -738,6 +763,8 @@ $(J.deriveJSON defaultJSON ''VoiceGroupPreference)
$(J.deriveJSON defaultJSON ''FilesGroupPreference)
$(J.deriveJSON defaultJSON ''HistoryGroupPreference)
$(J.deriveJSON defaultJSON ''GroupPreferences)
instance ToField GroupPreferences where
tests/ChatTests/Groups.hs
+76
View File
@@ -117,6 +117,7 @@ chatGroupTests = do
it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember
describe "group history" $ do
it "text messages" testGroupHistory
fit "history is not sent if preference is disabled" testGroupHistoryPreferenceOff
it "host's file" testGroupHistoryHostFile
it "member's file" testGroupHistoryMemberFile
it "large file with text" testGroupHistoryLargeFile
@@ -4172,6 +4173,81 @@ testGroupHistory =
cath #> "#team 3"
[alice, bob] *<# "#team cath> 3"
testGroupHistoryPreferenceOff :: HasCallStack => FilePath -> IO ()
testGroupHistoryPreferenceOff =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
createGroup2 "team" alice bob
threadDelay 1000000
alice #> "#team hello"
bob <# "#team alice> hello"
threadDelay 1000000
bob #> "#team hey!"
alice <# "#team bob> hey!"
connectUsers alice cath
addMember "team" alice cath GRAdmin
cath ##> "/j team"
concurrentlyN_
[ alice <## "#team: cath joined the group",
cath
<### [ "#team: you joined the group",
WithTime "#team alice> hello [>>]",
WithTime "#team bob> hey! [>>]",
"#team: member bob (Bob) is connected"
],
do
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
bob <## "#team: new member cath is connected"
]
cath ##> "/_get chat #1 count=100"
r <- chat <$> getTermLine cath
r `shouldContain` [(0, "hello"), (0, "hey!")]
alice ##> "/set history #team off"
alice <## "updated group preferences:"
alice <## "History: off"
concurrentlyN_
[ do
bob <## "alice updated group #team:"
bob <## "updated group preferences:"
bob <## "History: off",
do
cath <## "alice updated group #team:"
cath <## "updated group preferences:"
cath <## "History: off"
]
connectUsers alice dan
addMember "team" alice dan GRAdmin
dan ##> "/j team"
concurrentlyN_
[ alice <## "#team: dan joined the group",
do
dan <## "#team: you joined the group"
dan
<### [ "#team: member bob (Bob) is connected",
"#team: member cath (Catherine) is connected"
],
aliceAddedDan bob,
aliceAddedDan cath
]
dan ##> "/_get chat #1 count=100"
r' <- chat <$> getTermLine dan
r' `shouldNotContain` [(0, "hello")]
r' `shouldNotContain` [(0, "hey!")]
where
aliceAddedDan :: HasCallStack => TestCC -> IO ()
aliceAddedDan cc = do
cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
cc <## "#team: new member dan is connected"
testGroupHistoryHostFile :: HasCallStack => FilePath -> IO ()
testGroupHistoryHostFile =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
tests/ProtocolTests.hs
+1 -1
View File
@@ -98,7 +98,7 @@ testChatPreferences :: Maybe Preferences
testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}}
testGroupPreferences :: Maybe GroupPreferences
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing}
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing, history = Nothing}
testProfile :: Profile
testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), contactLink = Nothing, preferences = testChatPreferences}