core: ttl in feature chat items, view responses (#1595)

* core: ttl in feature chat items, view responses

* fix tests

* fix test

* view

* refactor

* use prefChangedValue

* use groupPrefChangedValue

* use cupIntValue

* simplify types

* groupFeatureState

* groupPrefToText

* prefToText, view

* remove prefFeature

* rename intValue -> param

* int -> param

* timedTTLText

* remove pragma

* restore pragma

* simplify

* timedTTLText

* fix tests

* off, after

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
JRoberts
2022-12-19 21:18:59 +04:00
committed by GitHub
parent ffa37b1684
commit 84e43c57f6
5 changed files with 150 additions and 76 deletions
+20 -19
View File
@@ -1342,7 +1342,7 @@ processChatCommand = \case
unless (sameGroupProfileInfo p p') $ do
ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p')
toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat g') ci
createGroupFeatureChangedItems user cd CISndGroupFeature p p'
createGroupFeatureChangedItems user cd CISndGroupFeature g g'
pure $ CRGroupUpdated g g' Nothing
updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> m ChatResponse
updateGroupProfileByName gName update = withUser $ \user -> do
@@ -2767,15 +2767,15 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
createFeatureEnabledItems :: Contact -> m ()
createFeatureEnabledItems ct@Contact {mergedPreferences} =
forM_ allChatFeatures $ \(ACF f) -> do
let ContactUserPreference {enabled} = getContactUserPreference f mergedPreferences
createInternalChatItem user (CDDirectRcv ct) (CIRcvChatFeature (chatFeature f) enabled) Nothing
let state = featureState $ getContactUserPreference f mergedPreferences
createInternalChatItem user (CDDirectRcv ct) (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing
createGroupFeatureItems :: GroupInfo -> GroupMember -> m ()
createGroupFeatureItems g@GroupInfo {groupProfile} m = do
let prefs = mergeGroupPreferences $ groupPreferences groupProfile
createGroupFeatureItems g@GroupInfo {fullGroupPreferences} m =
forM_ allGroupFeatures $ \(AGF f) -> do
let p = getGroupPreference f prefs
createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p)) Nothing
let p = getGroupPreference f fullGroupPreferences
(_, param) = groupFeatureState p
createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe =
@@ -3078,7 +3078,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
unless (sameGroupProfileInfo p p') $ do
ci <- saveRcvChatItem user cd msg msgMeta (CIRcvGroupEvent $ RGEGroupUpdated p')
groupMsgToView g' m ci msgMeta
createGroupFeatureChangedItems user cd CIRcvGroupFeature p p'
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
sendDirectFileInline :: ChatMonad m => Contact -> FileTransferMeta -> SharedMsgId -> m ()
sendDirectFileInline ct ft sharedMsgId = do
@@ -3391,21 +3391,22 @@ userProfileToSend user@User {profile = p} incognitoProfile ct =
userPrefs = maybe (preferences' user) (const Nothing) incognitoProfile
in (p' :: Profile) {preferences = Just . toChatPrefs $ mergePreferences (userPreferences <$> ct) userPrefs}
createFeatureChangedItems :: (MsgDirectionI d, ChatMonad m) => User -> Contact -> Contact -> (Contact -> ChatDirection 'CTDirect d) -> (ChatFeature -> PrefEnabled -> CIContent d) -> m ()
createFeatureChangedItems :: (MsgDirectionI d, ChatMonad m) => User -> Contact -> Contact -> (Contact -> ChatDirection 'CTDirect d) -> (ChatFeature -> PrefEnabled -> Maybe Int -> CIContent d) -> m ()
createFeatureChangedItems user Contact {mergedPreferences = cups} ct'@Contact {mergedPreferences = cups'} chatDir ciContent =
forM_ allChatFeatures $ \(ACF f) -> do
let ContactUserPreference {enabled} = getContactUserPreference f cups
ContactUserPreference {enabled = enabled'} = getContactUserPreference f cups'
unless (enabled == enabled') $
createInternalChatItem user (chatDir ct') (ciContent (chatFeature f) enabled') Nothing
let state = featureState $ getContactUserPreference f cups
state' = featureState $ getContactUserPreference f cups'
when (state /= state') $
createInternalChatItem user (chatDir ct') (uncurry (ciContent $ chatFeature f) state') Nothing
createGroupFeatureChangedItems :: (MsgDirectionI d, ChatMonad m) => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> CIContent d) -> GroupProfile -> GroupProfile -> m ()
createGroupFeatureChangedItems user cd ciContent p p' =
createGroupFeatureChangedItems :: (MsgDirectionI d, ChatMonad m) => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> CIContent d) -> GroupInfo -> GroupInfo -> m ()
createGroupFeatureChangedItems user cd ciContent GroupInfo {fullGroupPreferences = gps} GroupInfo {fullGroupPreferences = gps'} =
forM_ allGroupFeatures $ \(AGF f) -> do
let pref = getGroupPreference f $ groupPreferences p
pref' = getGroupPreference f $ groupPreferences p'
unless (pref == pref') $
createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref')) Nothing
let state = groupFeatureState $ getGroupPreference f gps
pref' = getGroupPreference f gps'
state'@(_, int') = groupFeatureState pref'
when (state /= state') $
createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref') int') Nothing
sameGroupProfileInfo :: GroupProfile -> GroupProfile -> Bool
sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferences = Nothing}