core: type for group preference for timed messages (#1568)

* core: type for group preference for timed messages

* remove unused func

src/Simplex/Chat.hs

@@ -341,7 +341,7 @@ processChatCommand = \case
     CTGroup -> do
       Group gInfo@GroupInfo {membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
       unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
-      if isVoice mc && not (groupFeatureAllowed GFVoice gInfo)
+      if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
         then pure $ chatCmdError $ "feature not allowed " <> T.unpack (groupFeatureToText GFVoice)
         else do
           (fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
@@ -467,7 +467,7 @@ processChatCommand = \case
         (CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
           SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgDel itemSharedMId)
           setActive $ ActiveG gName
-          if groupFeatureAllowed GFFullDelete gInfo
+          if groupFeatureAllowed SGFFullDelete gInfo
             then deleteGroupCI user gInfo ci True
             else markGroupCIDeleted user gInfo ci msgId True
         (CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
@@ -1113,16 +1113,14 @@ processChatCommand = \case
   UpdateProfileImage image -> withUser $ \user@User {profile} -> do
     let p = (fromLocalProfile profile :: Profile) {image}
     updateProfile user p
-  SetUserFeature cf allowed -> withUser $ \user@User {profile} -> do
-    ACF f <- pure $ aChatFeature cf
+  SetUserFeature (ACF f) allowed -> withUser $ \user@User {profile} -> do
     let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user}
     updateProfile user p
-  SetContactFeature cf cName allowed_ -> withUser $ \user -> do
+  SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do
     ct@Contact {userPreferences} <- withStore $ \db -> getContactByName db user cName
-    ACF f <- pure $ aChatFeature cf
     let prefs' = setPreference f allowed_ $ Just userPreferences
     updateContactPrefs user ct prefs'
-  SetGroupFeature f gName enabled ->
+  SetGroupFeature (AGF f) gName enabled ->
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference f enabled $ groupPreferences p}
   QuitChat -> liftIO exitSuccess
@@ -1322,7 +1320,7 @@ assertDirectAllowed user dir ct event =
   unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $
     throwChatError $ CEDirectMessagesProhibited dir ct
   where
-    directMessagesAllowed = any (groupFeatureAllowed' GFDirectMessages) <$> withStore' (\db -> getContactGroupPreferences db user ct)
+    directMessagesAllowed = any (groupFeatureAllowed' SGFDirectMessages) <$> withStore' (\db -> getContactGroupPreferences db user ct)
     allowedChatEvent = case event of
       XMsgNew_ -> False
       XMsgUpdate_ -> False
@@ -2374,7 +2372,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
     newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
     newGroupContentMessage gInfo@GroupInfo {chatSettings} m@GroupMember {localDisplayName = c} mc msg msgMeta = do
       let (ExtMsgContent content fInv_) = mcExtMsgContent mc
-      if isVoice content && not (groupFeatureAllowed GFVoice gInfo)
+      if isVoice content && not (groupFeatureAllowed SGFVoice gInfo)
         then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing
         else do
           ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
@@ -2421,7 +2419,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
         (SMDRcv, CIGroupRcv m) ->
           if sameMemberId memberId m
             then
-              if groupFeatureAllowed GFFullDelete gInfo
+              if groupFeatureAllowed SGFFullDelete gInfo
                 then deleteGroupCI user gInfo ci False >>= toView
                 else markGroupCIDeleted user gInfo ci msgId False >>= toView
             else messageError "x.msg.del: group member attempted to delete a message of another member" -- shouldn't happen now that query includes group member id
@@ -2630,9 +2628,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
     createGroupFeatureItems :: GroupInfo -> GroupMember -> m ()
     createGroupFeatureItems g@GroupInfo {groupProfile} m = do
       let prefs = mergeGroupPreferences $ groupPreferences groupProfile
-      forM_ allGroupFeatures $ \f -> do
+      forM_ allGroupFeatures $ \(AGF f) -> do
         let p = getGroupPreference f prefs
-        createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature f p) Nothing
+        createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p)) Nothing
 
     xInfoProbe :: Contact -> Probe -> m ()
     xInfoProbe c2 probe =
@@ -3254,11 +3252,11 @@ createFeatureChangedItems user Contact {mergedPreferences = cups} ct'@Contact {m
 
 createGroupFeatureChangedItems :: (MsgDirectionI d, ChatMonad m) => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> CIContent d) -> GroupProfile -> GroupProfile -> m ()
 createGroupFeatureChangedItems user cd ciContent p p' =
-  forM_ allGroupFeatures $ \f -> do
+  forM_ allGroupFeatures $ \(AGF f) -> do
     let pref = getGroupPreference f $ groupPreferences p
         pref' = getGroupPreference f $ groupPreferences p'
     unless (pref == pref') $
-      createInternalChatItem user cd (ciContent f pref') Nothing
+      createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref')) Nothing
 
 sameGroupProfileInfo :: GroupProfile -> GroupProfile -> Bool
 sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferences = Nothing}
@@ -3532,13 +3530,13 @@ chatCommandP =
       "/profile_image" $> UpdateProfileImage Nothing,
       ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> userNames),
       ("/profile" <|> "/p") $> ShowProfile,
-      "/set voice #" *> (SetGroupFeature GFVoice <$> displayName <*> (A.space *> strP)),
-      "/set voice @" *> (SetContactFeature CFVoice <$> displayName <*> optional (A.space *> strP)),
-      "/set voice " *> (SetUserFeature CFVoice <$> strP),
-      "/set delete #" *> (SetGroupFeature GFFullDelete <$> displayName <*> (A.space *> strP)),
-      "/set delete @" *> (SetContactFeature CFFullDelete <$> displayName <*> optional (A.space *> strP)),
-      "/set delete " *> (SetUserFeature CFFullDelete <$> strP),
-      "/set direct #" *> (SetGroupFeature GFDirectMessages <$> displayName <*> (A.space *> strP)),
+      "/set voice #" *> (SetGroupFeature (AGF SGFVoice) <$> displayName <*> (A.space *> strP)),
+      "/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
+      "/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
+      "/set delete #" *> (SetGroupFeature (AGF SGFFullDelete) <$> displayName <*> (A.space *> strP)),
+      "/set delete @" *> (SetContactFeature (ACF SCFFullDelete) <$> displayName <*> optional (A.space *> strP)),
+      "/set delete " *> (SetUserFeature (ACF SCFFullDelete) <$> strP),
+      "/set direct #" *> (SetGroupFeature (AGF SGFDirectMessages) <$> displayName <*> (A.space *> strP)),
       "/incognito " *> (SetIncognito <$> onOffP),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,
@@ -3573,7 +3571,7 @@ chatCommandP =
     groupProfile = do
       gName <- displayName
       fullName <- fullNameP gName
-      let groupPreferences = Just (emptyGroupPrefs :: GroupPreferences) {directMessages = Just GroupPreference {enable = FEOn}}
+      let groupPreferences = Just (emptyGroupPrefs :: GroupPreferences) {directMessages = Just DirectMessagesGroupPreference {enable = FEOn}}
       pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences}
     fullNameP name = do
       n <- (A.space *> A.takeByteString) <|> pure ""

src/Simplex/Chat/Controller.hs

@@ -260,9 +260,9 @@ data ChatCommand
   | ShowProfile
   | UpdateProfile ContactName Text
   | UpdateProfileImage (Maybe ImageData)
-  | SetUserFeature ChatFeature FeatureAllowed
-  | SetContactFeature ChatFeature ContactName (Maybe FeatureAllowed)
-  | SetGroupFeature GroupFeature GroupName GroupFeatureEnabled
+  | SetUserFeature AChatFeature FeatureAllowed
+  | SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)
+  | SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled
   | QuitChat
   | ShowVersion
   | DebugLocks

src/Simplex/Chat/Types.hs

@@ -13,6 +13,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
@@ -274,8 +275,12 @@ data SChatFeature (f :: ChatFeature) where
   SCFFullDelete :: SChatFeature 'CFFullDelete
   SCFVoice :: SChatFeature 'CFVoice
 
+deriving instance Show (SChatFeature f)
+
 data AChatFeature = forall f. FeatureI f => ACF (SChatFeature f)
 
+deriving instance Show AChatFeature
+
 chatFeatureToText :: ChatFeature -> Text
 chatFeatureToText = \case
   CFTimedMessages -> "Disappearing messages"
@@ -315,12 +320,6 @@ chatFeature = \case
   SCFFullDelete -> CFFullDelete
   SCFVoice -> CFVoice
 
-aChatFeature :: ChatFeature -> AChatFeature
-aChatFeature = \case
-  CFTimedMessages -> ACF SCFTimedMessages
-  CFFullDelete -> ACF SCFFullDelete
-  CFVoice -> ACF SCFVoice
-
 class PreferenceI p where
   getPreference :: SChatFeature f -> p -> FeaturePreference f
 
@@ -370,25 +369,39 @@ instance FromField Preferences where
   fromField = fromTextField_ decodeJSON
 
 data GroupFeature
-  = GFDirectMessages
+  = GFTimedMessages
+  | GFDirectMessages
   | GFFullDelete
   | -- | GFReceipts
     GFVoice
   deriving (Show, Generic)
 
+data SGroupFeature (f :: GroupFeature) where
+  SGFTimedMessages :: SGroupFeature 'GFTimedMessages
+  SGFDirectMessages :: SGroupFeature 'GFDirectMessages
+  SGFFullDelete :: SGroupFeature 'GFFullDelete
+  -- SGFReceipts
+  SGFVoice :: SGroupFeature 'GFVoice
+
+deriving instance Show (SGroupFeature f)
+
+data AGroupFeature = forall f. GroupFeatureI f => AGF (SGroupFeature f)
+
+deriving instance Show AGroupFeature
+
 groupFeatureToText :: GroupFeature -> Text
 groupFeatureToText = \case
+  GFTimedMessages -> "Disappearing messages"
   GFDirectMessages -> "Direct messages"
   GFFullDelete -> "Full deletion"
   GFVoice -> "Voice messages"
 
-groupFeatureAllowed :: GroupFeature -> GroupInfo -> Bool
+groupFeatureAllowed :: GroupFeatureI f => SGroupFeature f -> GroupInfo -> Bool
 groupFeatureAllowed feature gInfo = groupFeatureAllowed' feature $ fullGroupPreferences gInfo
 
-groupFeatureAllowed' :: GroupFeature -> FullGroupPreferences -> Bool
+groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferences -> Bool
 groupFeatureAllowed' feature prefs =
-  let GroupPreference {enable} = getGroupPreference feature prefs
-   in enable == FEOn
+  getField @"enable" (getGroupPreference feature prefs) == FEOn
 
 instance ToJSON GroupFeature where
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "GF"
@@ -397,23 +410,32 @@ instance ToJSON GroupFeature where
 instance FromJSON GroupFeature where
   parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "GF"
 
-allGroupFeatures :: [GroupFeature]
+allGroupFeatures :: [AGroupFeature]
 allGroupFeatures =
-  [ GFDirectMessages,
-    GFFullDelete,
+  [ AGF SGFTimedMessages,
+    AGF SGFDirectMessages,
+    AGF SGFFullDelete,
     -- GFReceipts,
-    GFVoice
+    AGF SGFVoice
   ]
 
-groupPrefSel :: GroupFeature -> GroupPreferences -> Maybe GroupPreference
+groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
 groupPrefSel = \case
-  GFDirectMessages -> directMessages
-  GFFullDelete -> fullDelete
+  SGFTimedMessages -> timedMessages
+  SGFDirectMessages -> directMessages
+  SGFFullDelete -> fullDelete
   -- GFReceipts -> receipts
-  GFVoice -> voice
+  SGFVoice -> voice
+
+toGroupFeature :: SGroupFeature f -> GroupFeature
+toGroupFeature = \case
+  SGFTimedMessages -> GFTimedMessages
+  SGFDirectMessages -> GFDirectMessages
+  SGFFullDelete -> GFFullDelete
+  SGFVoice -> GFVoice
 
 class GroupPreferenceI p where
-  getGroupPreference :: GroupFeature -> p -> GroupPreference
+  getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
 
 instance GroupPreferenceI GroupPreferences where
   getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt prefs)
@@ -423,18 +445,20 @@ instance GroupPreferenceI (Maybe GroupPreferences) where
 
 instance GroupPreferenceI FullGroupPreferences where
   getGroupPreference = \case
-    GFDirectMessages -> directMessages
-    GFFullDelete -> fullDelete
+    SGFTimedMessages -> timedMessages
+    SGFDirectMessages -> directMessages
+    SGFFullDelete -> fullDelete
     -- GFReceipts -> receipts
-    GFVoice -> voice
+    SGFVoice -> voice
   {-# INLINE getGroupPreference #-}
 
 -- collection of optional group preferences
 data GroupPreferences = GroupPreferences
-  { directMessages :: Maybe GroupPreference,
-    fullDelete :: Maybe GroupPreference,
+  { timedMessages :: Maybe TimedMessagesGroupPreference,
+    directMessages :: Maybe DirectMessagesGroupPreference,
+    fullDelete :: Maybe FullDeleteGroupPreference,
     -- receipts :: Maybe GroupPreference,
-    voice :: Maybe GroupPreference
+    voice :: Maybe VoiceGroupPreference
   }
   deriving (Eq, Show, Generic, FromJSON)
 
@@ -448,14 +472,17 @@ instance ToField GroupPreferences where
 instance FromField GroupPreferences where
   fromField = fromTextField_ decodeJSON
 
-setGroupPreference :: GroupFeature -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
+setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
 setGroupPreference f enable prefs_ =
-  let prefs = mergeGroupPreferences prefs_
-      pref = (getGroupPreference f prefs :: GroupPreference) {enable}
-   in toGroupPreferences $ case f of
-        GFDirectMessages -> prefs {directMessages = pref}
-        GFVoice -> prefs {voice = pref}
-        GFFullDelete -> prefs {fullDelete = pref}
+  toGroupPreferences $ case f of
+    SGFTimedMessages -> prefs {timedMessages = pref}
+    SGFDirectMessages -> prefs {directMessages = pref}
+    SGFVoice -> prefs {voice = pref}
+    SGFFullDelete -> prefs {fullDelete = 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.
@@ -472,10 +499,11 @@ instance ToJSON FullPreferences where toEncoding = J.genericToEncoding J.default
 -- 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
-  { directMessages :: GroupPreference,
-    fullDelete :: GroupPreference,
+  { timedMessages :: TimedMessagesGroupPreference,
+    directMessages :: DirectMessagesGroupPreference,
+    fullDelete :: FullDeleteGroupPreference,
     -- receipts :: GroupPreference,
-    voice :: GroupPreference
+    voice :: VoiceGroupPreference
   }
   deriving (Eq, Show, Generic, FromJSON)
 
@@ -532,14 +560,15 @@ emptyChatPrefs = Preferences Nothing Nothing Nothing
 defaultGroupPrefs :: FullGroupPreferences
 defaultGroupPrefs =
   FullGroupPreferences
-    { directMessages = GroupPreference {enable = FEOff},
-      fullDelete = GroupPreference {enable = FEOff},
+    { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = 86400},
+      directMessages = DirectMessagesGroupPreference {enable = FEOff},
+      fullDelete = FullDeleteGroupPreference {enable = FEOff},
       -- receipts = GroupPreference {enable = FEOff},
-      voice = GroupPreference {enable = FEOn}
+      voice = VoiceGroupPreference {enable = FEOn}
     }
 
 emptyGroupPrefs :: GroupPreferences
-emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing
+emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing
 
 data TimedMessagesPreference = TimedMessagesPreference
   { allow :: FeatureAllowed,
@@ -584,11 +613,70 @@ data GroupPreference = GroupPreference
   {enable :: GroupFeatureEnabled}
   deriving (Eq, Show, Generic, FromJSON)
 
-groupPrefToText :: GroupPreference -> Text
-groupPrefToText GroupPreference {enable} = safeDecodeUtf8 $ strEncode enable
+data TimedMessagesGroupPreference = TimedMessagesGroupPreference
+  { enable :: GroupFeatureEnabled,
+    ttl :: 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 VoiceGroupPreference = VoiceGroupPreference
+  {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 FullDeleteGroupPreference where toEncoding = J.genericToEncoding J.defaultOptions
+
+instance ToJSON VoiceGroupPreference 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
+
+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" 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 GroupFeatureI 'GFTimedMessages where
+  type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
+
+instance GroupFeatureI 'GFDirectMessages where
+  type GroupFeaturePreference 'GFDirectMessages = DirectMessagesGroupPreference
+
+instance GroupFeatureI 'GFFullDelete where
+  type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference
+
+instance GroupFeatureI 'GFVoice where
+  type GroupFeaturePreference 'GFVoice = VoiceGroupPreference
+
+groupPrefToText :: HasField "enable" p GroupFeatureEnabled => p -> Text
+groupPrefToText = safeDecodeUtf8 . strEncode . getField @"enable"
+
+toGroupPreference :: GroupFeatureI f => GroupFeaturePreference f -> GroupPreference
+toGroupPreference p = GroupPreference {enable = getField @"enable" p}
+
 data FeatureAllowed
   = FAAlways -- allow unconditionally
   | FAYes -- allow, if peer allows it
@@ -667,23 +755,27 @@ mergeUserChatPrefs' user connectedIncognito userPreferences =
 mergeGroupPreferences :: Maybe GroupPreferences -> FullGroupPreferences
 mergeGroupPreferences groupPreferences =
   FullGroupPreferences
-    { directMessages = pref GFDirectMessages,
-      fullDelete = pref GFFullDelete,
+    { timedMessages = pref SGFTimedMessages,
+      directMessages = pref SGFDirectMessages,
+      fullDelete = pref SGFFullDelete,
       -- receipts = pref GFReceipts,
-      voice = pref GFVoice
+      voice = pref SGFVoice
     }
   where
+    pref :: SGroupFeature f -> GroupFeaturePreference f
     pref pt = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPreferences >>= groupPrefSel pt)
 
 toGroupPreferences :: FullGroupPreferences -> GroupPreferences
 toGroupPreferences groupPreferences =
   GroupPreferences
-    { directMessages = pref GFDirectMessages,
-      fullDelete = pref GFFullDelete,
+    { timedMessages = pref SGFTimedMessages,
+      directMessages = pref SGFDirectMessages,
+      fullDelete = pref SGFFullDelete,
       -- receipts = pref GFReceipts,
-      voice = pref GFVoice
+      voice = pref SGFVoice
     }
   where
+    pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
     pref f = Just $ getGroupPreference f groupPreferences
 
 data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}

src/Simplex/Chat/View.hs

@@ -26,6 +26,7 @@ import Data.Time.Clock (DiffTime, UTCTime)
 import Data.Time.Format (defaultTimeLocale, formatTime)
 import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToZonedTime)
 import GHC.Generics (Generic)
+import GHC.Records.Compat
 import qualified Network.HTTP.Types as Q
 import Numeric (showFFloat)
 import Simplex.Chat (maxImageSize)
@@ -50,7 +51,6 @@ import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Util (bshow)
 import System.Console.ANSI.Types
-import GHC.Records.Compat
 
 type CurrentTime = UTCTime
 
@@ -829,11 +829,11 @@ viewGroupUpdated
         | otherwise = bold' "updated group preferences:" : prefs
         where
           prefs = mapMaybe viewPref allGroupFeatures
-          viewPref pt
+          viewPref (AGF f)
             | pref gps == pref gps' = Nothing
-            | otherwise = Just $ plain (groupFeatureToText pt) <> " enabled: " <> plain (groupPrefToText $ pref gps')
+            | otherwise = Just $ plain (groupFeatureToText $ toGroupFeature f) <> " enabled: " <> plain (groupPrefToText $ pref gps')
             where
-              pref = getGroupPreference pt . mergeGroupPreferences
+              pref = getGroupPreference f . mergeGroupPreferences
 
 viewGroupProfile :: GroupInfo -> [StyledString]
 viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, groupPreferences = gps}} =
@@ -842,9 +842,9 @@ viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, g
     <> maybe [] ((bold' "description:" :) . map plain . T.lines) description
     <> (bold' "group preferences:" : map viewPref allGroupFeatures)
   where
-    viewPref pt = plain (groupFeatureToText pt) <> " enabled: " <> plain (groupPrefToText $ pref gps)
+    viewPref (AGF f) = plain (groupFeatureToText $ toGroupFeature f) <> " enabled: " <> plain (groupPrefToText $ pref gps)
       where
-        pref = getGroupPreference pt . mergeGroupPreferences
+        pref = getGroupPreference f . mergeGroupPreferences
 
 bold' :: String -> StyledString
 bold' = styled Bold

tests/ChatTests.hs

@@ -1283,7 +1283,7 @@ testGroupMessageDelete =
         (cath <# "#team alice> hello!")
 
       -- alice: deletes msg id 5
-      alice #$> ("/_delete item #1 " <> groupItemId' 2 2 <> " internal", id, "message deleted")
+      alice #$> ("/_delete item #1 " <> groupItemId 2 5 <> " internal", id, "message deleted")
 
       alice #$> ("/_get chat #1 count=1", chat, [(0, "connected")])
       bob #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
@@ -1309,14 +1309,14 @@ testGroupMessageDelete =
       cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
 
       -- alice: deletes msg id 5
-      alice #$> ("/_delete item #1 " <> groupItemId' 2 2 <> " internal", id, "message deleted")
+      alice #$> ("/_delete item #1 " <> groupItemId 2 5 <> " internal", id, "message deleted")
 
       alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
       bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
       cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
 
       -- alice: msg id 5
-      bob #$> ("/_update item #1 " <> groupItemId' 2 3 <> " text hi alice", id, "message updated")
+      bob #$> ("/_update item #1 " <> groupItemId 2 7 <> " text hi alice", id, "message updated")
       concurrently_
         (alice <# "#team bob> [edited] hi alice")
         ( do
@@ -1335,13 +1335,13 @@ testGroupMessageDelete =
         (alice <# "#team cath> how are you?")
         (bob <# "#team cath> how are you?")
 
-      cath #$> ("/_delete item #1 " <> groupItemId' 2 3 <> " broadcast", id, "message marked deleted")
+      cath #$> ("/_delete item #1 " <> groupItemId 2 7 <> " broadcast", id, "message marked deleted")
       concurrently_
         (alice <# "#team cath> [marked deleted] how are you?")
         (bob <# "#team cath> [marked deleted] how are you?")
 
-      alice #$> ("/_delete item #1 " <> groupItemId' 2 2 <> " broadcast", id, "cannot delete this item")
-      alice #$> ("/_delete item #1 " <> groupItemId' 2 2 <> " internal", id, "message deleted")
+      alice #$> ("/_delete item #1 " <> groupItemId 2 5 <> " broadcast", id, "cannot delete this item")
+      alice #$> ("/_delete item #1 " <> groupItemId 2 5 <> " internal", id, "message deleted")
 
       alice #$> ("/_get chat #1 count=1", chat', [((0, "how are you? [marked deleted]"), Nothing)])
       bob #$> ("/_get chat #1 count=3", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "how are you? [marked deleted]"), Nothing)])
@@ -1561,6 +1561,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile
   where
     groupInfo alice = do
       alice <## "group preferences:"
+      alice <## "Disappearing messages enabled: off"
       alice <## "Direct messages enabled: on"
       alice <## "Full deletion enabled: off"
       alice <## "Voice messages enabled: on"
@@ -4875,7 +4876,7 @@ groupFeatures :: [(Int, String)]
 groupFeatures = map (\(a, _, _) -> a) groupFeatures''
 
 groupFeatures'' :: [((Int, String), Maybe (Int, String), Maybe String)]
-groupFeatures'' = [((0, "Direct messages: on"), Nothing, Nothing), ((0, "Full deletion: off"), Nothing, Nothing), ((0, "Voice messages: on"), Nothing, Nothing)]
+groupFeatures'' = [((0, "Disappearing messages: off"), Nothing, Nothing), ((0, "Direct messages: on"), Nothing, Nothing), ((0, "Full deletion: off"), Nothing, Nothing), ((0, "Voice messages: on"), Nothing, Nothing)]
 
 itemId :: Int -> String
 itemId i = show $ length chatFeatures + i

tests/ProtocolTests.hs

@@ -83,7 +83,7 @@ testChatPreferences :: Maybe Preferences
 testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing}
 
 testGroupPreferences :: Maybe GroupPreferences
-testGroupPreferences = Just GroupPreferences {directMessages = Nothing, voice = Just GroupPreference {enable = FEOn}, fullDelete = Nothing}
+testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, voice = Just VoiceGroupPreference {enable = FEOn}, fullDelete = Nothing}
 
 testProfile :: Profile
 testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), preferences = testChatPreferences}