mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-09-11 15:47:22 +00:00
core, ui: allow to choose disappearing messages ttl in user profile (#6097)
This commit is contained in:
spaced4ndy
@@ -187,11 +187,12 @@ createOrUpdateContactRequest
|
||||
| otherwise = createContact'
|
||||
where
|
||||
createContact' = do
|
||||
let ctUserPreferences = newContactUserPrefs user profile
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(profileId, ldn, userId, currentTs, currentTs, currentTs, BI True, contactRequestId)
|
||||
"INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(profileId, ctUserPreferences, ldn, userId, currentTs, currentTs, currentTs, BI True, contactRequestId)
|
||||
contactId <- liftIO $ insertedRowId db
|
||||
liftIO $
|
||||
DB.execute
|
||||
@@ -202,7 +203,7 @@ createOrUpdateContactRequest
|
||||
ct <- getContact db vr user contactId
|
||||
pure $ RSCurrentRequest Nothing ucr (Just $ REContact ct)
|
||||
createBusinessChat = do
|
||||
let Profile {preferences = userPreferences} = userProfileToSend' user Nothing Nothing True
|
||||
let Profile {preferences = userPreferences} = userProfileInGroup user Nothing
|
||||
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs userPreferences
|
||||
(gInfo@GroupInfo {groupId}, clientMember) <-
|
||||
createBusinessRequestGroup db vr gVar user cReqChatVRange profile profileId ldn groupPreferences
|
||||
|
||||
@@ -107,7 +107,7 @@ import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), UserId, connMode)
|
||||
import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), UserId)
|
||||
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
|
||||
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
|
||||
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
||||
@@ -343,58 +343,33 @@ createIncognitoProfile db User {userId} p = do
|
||||
createdAt <- getCurrentTime
|
||||
createIncognitoProfile_ db userId createdAt p
|
||||
|
||||
createPreparedContact :: DB.Connection -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
|
||||
createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToConnect@(ACCL m _) welcomeSharedMsgId = do
|
||||
createPreparedContact :: DB.Connection -> VersionRangeChat -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
|
||||
createPreparedContact db vr user p connLinkToConnect welcomeSharedMsgId = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId p prepared "" Nothing currentTs
|
||||
let profile = toLocalProfile profileId p ""
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences False
|
||||
pure $
|
||||
Contact
|
||||
{ contactId,
|
||||
localDisplayName,
|
||||
profile,
|
||||
activeConn = Nothing,
|
||||
viaGroup = Nothing,
|
||||
contactUsed = True,
|
||||
contactStatus = CSActive,
|
||||
chatSettings = defaultChatSettings,
|
||||
userPreferences,
|
||||
mergedPreferences,
|
||||
createdAt = currentTs,
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
preparedContact = Just PreparedContact {connLinkToConnect, uiConnLinkType = connMode m, welcomeSharedMsgId, requestSharedMsgId = Nothing},
|
||||
contactRequestId = Nothing,
|
||||
contactGroupMemberId = Nothing,
|
||||
contactGrpInvSent = False,
|
||||
chatTags = [],
|
||||
chatItemTTL = Nothing,
|
||||
uiThemes = Nothing,
|
||||
chatDeleted = False,
|
||||
customData = Nothing
|
||||
}
|
||||
ctUserPreferences = newContactUserPrefs user p
|
||||
contactId <- createContact_ db user p ctUserPreferences prepared "" Nothing currentTs
|
||||
getContact db vr user contactId
|
||||
|
||||
updatePreparedContactUser :: DB.Connection -> VersionRangeChat -> User -> Contact -> User -> ExceptT StoreError IO Contact
|
||||
updatePreparedContactUser
|
||||
db
|
||||
vr
|
||||
user
|
||||
Contact {contactId, localDisplayName = oldLDN, profile = LocalProfile {profileId, displayName}}
|
||||
Contact {contactId, localDisplayName = oldLDN, profile = profile@LocalProfile {profileId, displayName}}
|
||||
newUser@User {userId = newUserId} = do
|
||||
ExceptT . withLocalDisplayName db newUserId displayName $ \newLDN -> runExceptT $ do
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
let ctUserPreferences = newContactUserPrefs newUser (fromLocalProfile profile)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contacts
|
||||
SET user_id = ?, local_display_name = ?, updated_at = ?
|
||||
SET user_id = ?, local_display_name = ?, user_preferences = ?, updated_at = ?
|
||||
WHERE contact_id = ?
|
||||
|]
|
||||
(newUserId, newLDN, currentTs, contactId)
|
||||
(newUserId, newLDN, ctUserPreferences, currentTs, contactId)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
@@ -406,39 +381,13 @@ updatePreparedContactUser
|
||||
safeDeleteLDN db user oldLDN
|
||||
getContact db vr newUser contactId
|
||||
|
||||
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
|
||||
createDirectContact :: DB.Connection -> VersionRangeChat -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db vr user Connection {connId, localAlias} p = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId p Nothing localAlias Nothing currentTs
|
||||
let ctUserPreferences = newContactUserPrefs user p
|
||||
contactId <- createContact_ db user p ctUserPreferences Nothing localAlias Nothing currentTs
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
|
||||
let profile = toLocalProfile profileId p localAlias
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $
|
||||
Contact
|
||||
{ contactId,
|
||||
localDisplayName,
|
||||
profile,
|
||||
activeConn = Just conn,
|
||||
viaGroup = Nothing,
|
||||
contactUsed = True,
|
||||
contactStatus = CSActive,
|
||||
chatSettings = defaultChatSettings,
|
||||
userPreferences,
|
||||
mergedPreferences,
|
||||
createdAt = currentTs,
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
preparedContact = Nothing,
|
||||
contactRequestId = Nothing,
|
||||
contactGroupMemberId = Nothing,
|
||||
contactGrpInvSent = False,
|
||||
chatTags = [],
|
||||
chatItemTTL = Nothing,
|
||||
uiThemes = Nothing,
|
||||
chatDeleted = False,
|
||||
customData = Nothing
|
||||
}
|
||||
getContact db vr user contactId
|
||||
|
||||
deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
|
||||
deleteContactConnections db User {userId} Contact {contactId} = do
|
||||
|
||||
@@ -320,7 +320,7 @@ updateUserProfile db user p'
|
||||
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, image, localAlias}, userMemberProfileUpdatedAt} = user
|
||||
Profile {displayName = newName, fullName = newFullName, image = newImage, preferences} = p'
|
||||
profile = toLocalProfile profileId p' localAlias
|
||||
fullPreferences = mergePreferences Nothing preferences
|
||||
fullPreferences = fullPreferences' preferences
|
||||
|
||||
setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User
|
||||
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do
|
||||
|
||||
@@ -745,7 +745,7 @@ SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE contacts
|
||||
SET user_id = ?, local_display_name = ?, updated_at = ?
|
||||
SET user_id = ?, local_display_name = ?, user_preferences = ?, updated_at = ?
|
||||
WHERE contact_id = ?
|
||||
|
||||
Plan:
|
||||
@@ -5715,15 +5715,15 @@ Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image
|
||||
Plan:
|
||||
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
|
||||
|
||||
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?)
|
||||
Plan:
|
||||
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
|
||||
|
||||
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)
|
||||
Plan:
|
||||
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
|
||||
|
||||
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
Query: INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?,?)
|
||||
Plan:
|
||||
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
|
||||
|
||||
Query: INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
Plan:
|
||||
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
|
||||
|
||||
|
||||
@@ -382,12 +382,12 @@ setCommandConnId db User {userId} cmdId connId = do
|
||||
(connId, updatedAt, userId, cmdId)
|
||||
|
||||
createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
|
||||
createContact db User {userId} profile = do
|
||||
createContact db user profile = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
void $ createContact_ db userId profile Nothing "" Nothing currentTs
|
||||
void $ createContact_ db user profile emptyChatPrefs Nothing "" Nothing currentTs
|
||||
|
||||
createContact_ :: DB.Connection -> UserId -> Profile -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
|
||||
createContact_ db userId Profile {displayName, fullName, shortDescr, image, contactLink, preferences} prepared localAlias viaGroup currentTs =
|
||||
createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO ContactId
|
||||
createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, preferences} ctUserPreferences prepared localAlias viaGroup currentTs =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
DB.execute
|
||||
db
|
||||
@@ -396,10 +396,31 @@ createContact_ db userId Profile {displayName, fullName, shortDescr, image, cont
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared)
|
||||
"INSERT INTO contacts (contact_profile_id, user_preferences, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((profileId, ctUserPreferences, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared)
|
||||
contactId <- insertedRowId db
|
||||
pure $ Right (ldn, contactId, profileId)
|
||||
pure $ Right contactId
|
||||
|
||||
newContactUserPrefs :: User -> Profile -> Preferences
|
||||
newContactUserPrefs User {fullPreferences = FullPreferences {timedMessages = userTM}} Profile {preferences} =
|
||||
let ctTM_ = chatPrefSel SCFTimedMessages =<< preferences
|
||||
ctUserTM' = newContactUserTMPref userTM ctTM_
|
||||
in emptyChatPrefs {timedMessages = ctUserTM'}
|
||||
where
|
||||
newContactUserTMPref :: TimedMessagesPreference -> Maybe TimedMessagesPreference -> Maybe TimedMessagesPreference
|
||||
newContactUserTMPref userTMPref ctTMPref_ =
|
||||
case (userTMPref, ctTMPref_) of
|
||||
(TimedMessagesPreference {allow = FANo}, _) -> Nothing
|
||||
(_, Nothing) -> Nothing
|
||||
(_, Just TimedMessagesPreference {allow = FANo}) -> Nothing
|
||||
(TimedMessagesPreference {allow = userAllow, ttl = userTTL_}, Just TimedMessagesPreference {ttl = ctTTL_}) ->
|
||||
case (userTTL_, ctTTL_) of
|
||||
(Just userTTL, Just ctTTL) -> Just $ override (max userTTL ctTTL)
|
||||
(Just userTTL, Nothing) -> Just $ override userTTL
|
||||
(Nothing, Just ctTTL) -> Just $ override ctTTL
|
||||
(Nothing, Nothing) -> Nothing
|
||||
where
|
||||
override overrideTTL = TimedMessagesPreference {allow = userAllow, ttl = Just overrideTTL}
|
||||
|
||||
type NewPreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe SharedMsgId)
|
||||
|
||||
@@ -496,7 +517,7 @@ toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, dis
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes}
|
||||
where
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = mergePreferences Nothing userPreferences
|
||||
fullPreferences = fullPreferences' userPreferences
|
||||
viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
|
||||
|
||||
toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, Maybe GroupLinkId, Maybe Int64, Maybe ConnReqInvitation, Maybe ShortLinkInvitation, LocalAlias, UTCTime, UTCTime) -> PendingContactConnection
|
||||
|
||||
Reference in New Issue
Block a user