IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

refactor, restore that received message can disabled disappearing

Browse Source
This commit is contained in:
Evgeny Poberezkin 2023-05-11 11:25:34 +01:00
parent 94b05d0fab
commit 3ccc57a090
2 changed files with 28 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/Simplex/Chat.hs
View File

@ -481,7 +481,7 @@ processChatCommand = \case
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFVoice))
else do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
timed_ <- sndContactCITimed live itemTTL ct
timed_ <- sndContactCITimed live ct itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
case ft_ of
@ -541,7 +541,7 @@ processChatCommand = \case
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice))
else do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live itemTTL gInfo
timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
@ -1790,16 +1790,17 @@ processChatCommand = \case
chatRef <- getChatRef user chatName
let mc = MCText msg
processChatCommand . APISendMessage chatRef live Nothing $ ComposedMessage Nothing Nothing mc
sndContactCITimed :: Bool -> Maybe Int -> Contact -> m (Maybe CITimed)
sndContactCITimed live itemTTL ct = mapM (sndCITimed_ live) $ contactTimedTTL ct itemTTL
sndGroupCITimed :: Bool -> Maybe Int -> GroupInfo -> m (Maybe CITimed)
sndGroupCITimed live itemTTL g = mapM (sndCITimed_ live) $ groupTimedTTL g itemTTL
sndCITimed_ :: Bool -> Int -> m CITimed
sndCITimed_ live ttl =
CITimed ttl
<$> if live
then pure Nothing
else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime
sndContactCITimed :: Bool -> Contact -> Maybe Int -> m (Maybe CITimed)
sndContactCITimed live = sndCITimed_ live . contactTimedTTL
sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> m (Maybe CITimed)
sndGroupCITimed live = sndCITimed_ live . groupTimedTTL
sndCITimed_ :: Bool -> Maybe (Maybe Int) -> Maybe Int -> m (Maybe CITimed)
sndCITimed_ live chatTTL itemTTL =
forM (chatTTL >>= (itemTTL <|>)) $ \ttl ->
CITimed ttl
<$> if live
then pure Nothing
else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime
drgRandomBytes :: Int -> m ByteString
drgRandomBytes n = asks idsDrg >>= liftIO . (`randomBytes` n)
privateGetUser :: UserId -> m User

34
src/Simplex/Chat/Messages.hs
View File

@ -344,7 +344,7 @@ instance ToJSON (CIMeta c d) where toEncoding = J.genericToEncoding J.defaultOpt
data CITimed = CITimed
{ ttl :: Int, -- seconds
deleteAt :: Maybe UTCTime
deleteAt :: Maybe UTCTime -- this is initially Nothing for received items, the timer starts when they are read
}
deriving (Show, Generic)
@ -353,30 +353,26 @@ instance ToJSON CITimed where toEncoding = J.genericToEncoding J.defaultOptions
ttl' :: CITimed -> Int
ttl' CITimed {ttl} = ttl
contactTimedTTL :: Contact -> Maybe Int -> Maybe Int
contactTimedTTL
Contact {mergedPreferences = ContactUserPreferences {timedMessages = ContactUserPreference {enabled, userPreference}}}
itemTTL
| forUser enabled && forContact enabled = itemTTL <|> ttl
| otherwise = Nothing
where
TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference)
contactTimedTTL :: Contact -> Maybe (Maybe Int)
contactTimedTTL Contact {mergedPreferences = ContactUserPreferences {timedMessages = ContactUserPreference {enabled, userPreference}}}
| forUser enabled && forContact enabled = Just ttl
| otherwise = Nothing
where
TimedMessagesPreference {ttl} = preference (userPreference :: ContactUserPref TimedMessagesPreference)
groupTimedTTL :: GroupInfo -> Maybe Int -> Maybe Int
groupTimedTTL
GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
itemTTL
| enable == FEOn = itemTTL <|> Just ttl
| otherwise = Nothing
groupTimedTTL :: GroupInfo -> Maybe (Maybe Int)
groupTimedTTL GroupInfo {fullGroupPreferences = FullGroupPreferences {timedMessages = TimedMessagesGroupPreference {enable, ttl}}}
| enable == FEOn = Just $ Just ttl
| otherwise = Nothing
rcvContactCITimed :: Contact -> Maybe Int -> Maybe CITimed
rcvContactCITimed ct itemTTL = rcvCITimed_ $ contactTimedTTL ct itemTTL
rcvContactCITimed = rcvCITimed_ . contactTimedTTL
rcvGroupCITimed :: GroupInfo -> Maybe Int -> Maybe CITimed
rcvGroupCITimed g itemTTL = rcvCITimed_ $ groupTimedTTL g itemTTL
rcvGroupCITimed = rcvCITimed_ . groupTimedTTL
rcvCITimed_ :: Maybe Int -> Maybe CITimed
rcvCITimed_ rcvTTL = (`CITimed` Nothing) <$> rcvTTL
rcvCITimed_ :: Maybe (Maybe Int) -> Maybe Int -> Maybe CITimed
rcvCITimed_ chatTTL itemTTL = (`CITimed` Nothing) <$> (chatTTL >> itemTTL)
data CIQuote (c :: ChatType) = CIQuote
{ chatDir :: CIQDirection c,