core: chat items with offered feature (#1620)

* core: chat items with offered feature * texts Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> * new preference items * test Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
2026-05-24 21:45:38 +00:00 · 2022-12-22 14:56:29 +00:00
parent 74a20ef70c
commit aae0802ec8
5 changed files with 207 additions and 118 deletions
@@ -623,6 +623,8 @@ data CIContent (d :: MsgDirection) where
  CISndConnEvent :: SndConnEvent -> CIContent 'MDSnd
  CIRcvChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDRcv
  CISndChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDSnd
+  CIRcvChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDRcv
+  CISndChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDSnd
  CIRcvGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDRcv
  CISndGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDSnd
  CIRcvChatFeatureRejected :: ChatFeature -> CIContent 'MDRcv
@@ -655,6 +657,7 @@ ciRequiresAttention content = case msgDirection @d of
      RGEInvitedViaGroupLink -> False
    CIRcvConnEvent _ -> True
    CIRcvChatFeature {} -> False
+    CIRcvChatPreference {} -> False
    CIRcvGroupFeature {} -> False
    CIRcvChatFeatureRejected _ -> True
    CIRcvGroupFeatureRejected _ -> True
@@ -809,12 +812,14 @@ ciContentToText = \case
  CISndGroupEvent event -> sndGroupEventToText event
  CIRcvConnEvent event -> rcvConnEventToText event
  CISndConnEvent event -> sndConnEventToText event
-  CIRcvChatFeature feature enabled param -> chatFeatureToText feature <> ": " <> prefToText enabled param
-  CISndChatFeature feature enabled param -> chatFeatureToText feature <> ": " <> prefToText enabled param
-  CIRcvGroupFeature feature pref param -> groupFeatureToText feature <> ": " <> groupPrefToText pref param
-  CISndGroupFeature feature pref param -> groupFeatureToText feature <> ": " <> groupPrefToText pref param
-  CIRcvChatFeatureRejected feature -> chatFeatureToText feature <> ": received, prohibited"
-  CIRcvGroupFeatureRejected feature -> groupFeatureToText feature <> ": received, prohibited"
+  CIRcvChatFeature feature enabled param -> featureStateText feature enabled param
+  CISndChatFeature feature enabled param -> featureStateText feature enabled param
+  CIRcvChatPreference feature allowed param -> prefStateText feature allowed param
+  CISndChatPreference feature allowed param -> "you " <> prefStateText feature allowed param
+  CIRcvGroupFeature feature pref param -> groupPrefStateText feature pref param
+  CISndGroupFeature feature pref param -> groupPrefStateText feature pref param
+  CIRcvChatFeatureRejected feature -> chatFeatureNameText feature <> ": received, prohibited"
+  CIRcvGroupFeatureRejected feature -> groupFeatureNameText feature <> ": received, prohibited"

 msgIntegrityError :: MsgErrorType -> Text
 msgIntegrityError = \case
@@ -867,6 +872,8 @@ data JSONCIContent
  | JCISndConnEvent {sndConnEvent :: SndConnEvent}
  | JCIRcvChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int}
  | JCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int}
+  | JCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
+  | JCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
  | JCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
  | JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
  | JCIRcvChatFeatureRejected {feature :: ChatFeature}
@@ -897,6 +904,8 @@ jsonCIContent = \case
  CISndConnEvent sndConnEvent -> JCISndConnEvent {sndConnEvent}
  CIRcvChatFeature feature enabled param -> JCIRcvChatFeature {feature, enabled, param}
  CISndChatFeature feature enabled param -> JCISndChatFeature {feature, enabled, param}
+  CIRcvChatPreference feature allowed param -> JCIRcvChatPreference {feature, allowed, param}
+  CISndChatPreference feature allowed param -> JCISndChatPreference {feature, allowed, param}
  CIRcvGroupFeature groupFeature preference param -> JCIRcvGroupFeature {groupFeature, preference, param}
  CISndGroupFeature groupFeature preference param -> JCISndGroupFeature {groupFeature, preference, param}
  CIRcvChatFeatureRejected feature -> JCIRcvChatFeatureRejected {feature}
@@ -919,6 +928,8 @@ aciContentJSON = \case
  JCISndConnEvent {sndConnEvent} -> ACIContent SMDSnd $ CISndConnEvent sndConnEvent
  JCIRcvChatFeature {feature, enabled, param} -> ACIContent SMDRcv $ CIRcvChatFeature feature enabled param
  JCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param
+  JCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param
+  JCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param
  JCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param
  JCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param
  JCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature
@@ -941,6 +952,8 @@ data DBJSONCIContent
  | DBJCISndConnEvent {sndConnEvent :: DBSndConnEvent}
  | DBJCIRcvChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int}
  | DBJCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int}
+  | DBJCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
+  | DBJCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
  | DBJCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
  | DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
  | DBJCIRcvChatFeatureRejected {feature :: ChatFeature}
@@ -971,6 +984,8 @@ dbJsonCIContent = \case
  CISndConnEvent sce -> DBJCISndConnEvent $ SCE sce
  CIRcvChatFeature feature enabled param -> DBJCIRcvChatFeature {feature, enabled, param}
  CISndChatFeature feature enabled param -> DBJCISndChatFeature {feature, enabled, param}
+  CIRcvChatPreference feature allowed param -> DBJCIRcvChatPreference {feature, allowed, param}
+  CISndChatPreference feature allowed param -> DBJCISndChatPreference {feature, allowed, param}
  CIRcvGroupFeature groupFeature preference param -> DBJCIRcvGroupFeature {groupFeature, preference, param}
  CISndGroupFeature groupFeature preference param -> DBJCISndGroupFeature {groupFeature, preference, param}
  CIRcvChatFeatureRejected feature -> DBJCIRcvChatFeatureRejected {feature}
@@ -993,6 +1008,8 @@ aciContentDBJSON = \case
  DBJCISndConnEvent (SCE sce) -> ACIContent SMDSnd $ CISndConnEvent sce
  DBJCIRcvChatFeature {feature, enabled, param} -> ACIContent SMDRcv $ CIRcvChatFeature feature enabled param
  DBJCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param
+  DBJCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param
+  DBJCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param
  DBJCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param
  DBJCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param
  DBJCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature
@@ -283,12 +283,15 @@ data AChatFeature = forall f. FeatureI f => ACF (SChatFeature f)

 deriving instance Show AChatFeature

-chatFeatureToText :: ChatFeature -> Text
-chatFeatureToText = \case
+chatFeatureNameText :: ChatFeature -> Text
+chatFeatureNameText = \case
  CFTimedMessages -> "Disappearing messages"
  CFFullDelete -> "Full deletion"
  CFVoice -> "Voice messages"

+chatFeatureNameText' :: SChatFeature f -> Text
+chatFeatureNameText' = chatFeatureNameText . chatFeature
+
 featureAllowed :: SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
 featureAllowed feature forWhom Contact {mergedPreferences} =
  let ContactUserPreference {enabled} = getContactUserPreference feature mergedPreferences
@@ -397,13 +400,16 @@ data AGroupFeature = forall f. GroupFeatureI f => AGF (SGroupFeature f)

 deriving instance Show AGroupFeature

-groupFeatureToText :: GroupFeature -> Text
-groupFeatureToText = \case
+groupFeatureNameText :: GroupFeature -> Text
+groupFeatureNameText = \case
  GFTimedMessages -> "Disappearing messages"
  GFDirectMessages -> "Direct messages"
  GFFullDelete -> "Full deletion"
  GFVoice -> "Voice messages"

+groupFeatureNameText' :: SGroupFeature f -> Text
+groupFeatureNameText' = groupFeatureNameText . toGroupFeature
+
 groupFeatureAllowed :: GroupFeatureI f => SGroupFeature f -> GroupInfo -> Bool
 groupFeatureAllowed feature gInfo = groupFeatureAllowed' feature $ fullGroupPreferences gInfo

@@ -614,6 +620,7 @@ instance ToJSON VoicePreference where toEncoding = J.genericToEncoding J.default

 class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureAllowed) => FeatureI f where
  type FeaturePreference (f :: ChatFeature) = p | p -> f
+  sFeature :: SChatFeature f
  prefParam :: FeaturePreference f -> Maybe Int

 instance HasField "allow" TimedMessagesPreference FeatureAllowed where
@@ -627,14 +634,17 @@ instance HasField "allow" VoicePreference FeatureAllowed where

 instance FeatureI 'CFTimedMessages where
  type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
+  sFeature = SCFTimedMessages
  prefParam TimedMessagesPreference {ttl} = ttl

 instance FeatureI 'CFFullDelete where
  type FeaturePreference 'CFFullDelete = FullDeletePreference
+  sFeature = SCFFullDelete
  prefParam _ = Nothing

 instance FeatureI 'CFVoice where
  type FeaturePreference 'CFVoice = VoicePreference
+  sFeature = SCFVoice
  prefParam _ = Nothing

 data GroupPreference = GroupPreference
@@ -671,6 +681,7 @@ instance ToJSON VoiceGroupPreference where toEncoding = J.genericToEncoding J.de

 class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
  type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
+  sGroupFeature :: SGroupFeature f
  groupPrefParam :: GroupFeaturePreference f -> Maybe Int

 instance HasField "enable" GroupPreference GroupFeatureEnabled where
@@ -690,31 +701,39 @@ instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where

 instance GroupFeatureI 'GFTimedMessages where
  type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
+  sGroupFeature = SGFTimedMessages
  groupPrefParam TimedMessagesGroupPreference {ttl} = Just ttl

 instance GroupFeatureI 'GFDirectMessages where
  type GroupFeaturePreference 'GFDirectMessages = DirectMessagesGroupPreference
+  sGroupFeature = SGFDirectMessages
  groupPrefParam _ = Nothing

 instance GroupFeatureI 'GFFullDelete where
  type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference
+  sGroupFeature = SGFFullDelete
  groupPrefParam _ = Nothing

 instance GroupFeatureI 'GFVoice where
  type GroupFeaturePreference 'GFVoice = VoiceGroupPreference
+  sGroupFeature = SGFVoice
  groupPrefParam _ = Nothing

-groupPrefToText :: HasField "enable" p GroupFeatureEnabled => p -> Maybe Int -> Text
-groupPrefToText p = groupPrefToText_ $ getField @"enable" p
+groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
+groupPrefStateText feature pref param =
+  let enabled = getField @"enable" pref
+      paramText = if enabled == FEOn then groupParamText_ feature param else ""
+   in groupFeatureNameText feature <> ": " <> safeDecodeUtf8 (strEncode enabled) <> paramText

-groupPrefToText' :: GroupFeatureI f => GroupFeaturePreference f -> Text
-groupPrefToText' p = groupPrefToText_ (getField @"enable" p) (groupPrefParam p)
+groupParamText_ :: GroupFeature -> Maybe Int -> Text
+groupParamText_ feature param = case feature of
+  GFTimedMessages -> maybe "" (\p -> " (" <> timedTTLText p <> ")") param
+  _ -> ""

-groupPrefToText_ :: GroupFeatureEnabled -> Maybe Int -> Text
-groupPrefToText_ enabled param = do
-  let enabledText = safeDecodeUtf8 . strEncode $ enabled
-      paramText = if enabled == FEOn then maybe "" (\n -> ", after " <> timedTTLText n) param else ""
-   in enabledText <> paramText
+groupPreferenceText :: forall f. GroupFeatureI f => GroupFeaturePreference f -> Text
+groupPreferenceText pref =
+  let feature = toGroupFeature $ sGroupFeature @f
+   in groupPrefStateText feature pref $ groupPrefParam pref

 timedTTLText :: Int -> Text
 timedTTLText 0 = "0 sec"
@@ -862,13 +881,21 @@ prefEnabled asymmetric user contact = case (getField @"allow" user, getField @"a
  (FANo, _) -> PrefEnabled False False
  _ -> PrefEnabled True True

-prefToText :: PrefEnabled -> Maybe Int -> Text
-prefToText enabled param =
-  let paramText = if enabled == PrefEnabled True True then prefParamText param else ""
-   in prefEnabledToText enabled <> paramText
+prefStateText :: ChatFeature -> FeatureAllowed -> Maybe Int -> Text
+prefStateText feature allowed param = case allowed of
+  FANo -> "cancelled " <> chatFeatureNameText feature
+  _ -> "offered " <> chatFeatureNameText feature <> paramText_ feature param

-prefParamText :: Maybe Int -> Text
-prefParamText = maybe "" (\n -> ", after " <> timedTTLText n)
+featureStateText :: ChatFeature -> PrefEnabled -> Maybe Int -> Text
+featureStateText feature enabled param =
+  chatFeatureNameText feature <> ": " <> prefEnabledToText enabled <> case enabled of
+    PrefEnabled {forUser = True} -> paramText_ feature param
+    _ -> ""
+
+paramText_ :: ChatFeature -> Maybe Int -> Text
+paramText_ feature param = case feature of
+  CFTimedMessages -> maybe "" (\p -> " (" <> timedTTLText p <> ")") param
+  _ -> ""

 prefEnabledToText :: PrefEnabled -> Text
 prefEnabledToText = \case
@@ -877,21 +904,24 @@ prefEnabledToText = \case
  PrefEnabled {forUser = True, forContact = False} -> "enabled for you"
  PrefEnabled {forUser = False, forContact = True} -> "enabled for contact"

-prefToText' :: FeatureI f => FeaturePreference f -> Text
-prefToText' p =
-  let allowed = getField @"allow" p
-      allowedText = case getField @"allow" p of
-        FAAlways -> "always"
-        FAYes -> "yes"
-        FANo -> "no"
-      paramText = if allowed == FAAlways || allowed == FAYes then prefParamText (prefParam p) else ""
-   in allowedText <> paramText
+preferenceText :: forall f. FeatureI f => FeaturePreference f -> Text
+preferenceText p =
+  let feature = chatFeature $ sFeature @f
+      allowed = getField @"allow" p
+      paramText = if allowed == FAAlways || allowed == FAYes then paramText_ feature (prefParam p) else ""
+   in safeDecodeUtf8 (strEncode allowed) <> paramText

 featureState :: FeatureI f => ContactUserPreference (FeaturePreference f) -> (PrefEnabled, Maybe Int)
 featureState ContactUserPreference {enabled, userPreference} =
  let param = if forUser enabled then prefParam $ preference userPreference else Nothing
   in (enabled, param)

+preferenceState :: FeatureI f => FeaturePreference f -> (FeatureAllowed, Maybe Int)
+preferenceState pref =
+  let allow = getField @"allow" pref
+      param = if allow == FAAlways || allow == FAYes then prefParam pref else Nothing
+   in (allow, param)
+
 updateMergedPreferences :: User -> Contact -> Contact
 updateMergedPreferences user ct =
  let mergedPreferences = contactUserPreferences user (userPreferences ct) (preferences' ct) (contactConnIncognito ct)
@@ -796,7 +796,7 @@ viewContactPreferences user ct ct' cups =
 viewContactPref :: FullPreferences -> FullPreferences -> Maybe Preferences -> ContactUserPreferences -> AChatFeature -> Maybe StyledString
 viewContactPref userPrefs userPrefs' ctPrefs cups (ACF f)
  | userPref == userPref' && ctPref == contactPreference = Nothing
-  | otherwise = Just $ viewFeatureText f <> ": " <> plain (prefEnabledToText enabled) <> " (you allow: " <> viewCountactUserPref userPreference <> ", contact allows: " <> viewPreference contactPreference <> ")"
+  | otherwise = Just . plain $ chatFeatureNameText' f <> ": " <> prefEnabledToText enabled <> " (you allow: " <> countactUserPrefText userPreference <> ", contact allows: " <> preferenceText contactPreference <> ")"
  where
    userPref = getPreference f userPrefs
    userPref' = getPreference f userPrefs'
@@ -811,20 +811,14 @@ viewPrefsUpdated ps ps'
    prefs = mapMaybe viewPref allChatFeatures
    viewPref (ACF f)
      | pref ps == pref ps' = Nothing
-      | otherwise = Just $ viewFeatureText f <> " allowed: " <> viewPreference (pref ps')
+      | otherwise = Just . plain $ chatFeatureNameText' f <> " allowed: " <> preferenceText (pref ps')
      where
        pref pss = getPreference f $ mergePreferences pss Nothing

-viewFeatureText :: SChatFeature f -> StyledString
-viewFeatureText f = plain . chatFeatureToText $ chatFeature f
-
-viewPreference :: FeatureI f => FeaturePreference f -> StyledString
-viewPreference p = plain $ prefToText' p
-
-viewCountactUserPref :: FeatureI f => ContactUserPref (FeaturePreference f) -> StyledString
-viewCountactUserPref = \case
-  CUPUser p -> "default (" <> viewPreference p <> ")"
-  CUPContact p -> viewPreference p
+countactUserPrefText :: FeatureI f => ContactUserPref (FeaturePreference f) -> Text
+countactUserPrefText cup = case cup of
+  CUPUser p -> "default (" <> preferenceText p <> ")"
+  CUPContact p -> preferenceText p

 viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> [StyledString]
 viewGroupUpdated
@@ -849,16 +843,10 @@ viewGroupUpdated
          prefs = mapMaybe viewPref allGroupFeatures
          viewPref (AGF f)
            | pref gps == pref gps' = Nothing
-            | otherwise = Just $ viewGroupFeatureText f <> " enabled: " <> viewGroupPreference (pref gps')
+            | otherwise = Just . plain $ groupPreferenceText (pref gps')
            where
              pref = getGroupPreference f . mergeGroupPreferences

-viewGroupFeatureText :: SGroupFeature f -> StyledString
-viewGroupFeatureText f = plain . groupFeatureToText $ toGroupFeature f
-
-viewGroupPreference :: GroupFeatureI f => GroupFeaturePreference f -> StyledString
-viewGroupPreference p = plain $ groupPrefToText' p
-
 viewGroupProfile :: GroupInfo -> [StyledString]
 viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, groupPreferences = gps}} =
  [ttyFullGroup g]
@@ -866,7 +854,7 @@ viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, g
    <> maybe [] ((bold' "description:" :) . map plain . T.lines) description
    <> (bold' "group preferences:" : map viewPref allGroupFeatures)
  where
-    viewPref (AGF f) = viewGroupFeatureText f <> " enabled: " <> viewGroupPreference (pref gps)
+    viewPref (AGF f) = plain $ groupPreferenceText (pref gps)
      where
        pref = getGroupPreference f . mergeGroupPreferences