core: fix group preferences update (#1385)

src/Simplex/Chat/Store.hs

@@ -3673,14 +3673,15 @@ updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> Exce
 updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, image, groupPreferences}
   | displayName == newName = liftIO $ do
     currentTs <- getCurrentTime
-    updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
+    updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p', fullGroupPreferences}
   | otherwise =
     ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
       currentTs <- getCurrentTime
       updateGroupProfile_ currentTs
       updateGroup_ ldn currentTs
-      pure . Right $ (g :: GroupInfo) {localDisplayName = ldn, groupProfile = p'}
+      pure . Right $ (g :: GroupInfo) {localDisplayName = ldn, groupProfile = p', fullGroupPreferences}
   where
+    fullGroupPreferences = mergeGroupPreferences groupPreferences
     updateGroupProfile_ currentTs =
       DB.execute
         db

src/Simplex/Chat/View.hs

@@ -785,15 +785,36 @@ viewPrefEnabled = \case
 
 viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> [StyledString]
 viewGroupUpdated
-  GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, image}}
-  g'@GroupInfo {localDisplayName = n', groupProfile = GroupProfile {fullName = fullName', image = image'}}
-  m
-    | n == n' && fullName == fullName' && image == image' = []
-    | n == n' && fullName == fullName' = ["group " <> ttyGroup n <> ": profile image " <> (if isNothing image' then "removed" else "updated") <> byMember]
-    | n == n' = ["group " <> ttyGroup n <> ": full name " <> if T.null fullName' || fullName' == n' then "removed" else "changed to " <> plain fullName' <> byMember]
-    | otherwise = ["group " <> ttyGroup n <> " is changed to " <> ttyFullGroup g' <> byMember]
+  GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, image, groupPreferences = gps}}
+  g'@GroupInfo {localDisplayName = n', groupProfile = GroupProfile {fullName = fullName', image = image', groupPreferences = gps'}}
+  m = do
+    let update = groupProfileUpdated <> groupPrefsUpdated
+    if null update
+      then []
+      else memberUpdated <> update
     where
-      byMember = maybe "" ((" by " <>) . ttyMember) m
+      memberUpdated = maybe [] (\m' -> [ttyMember m' <> " updated group " <> ttyGroup n <> ":"]) m
+      groupProfileUpdated
+        | n == n' && fullName == fullName' && image == image' = []
+        | n == n' && fullName == fullName' = ["profile image " <> (if isNothing image' then "removed" else "updated")]
+        | n == n' = ["full name " <> if T.null fullName' || fullName' == n' then "removed" else "changed to " <> plain fullName']
+        | otherwise = ["changed to " <> ttyFullGroup g']
+      groupPrefsUpdated
+        | null prefs = []
+        | otherwise = "updated group preferences:" : prefs
+        where
+          prefs = mapMaybe viewPref allChatFeatures
+          viewPref pt
+            | pref gps == pref gps' = Nothing
+            | otherwise = Just $ plain (chatPrefName pt) <> " enabled: " <> viewGroupPreference (pref gps')
+            where
+              pref pss = getGroupPreference pt $ mergeGroupPreferences pss
+
+viewGroupPreference :: GroupPreference -> StyledString
+viewGroupPreference = \case
+  GroupPreference {enable} -> case enable of
+    FEOn -> "on"
+    FEOff -> "off"
 
 viewContactAliasUpdated :: Contact -> [StyledString]
 viewContactAliasUpdated Contact {localDisplayName = n, profile = LocalProfile {localAlias}}

tests/ChatTests.hs

@@ -112,10 +112,12 @@ chatTests = do
     it "join group incognito" testJoinGroupIncognito
     it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito
     it "can't see global preferences update" testCantSeeGlobalPrefsUpdateIncognito
-  describe "contact aliases and prefs" $ do
+  describe "contact aliases" $ do
     it "set contact alias" testSetAlias
     it "set connection alias" testSetConnectionAlias
-    it "set contact prefs" testSetContactPrefs
+  describe "preferences" $ do
+    it "set contact preferences" testSetContactPrefs
+    it "update group preferences" testUpdateGroupPrefs
   describe "SMP servers" $ do
     it "get and set SMP servers" testGetSetSMPServers
     it "test SMP server connection" testTestSMPServerConnection
@@ -1298,10 +1300,15 @@ testUpdateGroupProfile =
       bob ##> "/gp team my_team"
       bob <## "you have insufficient permissions for this group command"
       alice ##> "/gp team my_team"
-      alice <## "group #team is changed to #my_team"
-      concurrently_
-        (bob <## "group #team is changed to #my_team by alice")
-        (cath <## "group #team is changed to #my_team by alice")
+      alice <## "changed to #my_team"
+      concurrentlyN_
+        [ do
+            bob <## "alice updated group #team:"
+            bob <## "changed to #my_team",
+          do
+            cath <## "alice updated group #team:"
+            cath <## "changed to #my_team"
+        ]
       bob #> "#my_team hi"
       concurrently_
         (alice <# "#my_team bob> hi")
@@ -2863,6 +2870,38 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
     bob <## "alice updated preferences for you:"
     bob <## "full message deletion: off (you allow: default (yes), contact allows: no)"
 
+testUpdateGroupPrefs :: IO ()
+testUpdateGroupPrefs =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      createGroup2 "team" alice bob
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}}}"
+      alice <## "updated group preferences:"
+      alice <## "full message deletion enabled: on"
+      bob <## "alice updated group #team:"
+      bob <## "updated group preferences:"
+      bob <## "full message deletion enabled: on"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}}}"
+      alice <## "updated group preferences:"
+      alice <## "full message deletion enabled: off"
+      alice <## "voice messages enabled: off"
+      bob <## "alice updated group #team:"
+      bob <## "updated group preferences:"
+      bob <## "full message deletion enabled: off"
+      bob <## "voice messages enabled: off"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
+      alice <## "updated group preferences:"
+      alice <## "voice messages enabled: on"
+      bob <## "alice updated group #team:"
+      bob <## "updated group preferences:"
+      bob <## "voice messages enabled: on"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
+      -- no update
+      alice #> "#team hey"
+      bob <# "#team alice> hey"
+      bob #> "#team hi"
+      alice <# "#team bob> hi"
+
 testGetSetSMPServers :: IO ()
 testGetSetSMPServers =
   testChat2 aliceProfile bobProfile $