mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-03-31 01:05:55 +00:00
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>
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
74a20ef70c
commit
aae0802ec8
@@ -304,7 +304,7 @@ processChatCommand = \case
|
||||
assertDirectAllowed user MDSnd ct XMsgNew_
|
||||
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
|
||||
if isVoice mc && not (featureAllowed SCFVoice forUser ct)
|
||||
then pure $ chatCmdError $ "feature not allowed " <> T.unpack (chatFeatureToText CFVoice)
|
||||
then pure $ chatCmdError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFVoice)
|
||||
else do
|
||||
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
|
||||
timed_ <- sndContactCITimed live ct
|
||||
@@ -357,7 +357,7 @@ processChatCommand = \case
|
||||
Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
|
||||
unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
|
||||
if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
|
||||
then pure $ chatCmdError $ "feature not allowed " <> T.unpack (groupFeatureToText GFVoice)
|
||||
then pure $ chatCmdError $ "feature not allowed " <> T.unpack (groupFeatureNameText GFVoice)
|
||||
else do
|
||||
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
|
||||
timed_ <- sndGroupCITimed live gInfo
|
||||
@@ -1305,7 +1305,7 @@ processChatCommand = \case
|
||||
mergedProfile' = userProfileToSend user' Nothing $ Just ct'
|
||||
when (mergedProfile' /= mergedProfile) $ do
|
||||
void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchError` (toView . CRChatError)
|
||||
when (directOrUsed ct') $ createFeatureChangedItems user' ct ct' CDDirectSnd CISndChatFeature
|
||||
when (directOrUsed ct') $ createSndFeatureItems user' ct ct'
|
||||
pure $ CRUserProfileUpdated (fromLocalProfile p) p'
|
||||
updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse
|
||||
updateContactPrefs user@User {userId} ct@Contact {activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
|
||||
@@ -1319,7 +1319,7 @@ processChatCommand = \case
|
||||
when (mergedProfile' /= mergedProfile) $
|
||||
withChatLock "updateProfile" $ do
|
||||
void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchError` (toView . CRChatError)
|
||||
when (directOrUsed ct') $ createFeatureChangedItems user ct ct' CDDirectSnd CISndChatFeature
|
||||
when (directOrUsed ct') $ createSndFeatureItems user ct ct'
|
||||
pure $ CRContactPrefsUpdated ct ct'
|
||||
runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse
|
||||
runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p} ms) p' = do
|
||||
@@ -2789,7 +2789,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
else do
|
||||
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
|
||||
updateContactProfile db user c' p'
|
||||
when (directOrUsed c') $ createFeatureChangedItems user c c' CDDirectRcv CIRcvChatFeature
|
||||
when (directOrUsed c') $ createRcvFeatureItems user c c'
|
||||
toView $ CRContactUpdated c c'
|
||||
where
|
||||
Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
|
||||
@@ -3439,13 +3439,47 @@ 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 -> Maybe Int -> CIContent d) -> m ()
|
||||
createFeatureChangedItems user Contact {mergedPreferences = cups} ct'@Contact {mergedPreferences = cups'} chatDir ciContent =
|
||||
forM_ allChatFeatures $ \(ACF f) -> do
|
||||
let state = featureState $ getContactUserPreference f cups
|
||||
state' = featureState $ getContactUserPreference f cups'
|
||||
when (state /= state') $
|
||||
createInternalChatItem user (chatDir ct') (uncurry (ciContent $ chatFeature f) state') Nothing
|
||||
createRcvFeatureItems :: forall m. ChatMonad m => User -> Contact -> Contact -> m ()
|
||||
createRcvFeatureItems user ct ct' =
|
||||
createFeatureItems user ct ct' CDDirectRcv CIRcvChatFeature CIRcvChatPreference contactPreference
|
||||
|
||||
createSndFeatureItems :: forall m. ChatMonad m => User -> Contact -> Contact -> m ()
|
||||
createSndFeatureItems user ct ct' =
|
||||
createFeatureItems user ct ct' CDDirectSnd CISndChatFeature CISndChatPreference getPref
|
||||
where
|
||||
getPref = (preference :: ContactUserPref (FeaturePreference f) -> FeaturePreference f) . userPreference
|
||||
|
||||
type FeatureContent a d = ChatFeature -> a -> Maybe Int -> CIContent d
|
||||
|
||||
createFeatureItems ::
|
||||
forall d m.
|
||||
(MsgDirectionI d, ChatMonad m) =>
|
||||
User ->
|
||||
Contact ->
|
||||
Contact ->
|
||||
(Contact -> ChatDirection 'CTDirect d) ->
|
||||
FeatureContent PrefEnabled d ->
|
||||
FeatureContent FeatureAllowed d ->
|
||||
(forall f. ContactUserPreference (FeaturePreference f) -> FeaturePreference f) ->
|
||||
m ()
|
||||
createFeatureItems user Contact {mergedPreferences = cups} ct'@Contact {mergedPreferences = cups'} chatDir ciFeature ciOffer getPref =
|
||||
forM_ allChatFeatures $ \(ACF f) -> createItem f
|
||||
where
|
||||
createItem :: forall f. FeatureI f => SChatFeature f -> m ()
|
||||
createItem f
|
||||
| state /= state' = create ciFeature state'
|
||||
| prefState /= prefState' = create ciOffer prefState'
|
||||
| otherwise = pure ()
|
||||
where
|
||||
create :: FeatureContent a d -> (a, Maybe Int) -> m ()
|
||||
create ci (s, param) = createInternalChatItem user (chatDir ct') (ci f' s param) Nothing
|
||||
f' = chatFeature f
|
||||
state = featureState cup
|
||||
state' = featureState cup'
|
||||
prefState = preferenceState $ getPref cup
|
||||
prefState' = preferenceState $ getPref cup'
|
||||
cup = getContactUserPreference f cups
|
||||
cup' = getContactUserPreference f cups'
|
||||
|
||||
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'} =
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -136,6 +136,7 @@ chatTests = do
|
||||
it "set connection alias" testSetConnectionAlias
|
||||
describe "preferences" $ do
|
||||
it "set contact preferences" testSetContactPrefs
|
||||
it "feature offers" testFeatureOffers
|
||||
it "update group preferences" testUpdateGroupPrefs
|
||||
it "allow full deletion to contact" testAllowFullDeletionContact
|
||||
it "allow full deletion to group" testAllowFullDeletionGroup
|
||||
@@ -1584,10 +1585,10 @@ 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"
|
||||
alice <## "Disappearing messages: off"
|
||||
alice <## "Direct messages: on"
|
||||
alice <## "Full deletion: off"
|
||||
alice <## "Voice messages: on"
|
||||
bobAddedDan cc = do
|
||||
cc <## "#team: bob added dan (Daniel) to the group (connecting...)"
|
||||
cc <## "#team: new member dan is connected"
|
||||
@@ -3427,6 +3428,25 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
|
||||
bob <## "Voice messages: off (you allow: default (yes), contact allows: no)"
|
||||
bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off"), (1, "Voice messages: enabled"), (0, "Voice messages: off")])
|
||||
|
||||
testFeatureOffers :: IO ()
|
||||
testFeatureOffers = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice ##> "/set delete @bob yes"
|
||||
alice <## "you updated preferences for bob:"
|
||||
alice <## "Full deletion: off (you allow: yes, contact allows: no)"
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "you offered Full deletion")])
|
||||
bob <## "alice updated preferences for you:"
|
||||
bob <## "Full deletion: off (you allow: default (no), contact allows: yes)"
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Full deletion")])
|
||||
alice ##> "/set delete @bob no"
|
||||
alice <## "you updated preferences for bob:"
|
||||
alice <## "Full deletion: off (you allow: no, contact allows: no)"
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "you offered Full deletion"), (1, "you cancelled Full deletion")])
|
||||
bob <## "alice updated preferences for you:"
|
||||
bob <## "Full deletion: off (you allow: default (no), contact allows: no)"
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Full deletion"), (0, "cancelled Full deletion")])
|
||||
|
||||
testUpdateGroupPrefs :: IO ()
|
||||
testUpdateGroupPrefs =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
@@ -3437,32 +3457,32 @@ testUpdateGroupPrefs =
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected")])
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Full deletion enabled: on"
|
||||
alice <## "Full deletion: on"
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on")])
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Full deletion enabled: on"
|
||||
bob <## "Full deletion: on"
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on")])
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Full deletion enabled: off"
|
||||
alice <## "Voice messages enabled: off"
|
||||
alice <## "Full deletion: off"
|
||||
alice <## "Voice messages: off"
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off")])
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Full deletion enabled: off"
|
||||
bob <## "Voice messages enabled: off"
|
||||
bob <## "Full deletion: off"
|
||||
bob <## "Voice messages: off"
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off")])
|
||||
-- alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/set voice #team on"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Voice messages enabled: on"
|
||||
alice <## "Voice messages: on"
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")])
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Voice messages enabled: on"
|
||||
bob <## "Voice messages: on"
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on")])
|
||||
threadDelay 500000
|
||||
@@ -3512,10 +3532,10 @@ testAllowFullDeletionGroup =
|
||||
alice <# "#team bob> hey"
|
||||
alice ##> "/set delete #team on"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Full deletion enabled: on"
|
||||
alice <## "Full deletion: on"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Full deletion enabled: on"
|
||||
bob <## "Full deletion: on"
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "hi"), (0, "hey"), (1, "Full deletion: on")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "hi"), (1, "hey"), (0, "Full deletion: on")])
|
||||
bob #$> ("/_delete item #1 " <> msgItemId <> " broadcast", id, "message deleted")
|
||||
@@ -3530,7 +3550,7 @@ testProhibitDirectMessages =
|
||||
threadDelay 1000000
|
||||
alice ##> "/set direct #team off"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Direct messages enabled: off"
|
||||
alice <## "Direct messages: off"
|
||||
directProhibited bob
|
||||
directProhibited cath
|
||||
threadDelay 1000000
|
||||
@@ -3577,7 +3597,7 @@ testProhibitDirectMessages =
|
||||
directProhibited cc = do
|
||||
cc <## "alice updated group #team:"
|
||||
cc <## "updated group preferences:"
|
||||
cc <## "Direct messages enabled: off"
|
||||
cc <## "Direct messages: off"
|
||||
|
||||
testEnableTimedMessagesContact :: IO ()
|
||||
testEnableTimedMessagesContact =
|
||||
@@ -3586,42 +3606,42 @@ testEnableTimedMessagesContact =
|
||||
connectUsers alice bob
|
||||
alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 1}}"
|
||||
alice <## "you updated preferences for bob:"
|
||||
alice <## "Disappearing messages: off (you allow: yes, after 1 sec, contact allows: no)"
|
||||
alice <## "Disappearing messages: off (you allow: yes (1 sec), contact allows: no)"
|
||||
bob <## "alice updated preferences for you:"
|
||||
bob <## "Disappearing messages: off (you allow: no, contact allows: yes, after 1 sec)"
|
||||
bob <## "Disappearing messages: off (you allow: no, contact allows: yes (1 sec))"
|
||||
bob ##> "/set disappear @alice yes"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes, after 1 sec, contact allows: yes, after 1 sec)"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes, after 1 sec, contact allows: yes, after 1 sec)"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))"
|
||||
alice <##> bob
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled, after 1 sec"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled, after 1 sec"), (0, "hi"), (1, "hey")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "you offered Disappearing messages (1 sec)"), (0, "Disappearing messages: enabled (1 sec)"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Disappearing messages (1 sec)"), (1, "Disappearing messages: enabled (1 sec)"), (0, "hi"), (1, "hey")])
|
||||
threadDelay 1000000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled, after 1 sec")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled, after 1 sec")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "you offered Disappearing messages (1 sec)"), (0, "Disappearing messages: enabled (1 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Disappearing messages (1 sec)"), (1, "Disappearing messages: enabled (1 sec)")])
|
||||
-- turn off, messages are not disappearing
|
||||
bob ##> "/set disappear @alice no"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: off (you allow: no, contact allows: yes, after 1 sec)"
|
||||
bob <## "Disappearing messages: off (you allow: no, contact allows: yes (1 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: off (you allow: yes, after 1 sec, contact allows: no)"
|
||||
alice <## "Disappearing messages: off (you allow: yes (1 sec), contact allows: no)"
|
||||
alice <##> bob
|
||||
threadDelay 1500000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled, after 1 sec"), (0, "Disappearing messages: off"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled, after 1 sec"), (1, "Disappearing messages: off"), (0, "hi"), (1, "hey")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "you offered Disappearing messages (1 sec)"), (0, "Disappearing messages: enabled (1 sec)"), (0, "Disappearing messages: off"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Disappearing messages (1 sec)"), (1, "Disappearing messages: enabled (1 sec)"), (1, "Disappearing messages: off"), (0, "hi"), (1, "hey")])
|
||||
-- test api
|
||||
bob ##> "/set disappear @alice yes 30s"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes, after 30 sec, contact allows: yes, after 1 sec)"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (1 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes, after 30 sec, contact allows: yes, after 30 sec)"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (30 sec))"
|
||||
bob ##> "/set disappear @alice week" -- "yes" is optional
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes, after 1 week, contact allows: yes, after 1 sec)"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes, after 1 week, contact allows: yes, after 1 week)"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))"
|
||||
|
||||
testEnableTimedMessagesGroup :: IO ()
|
||||
testEnableTimedMessagesGroup =
|
||||
@@ -3631,45 +3651,45 @@ testEnableTimedMessagesGroup =
|
||||
threadDelay 1000000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages enabled: on, after 1 sec"
|
||||
alice <## "Disappearing messages: on (1 sec)"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages enabled: on, after 1 sec"
|
||||
bob <## "Disappearing messages: on (1 sec)"
|
||||
threadDelay 1000000
|
||||
alice #> "#team hi"
|
||||
bob <# "#team alice> hi"
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on, after 1 sec"), (1, "hi")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on, after 1 sec"), (0, "hi")])
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "hi")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "hi")])
|
||||
threadDelay 1000000
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on, after 1 sec")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on, after 1 sec")])
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on (1 sec)")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)")])
|
||||
-- turn off, messages are not disappearing
|
||||
alice ##> "/set disappear #team off"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages enabled: off"
|
||||
alice <## "Disappearing messages: off"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages enabled: off"
|
||||
bob <## "Disappearing messages: off"
|
||||
threadDelay 1000000
|
||||
alice #> "#team hey"
|
||||
bob <# "#team alice> hey"
|
||||
threadDelay 1500000
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on, after 1 sec"), (1, "Disappearing messages: off"), (1, "hey")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on, after 1 sec"), (0, "Disappearing messages: off"), (0, "hey")])
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "Disappearing messages: off"), (1, "hey")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "Disappearing messages: off"), (0, "hey")])
|
||||
-- test api
|
||||
alice ##> "/set disappear #team on 30s"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages enabled: on, after 30 sec"
|
||||
alice <## "Disappearing messages: on (30 sec)"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages enabled: on, after 30 sec"
|
||||
bob <## "Disappearing messages: on (30 sec)"
|
||||
alice ##> "/set disappear #team week" -- "on" is optional
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages enabled: on, after 1 week"
|
||||
alice <## "Disappearing messages: on (1 week)"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages enabled: on, after 1 week"
|
||||
bob <## "Disappearing messages: on (1 week)"
|
||||
|
||||
testTimedMessagesEnabledGlobally :: IO ()
|
||||
testTimedMessagesEnabledGlobally =
|
||||
@@ -3681,16 +3701,16 @@ testTimedMessagesEnabledGlobally =
|
||||
connectUsers alice bob
|
||||
bob ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 1}}"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes, after 1 sec, contact allows: yes)"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes)"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes, after 1 sec, contact allows: yes, after 1 sec)"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))"
|
||||
alice <##> bob
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled, after 1 sec"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled, after 1 sec"), (0, "hi"), (1, "hey")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (0, "hi"), (1, "hey")])
|
||||
threadDelay 1000000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled, after 1 sec")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled, after 1 sec")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")])
|
||||
|
||||
testGetSetSMPServers :: IO ()
|
||||
testGetSetSMPServers =
|
||||
|
||||
Reference in New Issue
Block a user