mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-24 08:45:31 +00:00
core: members profile update, create profile update chat items (#3644)
This commit is contained in:
spaced4ndy
+75
-20
@@ -1030,7 +1030,7 @@ processChatCommand' vr = \case
|
||||
filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo
|
||||
withChatLock "deleteChat group" . procCmd $ do
|
||||
deleteFilesAndConns user filesInfo
|
||||
when (memberActive membership && isOwner) . void $ sendGroupMessage user gInfo members XGrpDel
|
||||
when (memberActive membership && isOwner) . void $ sendGroupMessage' user gInfo members XGrpDel
|
||||
deleteGroupLinkIfExists user gInfo
|
||||
deleteMembersConnections user members
|
||||
-- functions below are called in separate transactions to prevent crashes on android
|
||||
@@ -1746,7 +1746,7 @@ processChatCommand' vr = \case
|
||||
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user groupId
|
||||
withChatLock "leaveGroup" . procCmd $ do
|
||||
(msg, _) <- sendGroupMessage user gInfo members XGrpLeave
|
||||
(msg, _) <- sendGroupMessage' user gInfo members XGrpLeave
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
|
||||
toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
|
||||
-- TODO delete direct connections that were unused
|
||||
@@ -3918,7 +3918,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
ms = introducedMembers <> invitedMembers
|
||||
msg = XGrpMsgForward memberId chatMsg' brokerTs
|
||||
unless (null ms) . void $
|
||||
sendGroupMessage user gInfo ms msg
|
||||
sendGroupMessage' user gInfo ms msg
|
||||
RCVD msgMeta msgRcpt ->
|
||||
withAckMessage' agentConnId conn msgMeta $
|
||||
groupMsgReceived gInfo m conn msgMeta msgRcpt
|
||||
@@ -4849,20 +4849,23 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
|
||||
processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact
|
||||
processContactProfileUpdate c@Contact {profile = p} p' createItems
|
||||
| fromLocalProfile p /= p' = do
|
||||
processContactProfileUpdate c@Contact {profile = lp} p' createItems
|
||||
| p /= p' = do
|
||||
c' <- withStore $ \db ->
|
||||
if userTTL == rcvTTL
|
||||
then updateContactProfile db user c p'
|
||||
else do
|
||||
c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
|
||||
updateContactProfile db user c' p'
|
||||
when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c'
|
||||
when (directOrUsed c' && createItems) $ do
|
||||
createProfileUpdatedItem c'
|
||||
createRcvFeatureItems user c c'
|
||||
toView $ CRContactUpdated user c c'
|
||||
pure c'
|
||||
| otherwise =
|
||||
pure c
|
||||
where
|
||||
p = fromLocalProfile lp
|
||||
Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
|
||||
userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs
|
||||
Profile {preferences = rcvPrefs_} = p'
|
||||
@@ -4876,32 +4879,62 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
| rcvTTL /= userDefaultTTL -> Just (userDefault :: TimedMessagesPreference) {ttl = rcvTTL}
|
||||
| otherwise -> Nothing
|
||||
in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs
|
||||
createProfileUpdatedItem c' =
|
||||
when visibleProfileUpdated $ do
|
||||
let ciContent = CIRcvDirectEvent $ RDEProfileUpdated p p'
|
||||
createInternalChatItem user (CDDirectRcv c') ciContent Nothing
|
||||
where
|
||||
visibleProfileUpdated =
|
||||
n' /= n || fn' /= fn || i' /= i || cl' /= cl
|
||||
Profile {displayName = n, fullName = fn, image = i, contactLink = cl} = p
|
||||
Profile {displayName = n', fullName = fn', image = i', contactLink = cl'} = p'
|
||||
|
||||
xInfoMember :: GroupInfo -> GroupMember -> Profile -> m ()
|
||||
xInfoMember gInfo m p' = void $ processMemberProfileUpdate gInfo m p'
|
||||
xInfoMember gInfo m p' = void $ processMemberProfileUpdate gInfo m p' True
|
||||
|
||||
xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> m ()
|
||||
xGrpLinkMem gInfo@GroupInfo {membership} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do
|
||||
xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
|
||||
if viaGroupLink && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
|
||||
then do
|
||||
m' <- processMemberProfileUpdate gInfo m p'
|
||||
m' <- processMemberProfileUpdate gInfo m p' False
|
||||
withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True
|
||||
let connectedIncognito = memberIncognito membership
|
||||
probeMatchingMemberContact m' connectedIncognito
|
||||
else messageError "x.grp.link.mem error: invalid group link host profile update"
|
||||
|
||||
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> m GroupMember
|
||||
processMemberProfileUpdate gInfo m@GroupMember {memberContactId} p' =
|
||||
case memberContactId of
|
||||
Nothing -> do
|
||||
m' <- withStore $ \db -> updateMemberProfile db user m p'
|
||||
toView $ CRGroupMemberUpdated user gInfo m m'
|
||||
pure m'
|
||||
Just mContactId -> do
|
||||
mCt <- withStore $ \db -> getContact db user mContactId
|
||||
Contact {profile} <- processContactProfileUpdate mCt p' True
|
||||
pure m {memberProfile = profile}
|
||||
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> m GroupMember
|
||||
processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems
|
||||
| redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' =
|
||||
case memberContactId of
|
||||
Nothing -> do
|
||||
m' <- withStore $ \db -> updateMemberProfile db user m p'
|
||||
createProfileUpdatedItem m'
|
||||
toView $ CRGroupMemberUpdated user gInfo m m'
|
||||
pure m'
|
||||
Just mContactId -> do
|
||||
mCt <- withStore $ \db -> getContact db user mContactId
|
||||
if canUpdateProfile mCt
|
||||
then do
|
||||
(m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p'
|
||||
createProfileUpdatedItem m'
|
||||
toView $ CRGroupMemberUpdated user gInfo m m'
|
||||
toView $ CRContactUpdated user mCt ct'
|
||||
pure m'
|
||||
else pure m
|
||||
where
|
||||
canUpdateProfile ct
|
||||
| not (contactActive ct) = True
|
||||
| otherwise = case contactConn ct of
|
||||
Nothing -> True
|
||||
Just conn -> not (connReady conn) || (authErrCounter conn >= 1)
|
||||
| otherwise =
|
||||
pure m
|
||||
where
|
||||
createProfileUpdatedItem m' =
|
||||
when createItems $ do
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p'
|
||||
createInternalChatItem user (CDGroupRcv gInfo m') ciContent Nothing
|
||||
|
||||
createFeatureEnabledItems :: Contact -> m ()
|
||||
createFeatureEnabledItems ct@Contact {mergedPreferences} =
|
||||
@@ -5835,7 +5868,29 @@ deliverMessagesB msgReqs = do
|
||||
Right <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId
|
||||
|
||||
sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
|
||||
sendGroupMessage user GroupInfo {groupId} members chatMsgEvent = do
|
||||
sendGroupMessage user gInfo members chatMsgEvent = do
|
||||
when shouldSendProfileUpdate $
|
||||
sendProfileUpdate `catchChatError` (\e -> toView (CRChatError (Just user) e))
|
||||
sendGroupMessage' user gInfo members chatMsgEvent
|
||||
where
|
||||
User {profile = p, userMemberProfileUpdatedAt} = user
|
||||
GroupInfo {userMemberProfileSentAt} = gInfo
|
||||
shouldSendProfileUpdate
|
||||
| incognitoMembership gInfo = False
|
||||
| otherwise =
|
||||
case (userMemberProfileSentAt, userMemberProfileUpdatedAt) of
|
||||
(Just lastSentTs, Just lastUpdateTs) -> lastSentTs < lastUpdateTs
|
||||
(Nothing, Just _) -> True
|
||||
_ -> False
|
||||
sendProfileUpdate = do
|
||||
let members' = filter (\m -> isCompatibleRange (memberChatVRange' m) memberProfileUpdateVRange) members
|
||||
profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p
|
||||
void $ sendGroupMessage' user gInfo members' profileUpdateEvent
|
||||
currentTs <- liftIO getCurrentTime
|
||||
withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs
|
||||
|
||||
sendGroupMessage' :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
|
||||
sendGroupMessage' user GroupInfo {groupId} members chatMsgEvent = do
|
||||
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId)
|
||||
recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
|
||||
let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent}
|
||||
|
||||
@@ -169,7 +169,9 @@ ciRequiresAttention content = case msgDirection @d of
|
||||
CIRcvIntegrityError _ -> True
|
||||
CIRcvDecryptionError {} -> True
|
||||
CIRcvGroupInvitation {} -> True
|
||||
CIRcvDirectEvent _ -> False
|
||||
CIRcvDirectEvent rde -> case rde of
|
||||
RDEContactDeleted -> False
|
||||
RDEProfileUpdated {} -> True
|
||||
CIRcvGroupEvent rge -> case rge of
|
||||
RGEMemberAdded {} -> False
|
||||
RGEMemberConnected -> False
|
||||
@@ -182,6 +184,7 @@ ciRequiresAttention content = case msgDirection @d of
|
||||
RGEGroupUpdated _ -> False
|
||||
RGEInvitedViaGroupLink -> False
|
||||
RGEMemberCreatedContact -> False
|
||||
RGEMemberProfileUpdated {} -> False
|
||||
CIRcvConnEvent _ -> True
|
||||
CIRcvChatFeature {} -> False
|
||||
CIRcvChatPreference {} -> False
|
||||
@@ -252,6 +255,7 @@ ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayN
|
||||
rcvDirectEventToText :: RcvDirectEvent -> Text
|
||||
rcvDirectEventToText = \case
|
||||
RDEContactDeleted -> "contact deleted"
|
||||
RDEProfileUpdated {} -> "updated profile"
|
||||
|
||||
rcvGroupEventToText :: RcvGroupEvent -> Text
|
||||
rcvGroupEventToText = \case
|
||||
@@ -266,6 +270,7 @@ rcvGroupEventToText = \case
|
||||
RGEGroupUpdated _ -> "group profile updated"
|
||||
RGEInvitedViaGroupLink -> "invited via your group link"
|
||||
RGEMemberCreatedContact -> "started direct connection with you"
|
||||
RGEMemberProfileUpdated {} -> "updated profile"
|
||||
|
||||
sndGroupEventToText :: SndGroupEvent -> Text
|
||||
sndGroupEventToText = \case
|
||||
|
||||
@@ -25,6 +25,7 @@ data RcvGroupEvent
|
||||
-- and be created as unread without adding / working around new status for sent items
|
||||
| RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
|
||||
| RGEMemberCreatedContact -- CRNewMemberContactReceivedInv
|
||||
| RGEMemberProfileUpdated {fromProfile :: Profile, toProfile :: Profile} -- CRGroupMemberUpdated
|
||||
deriving (Show)
|
||||
|
||||
data SndGroupEvent
|
||||
@@ -47,8 +48,8 @@ data SndConnEvent
|
||||
deriving (Show)
|
||||
|
||||
data RcvDirectEvent
|
||||
= -- RDEProfileChanged {...}
|
||||
RDEContactDeleted
|
||||
= RDEContactDeleted
|
||||
| RDEProfileUpdated {fromProfile :: Profile, toProfile :: Profile} -- CRContactUpdated
|
||||
deriving (Show)
|
||||
|
||||
-- platform-specific JSON encoding (used in API)
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20240104_members_profile_update where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20240104_members_profile_update :: Query
|
||||
m20240104_members_profile_update =
|
||||
[sql|
|
||||
ALTER TABLE users ADD COLUMN user_member_profile_updated_at TEXT;
|
||||
ALTER TABLE groups ADD COLUMN user_member_profile_sent_at TEXT;
|
||||
|]
|
||||
|
||||
down_m20240104_members_profile_update :: Query
|
||||
down_m20240104_members_profile_update =
|
||||
[sql|
|
||||
ALTER TABLE groups DROP COLUMN user_member_profile_sent_at;
|
||||
ALTER TABLE users DROP COLUMN user_member_profile_updated_at;
|
||||
|]
|
||||
@@ -33,7 +33,8 @@ CREATE TABLE users(
|
||||
view_pwd_salt BLOB,
|
||||
show_ntfs INTEGER NOT NULL DEFAULT 1,
|
||||
send_rcpts_contacts INTEGER NOT NULL DEFAULT 0,
|
||||
send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0, -- 1 for active user
|
||||
send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0,
|
||||
user_member_profile_updated_at TEXT, -- 1 for active user
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
@@ -118,7 +119,8 @@ CREATE TABLE groups(
|
||||
chat_ts TEXT,
|
||||
favorite INTEGER NOT NULL DEFAULT 0,
|
||||
send_rcpts INTEGER,
|
||||
via_group_link_uri_hash BLOB, -- received
|
||||
via_group_link_uri_hash BLOB,
|
||||
user_member_profile_sent_at TEXT, -- received
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
|
||||
@@ -54,7 +54,7 @@ import Simplex.Messaging.Version hiding (version)
|
||||
-- This indirection is needed for backward/forward compatibility testing.
|
||||
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
|
||||
currentChatVersion :: Version
|
||||
currentChatVersion = 6
|
||||
currentChatVersion = 7
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
supportedChatVRange :: VersionRange
|
||||
@@ -84,6 +84,10 @@ batchSendVRange = mkVersionRange 5 currentChatVersion
|
||||
groupHistoryIncludeWelcomeVRange :: VersionRange
|
||||
groupHistoryIncludeWelcomeVRange = mkVersionRange 6 currentChatVersion
|
||||
|
||||
-- version range that supports sending member profile updates to groups
|
||||
memberProfileUpdateVRange :: VersionRange
|
||||
memberProfileUpdateVRange = mkVersionRange 7 currentChatVersion
|
||||
|
||||
data ConnectionEntity
|
||||
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
|
||||
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
|
||||
|
||||
@@ -96,7 +96,9 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
|
||||
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
||||
@@ -9,9 +9,11 @@
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
module Simplex.Chat.Store.Direct
|
||||
( updateContact_,
|
||||
( updateContactLDN_,
|
||||
updateContactProfile_,
|
||||
updateContactProfile_',
|
||||
updateMemberContactProfile_,
|
||||
updateMemberContactProfile_',
|
||||
deleteContactProfile_,
|
||||
deleteUnusedProfile_,
|
||||
|
||||
@@ -316,7 +318,7 @@ updateContactProfile db user@User {userId} c p'
|
||||
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
||||
currentTs <- getCurrentTime
|
||||
updateContactProfile_' db userId profileId p' currentTs
|
||||
updateContact_ db userId contactId localDisplayName ldn currentTs
|
||||
updateContactLDN_ db userId contactId localDisplayName ldn currentTs
|
||||
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
|
||||
where
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
|
||||
@@ -453,8 +455,25 @@ updateContactProfile_' db userId profileId Profile {displayName, fullName, image
|
||||
|]
|
||||
(displayName, fullName, image, contactLink, preferences, updatedAt, userId, profileId)
|
||||
|
||||
updateContact_ :: DB.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
|
||||
updateContact_ db userId contactId displayName newName updatedAt = do
|
||||
-- update only member profile fields
|
||||
updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
|
||||
updateMemberContactProfile_ db userId profileId profile = do
|
||||
currentTs <- getCurrentTime
|
||||
updateMemberContactProfile_' db userId profileId profile currentTs
|
||||
|
||||
updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
|
||||
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, image} updatedAt = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET display_name = ?, full_name = ?, image = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
(displayName, fullName, image, updatedAt, userId, profileId)
|
||||
|
||||
updateContactLDN_ :: DB.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
|
||||
updateContactLDN_ db userId contactId displayName newName updatedAt = do
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE contacts SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
|
||||
|
||||
@@ -108,10 +108,12 @@ module Simplex.Chat.Store.Groups
|
||||
updateMemberContactInvited,
|
||||
resetMemberContactFields,
|
||||
updateMemberProfile,
|
||||
updateContactMemberProfile,
|
||||
getXGrpLinkMemReceived,
|
||||
setXGrpLinkMemReceived,
|
||||
createNewUnknownGroupMember,
|
||||
updateUnknownMemberAnnounced,
|
||||
updateUserMemberProfileSentAt,
|
||||
)
|
||||
where
|
||||
|
||||
@@ -143,19 +145,19 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
|
||||
import Simplex.Messaging.Version
|
||||
import UnliftIO.STM
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. GroupMemberRow
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
|
||||
|
||||
toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) =
|
||||
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
fullGroupPreferences = mergeGroupPreferences groupPreferences
|
||||
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs}
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt}
|
||||
|
||||
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
@@ -261,7 +263,9 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
|
||||
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
@@ -310,13 +314,31 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO groups (local_display_name, user_id, group_profile_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
|
||||
(ldn, userId, profileId, True, currentTs, currentTs, currentTs)
|
||||
[sql|
|
||||
INSERT INTO groups
|
||||
(local_display_name, user_id, group_profile_id, enable_ntfs,
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at)
|
||||
VALUES (?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(ldn, userId, profileId, True, currentTs, currentTs, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
memberId <- liftIO $ encodedRandomBytes gVar 12
|
||||
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs vr
|
||||
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
|
||||
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}
|
||||
pure
|
||||
GroupInfo
|
||||
{ groupId,
|
||||
localDisplayName = ldn,
|
||||
groupProfile,
|
||||
fullGroupPreferences,
|
||||
membership,
|
||||
hostConnCustomUserProfileId = Nothing,
|
||||
chatSettings,
|
||||
createdAt = currentTs,
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
userMemberProfileSentAt = Just currentTs
|
||||
}
|
||||
|
||||
-- | creates a new group record for the group the current user was invited to, or returns an existing one
|
||||
createGroupInvitation :: DB.Connection -> VersionRange -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
|
||||
@@ -356,14 +378,34 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
|
||||
[sql|
|
||||
INSERT INTO groups
|
||||
(group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs,
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
let JVersionRange hostVRange = peerChatVRange
|
||||
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
|
||||
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr
|
||||
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
|
||||
pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId)
|
||||
pure
|
||||
( GroupInfo
|
||||
{ groupId,
|
||||
localDisplayName,
|
||||
groupProfile,
|
||||
fullGroupPreferences,
|
||||
membership,
|
||||
hostConnCustomUserProfileId = customUserProfileId,
|
||||
chatSettings,
|
||||
createdAt = currentTs,
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
userMemberProfileSentAt = Just currentTs
|
||||
},
|
||||
groupMemberId
|
||||
)
|
||||
|
||||
getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
|
||||
getHostMemberId_ db User {userId} groupId =
|
||||
@@ -459,8 +501,13 @@ createGroupInvitedViaLink
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO groups (group_profile_id, local_display_name, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
|
||||
[sql|
|
||||
INSERT INTO groups
|
||||
(group_profile_id, local_display_name, host_conn_custom_user_profile_id, user_id, enable_ntfs,
|
||||
created_at, updated_at, chat_ts, user_member_profile_sent_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
insertHost_ currentTs groupId = do
|
||||
let fromMemberProfile = profileFromName fromMemberName
|
||||
@@ -564,7 +611,10 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
|
||||
SELECT
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
|
||||
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages,
|
||||
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
|
||||
FROM groups g
|
||||
@@ -1208,7 +1258,9 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
|
||||
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
@@ -1301,7 +1353,9 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
|
||||
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
@@ -1936,12 +1990,12 @@ createMemberContactConn_
|
||||
updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
|
||||
updateMemberProfile db User {userId} m p'
|
||||
| displayName == newName = do
|
||||
liftIO $ updateContactProfile_ db userId profileId p'
|
||||
liftIO $ updateMemberContactProfile_ db userId profileId p'
|
||||
pure m {memberProfile = profile}
|
||||
| otherwise =
|
||||
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
||||
currentTs <- getCurrentTime
|
||||
updateContactProfile_' db userId profileId p' currentTs
|
||||
updateMemberContactProfile_' db userId profileId p' currentTs
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
|
||||
@@ -1953,6 +2007,22 @@ updateMemberProfile db User {userId} m p'
|
||||
Profile {displayName = newName} = p'
|
||||
profile = toLocalProfile profileId p' localAlias
|
||||
|
||||
updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
|
||||
updateContactMemberProfile db User {userId} m ct@Contact {contactId} p'
|
||||
| displayName == newName = do
|
||||
liftIO $ updateMemberContactProfile_ db userId profileId p'
|
||||
pure (m {memberProfile = profile}, ct {profile})
|
||||
| otherwise =
|
||||
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
||||
currentTs <- getCurrentTime
|
||||
updateMemberContactProfile_' db userId profileId p' currentTs
|
||||
updateContactLDN_ db userId contactId localDisplayName ldn currentTs
|
||||
pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile})
|
||||
where
|
||||
GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
|
||||
Profile {displayName = newName} = p'
|
||||
profile = toLocalProfile profileId p' localAlias
|
||||
|
||||
getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
|
||||
getXGrpLinkMemReceived db mId =
|
||||
ExceptT . firstRow fromOnly (SEGroupMemberNotFound mId) $
|
||||
@@ -2014,3 +2084,10 @@ updateUnknownMemberAnnounced db user@User {userId} invitingMember unknownMember@
|
||||
getGroupMemberById db user groupMemberId
|
||||
where
|
||||
VersionRange minV maxV = maybe (fromJVersionRange memberChatVRange) fromChatVRange v
|
||||
|
||||
updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO ()
|
||||
updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs =
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE groups SET user_member_profile_sent_at = ? WHERE user_id = ? AND group_id = ?"
|
||||
(sentTs, userId, groupId)
|
||||
|
||||
@@ -95,6 +95,7 @@ import Simplex.Chat.Migrations.M20231207_chat_list_pagination
|
||||
import Simplex.Chat.Migrations.M20231214_item_content_tag
|
||||
import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
|
||||
import Simplex.Chat.Migrations.M20240102_note_folders
|
||||
import Simplex.Chat.Migrations.M20240104_members_profile_update
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -189,7 +190,8 @@ schemaMigrations =
|
||||
("20231207_chat_list_pagination", m20231207_chat_list_pagination, Just down_m20231207_chat_list_pagination),
|
||||
("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag),
|
||||
("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries),
|
||||
("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders)
|
||||
("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders),
|
||||
("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -121,8 +121,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
|
||||
(profileId, displayName, userId, True, currentTs, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
|
||||
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing)
|
||||
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing, Nothing)
|
||||
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
getUsersInfo db = getUsers db >>= mapM getUserInfo
|
||||
@@ -253,23 +252,32 @@ updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOv
|
||||
|
||||
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
|
||||
updateUserProfile db user p'
|
||||
| displayName == newName = do
|
||||
liftIO $ updateContactProfile_ db userId profileId p'
|
||||
pure user {profile, fullPreferences}
|
||||
| displayName == newName = liftIO $ do
|
||||
updateContactProfile_ db userId profileId p'
|
||||
currentTs <- getCurrentTime
|
||||
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
|
||||
pure user {profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
|
||||
| otherwise =
|
||||
checkConstraint SEDuplicateName . liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
|
||||
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
|
||||
(newName, newName, userId, currentTs, currentTs)
|
||||
updateContactProfile_' db userId profileId p' currentTs
|
||||
updateContact_ db userId userContactId localDisplayName newName currentTs
|
||||
pure user {localDisplayName = newName, profile, fullPreferences}
|
||||
updateContactLDN_ db userId userContactId localDisplayName newName currentTs
|
||||
pure user {localDisplayName = newName, profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
|
||||
where
|
||||
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}} = user
|
||||
Profile {displayName = newName, preferences} = p'
|
||||
updateUserMemberProfileUpdatedAt_ currentTs
|
||||
| userMemberProfileChanged = do
|
||||
DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (currentTs, userId)
|
||||
pure $ Just currentTs
|
||||
| otherwise = pure userMemberProfileUpdatedAt
|
||||
userMemberProfileChanged = newName /= displayName || newFullName /= fullName || newImage /= image
|
||||
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
|
||||
|
||||
|
||||
@@ -313,15 +313,15 @@ userQuery :: Query
|
||||
userQuery =
|
||||
[sql|
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at
|
||||
FROM users u
|
||||
JOIN contacts uct ON uct.contact_id = u.contact_id
|
||||
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|
||||
|]
|
||||
|
||||
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString) -> User
|
||||
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_)) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash}
|
||||
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime) -> User
|
||||
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt)) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt}
|
||||
where
|
||||
profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = mergePreferences Nothing userPreferences
|
||||
|
||||
@@ -112,7 +112,8 @@ data User = User
|
||||
viewPwdHash :: Maybe UserPwdHash,
|
||||
showNtfs :: Bool,
|
||||
sendRcptsContacts :: Bool,
|
||||
sendRcptsSmallGroups :: Bool
|
||||
sendRcptsSmallGroups :: Bool,
|
||||
userMemberProfileUpdatedAt :: Maybe UTCTime
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
@@ -346,7 +347,8 @@ data GroupInfo = GroupInfo
|
||||
chatSettings :: ChatSettings,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime,
|
||||
chatTs :: Maybe UTCTime
|
||||
chatTs :: Maybe UTCTime,
|
||||
userMemberProfileSentAt :: Maybe UTCTime
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -481,6 +483,10 @@ profilesMatch
|
||||
LocalProfile {displayName = n2, fullName = fn2, image = i2} =
|
||||
n1 == n2 && fn1 == fn2 && i1 == i2
|
||||
|
||||
redactedMemberProfile :: Profile -> Profile
|
||||
redactedMemberProfile Profile {displayName, fullName, image} =
|
||||
Profile {displayName, fullName, image, contactLink = Nothing, preferences = Nothing}
|
||||
|
||||
data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile
|
||||
|
||||
type LocalAlias = Text
|
||||
|
||||
@@ -1160,11 +1160,12 @@ viewGroupInfo GroupInfo {groupId} s =
|
||||
]
|
||||
|
||||
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString]
|
||||
viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias}, activeConn} stats =
|
||||
viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias, contactLink}, activeConn} stats =
|
||||
[ "group ID: " <> sShow groupId,
|
||||
"member ID: " <> sShow groupMemberId
|
||||
]
|
||||
<> maybe ["member not connected"] viewConnectionStats stats
|
||||
<> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact l)]) contactLink
|
||||
<> ["alias: " <> plain localAlias | localAlias /= ""]
|
||||
<> [viewConnectionVerified (memberSecurityCode m) | isJust stats]
|
||||
<> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn
|
||||
|
||||
Reference in New Issue
Block a user