core: contact aliases (#968)

This commit is contained in:
JRoberts
2022-08-24 19:03:43 +04:00
committed by GitHub
parent e6551abc68
commit 53a71cf28c
10 changed files with 147 additions and 77 deletions
+14 -7
View File
@@ -578,6 +578,11 @@ processChatCommand = \case
withCurrentCall contactId $ \userId ct call ->
updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
APIUpdateProfile profile -> withUser (`updateProfile` profile)
APISetContactAlias contactId localAlias -> withUser $ \User {userId} -> do
ct' <- withStore $ \db -> do
ct <- getContact db userId contactId
liftIO $ updateContactAlias db userId ct localAlias
pure $ CRContactAliasUpdated ct'
APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text
APIGetNtfToken -> withUser $ \_ -> crNtfToken <$> withAgent getNtfToken
APIRegisterToken token mode -> CRNtfTokenStatus <$> withUser (\_ -> withAgent $ \a -> registerNtfToken a token mode)
@@ -619,7 +624,7 @@ processChatCommand = \case
ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db userId contactId
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
connectionStats <- withAgent (`getConnectionServers` contactConnId ct)
pure $ CRContactInfo ct connectionStats incognitoProfile
pure $ CRContactInfo ct connectionStats (fmap fromLocalProfile incognitoProfile)
APIGroupMemberInfo gId gMemberId -> withUser $ \user@User {userId} -> do
-- [incognito] print group member main profile
(g, m@GroupMember {memberContactProfileId}) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
@@ -984,11 +989,11 @@ processChatCommand = \case
unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
(,) <$> getFileSize fsFilePath <*> asks (fileChunkSize . config)
updateProfile :: User -> Profile -> m ChatResponse
updateProfile user@User {profile = p@LocalProfile {profileId}} p'@Profile {displayName}
updateProfile user@User {profile = p@LocalProfile {profileId, localAlias}} p'@Profile {displayName}
| p' == fromLocalProfile p = pure CRUserProfileNoChange
| otherwise = do
withStore $ \db -> updateUserProfile db user p'
let user' = (user :: User) {localDisplayName = displayName, profile = toLocalProfile profileId p'}
let user' = (user :: User) {localDisplayName = displayName, profile = toLocalProfile profileId p' localAlias}
asks currentUser >>= atomically . (`writeTVar` Just user')
-- [incognito] filter out contacts with whom user has incognito connections
contacts <-
@@ -1365,7 +1370,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
CONF confId _ connInfo -> do
-- [incognito] send saved profile
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
let profileToSend = fromLocalProfile $ fromMaybe profile incognitoProfile
saveConnInfo conn connInfo
allowAgentConnection conn confId $ XInfo profileToSend
INFO connInfo ->
@@ -1430,7 +1435,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
Nothing -> do
-- [incognito] print incognito profile used for this contact
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
toView $ CRContactConnected ct incognitoProfile
toView $ CRContactConnected ct (fmap fromLocalProfile incognitoProfile)
setActive $ ActiveC c
showToast (c <> "> ") "connected"
forM_ viaUserContactLink $ \userContactLinkId -> do
@@ -1512,14 +1517,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
case memberCategory m of
GCHostMember -> do
-- [incognito] chat item & event with indication that host connected incognito
mainProfile <- if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
mainProfile <- fmap fromLocalProfile <$> if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
memberConnectedChatItem gInfo m mainProfile
toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} (memberIncognito membership)
setActive $ ActiveG gName
showToast ("#" <> gName) "you are connected to group"
GCInviteeMember -> do
-- [incognito] chat item & event with indication that invitee connected incognito
mainProfile <- if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
mainProfile <- fmap fromLocalProfile <$> if memberIncognito m then Just <$> withStore (\db -> getProfileById db userId memberContactProfileId) else pure Nothing
memberConnectedChatItem gInfo m mainProfile
toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected} mainProfile
setActive $ ActiveG gName
@@ -2575,6 +2580,7 @@ chatCommandP =
"/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP),
"/_call get" $> APIGetCallInvitations,
"/_profile " *> (APIUpdateProfile <$> jsonP),
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
"/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString),
"/_ntf get" $> APIGetNtfToken,
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
@@ -2685,6 +2691,7 @@ chatCommandP =
fullNameP name = do
n <- (A.space *> A.takeByteString) <|> pure ""
pure $ if B.null n then name else safeDecodeUtf8 n
textP = safeDecodeUtf8 <$> A.takeByteString
filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString
searchP = T.unpack . safeDecodeUtf8 <$> (" search=" *> A.takeByteString)
memberRole =
+3 -1
View File
@@ -133,6 +133,7 @@ data ChatCommand
| APIGetCallInvitations
| APICallStatus ContactId WebRTCCallStatus
| APIUpdateProfile Profile
| APISetContactAlias ContactId LocalAlias
| APIParseMarkdown Text
| APIGetNtfToken
| APIRegisterToken DeviceToken NotificationsMode
@@ -214,7 +215,7 @@ data ChatResponse
| CRUserSMPServers {smpServers :: [SMPServer]}
| CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
| CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats, mainProfile :: Maybe Profile}
| CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats, localMainProfile :: Maybe LocalProfile}
| CRNewChatItem {chatItem :: AChatItem}
| CRChatItemStatusUpdated {chatItem :: AChatItem}
| CRChatItemUpdated {chatItem :: AChatItem}
@@ -267,6 +268,7 @@ data ChatResponse
| CRSndFileRcvCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndGroupFileCancelled {chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {toContact :: Contact}
| CRContactConnecting {contact :: Contact}
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactAnotherClient {contact :: Contact}
@@ -0,0 +1,17 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20220824_profiles_local_alias where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20220824_profiles_local_alias :: Query
m20220824_profiles_local_alias =
[sql|
PRAGMA ignore_check_constraints=ON;
ALTER TABLE contact_profiles ADD COLUMN local_alias TEXT DEFAULT '' CHECK (local_alias NOT NULL);
UPDATE contact_profiles SET local_alias = '';
PRAGMA ignore_check_constraints=OFF;
|]
+2 -1
View File
@@ -14,7 +14,8 @@ CREATE TABLE contact_profiles(
updated_at TEXT CHECK(updated_at NOT NULL),
image TEXT,
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE,
incognito INTEGER
incognito INTEGER,
local_alias TEXT DEFAULT '' CHECK(local_alias NOT NULL)
);
CREATE INDEX contact_profiles_index ON contact_profiles(
display_name,
+73 -57
View File
@@ -38,6 +38,7 @@ module Simplex.Chat.Store
getContactIdByName,
updateUserProfile,
updateContactProfile,
updateContactAlias,
getUserContacts,
createUserContactLink,
getUserContactLinkConnections,
@@ -232,6 +233,7 @@ import Simplex.Chat.Migrations.M20220812_incognito_profiles
import Simplex.Chat.Migrations.M20220818_chat_notifications
import Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id
import Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items
import Simplex.Chat.Migrations.M20220824_profiles_local_alias
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -265,7 +267,8 @@ schemaMigrations =
("20220812_incognito_profiles", m20220812_incognito_profiles),
("20220818_chat_notifications", m20220818_chat_notifications),
("20220822_groups_host_conn_custom_user_profile_id", m20220822_groups_host_conn_custom_user_profile_id),
("20220823_delete_broken_group_event_chat_items", m20220823_delete_broken_group_event_chat_items)
("20220823_delete_broken_group_event_chat_items", m20220823_delete_broken_group_event_chat_items),
("20220824_profiles_local_alias", m20220824_profiles_local_alias)
]
-- | The list of migrations in ascending order by date
@@ -331,7 +334,7 @@ getUsers db =
toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData) -> User
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image) =
let profile = LocalProfile {profileId, displayName, fullName, image}
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias = ""}
in User {userId, userContactId, localDisplayName = displayName, profile, activeUser}
setActiveUser :: DB.Connection -> UserId -> IO ()
@@ -370,7 +373,7 @@ getConnReqContactXContactId db userId cReqHash = do
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, ct.enable_ntfs, ct.created_at, ct.updated_at,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.enable_ntfs, ct.created_at, ct.updated_at,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id, c.conn_status, c.conn_type,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
@@ -416,20 +419,20 @@ createIncognitoProfile_ db userId createdAt incognitoProfile =
(displayName, fullName, image, userId, Just True, createdAt, createdAt)
insertedRowId db
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO Profile
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById db userId profileId =
ExceptT . firstRow toProfile (SEProfileNotFound profileId) $
DB.query
db
[sql|
SELECT display_name, full_name, image
SELECT display_name, full_name, image, local_alias
FROM contact_profiles
WHERE user_id = ? AND contact_profile_id = ?
|]
(userId, profileId)
where
toProfile :: (ContactName, Text, Maybe ImageData) -> Profile
toProfile (displayName, fullName, image) = Profile {displayName, fullName, image}
toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias) -> LocalProfile
toProfile (displayName, fullName, image, localAlias) = LocalProfile {profileId, displayName, fullName, image, localAlias}
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection
createConnection_ db userId connType entityId acId viaContact viaUserContactLink customUserProfileId connLevel currentTs = do
@@ -453,7 +456,7 @@ createDirectContact :: DB.Connection -> UserId -> Connection -> Profile -> Excep
createDirectContact db userId activeConn@Connection {connId} profile = do
createdAt <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId connId profile Nothing createdAt
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile, activeConn, viaGroup = Nothing, chatSettings = defaultChatSettings, createdAt, updatedAt = createdAt}
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, chatSettings = defaultChatSettings, createdAt, updatedAt = createdAt}
createContact_ :: DB.Connection -> UserId -> Int64 -> Profile -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId connId Profile {displayName, fullName, image} viaGroup currentTs =
@@ -536,15 +539,28 @@ updateUserProfile db User {userId, userContactId, localDisplayName, profile = Lo
updateContact_ db userId userContactId localDisplayName newName currentTs
updateContactProfile :: DB.Connection -> UserId -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db userId c@Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName}} p'@Profile {displayName = newName}
updateContactProfile db userId c@Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}} p'@Profile {displayName = newName}
| displayName == newName =
liftIO $ updateContactProfile_ db userId profileId p' $> (c :: Contact) {profile = toLocalProfile profileId p'}
liftIO $ updateContactProfile_ db userId profileId p' $> (c :: Contact) {profile = toLocalProfile profileId p' localAlias}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId contactId localDisplayName ldn currentTs
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p'}
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias}
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do
updatedAt <- getCurrentTime
DB.execute
db
[sql|
UPDATE contact_profiles
SET local_alias = ?, updated_at = ?
WHERE user_id = ? AND contact_profile_id = ?
|]
(localAlias, updatedAt, userId, profileId)
pure $ (c :: Contact) {profile = lp {localAlias = localAlias}}
updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
updateContactProfile_ db userId profileId profile = do
@@ -574,18 +590,18 @@ updateContact_ db userId contactId displayName newName updatedAt = do
(newName, updatedAt, userId, contactId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId)
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe Bool, UTCTime, UTCTime)
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Maybe Bool, UTCTime, UTCTime)
toContact :: ContactRow :. ConnectionRow -> Contact
toContact ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image}
toContact ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
toContactOrError :: ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image}
toContactOrError ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in case toMaybeConnection connRow of
Just activeConn ->
@@ -769,7 +785,7 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, ct.enable_ntfs, ct.created_at, ct.updated_at,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.enable_ntfs, ct.created_at, ct.updated_at,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id, c.conn_status, c.conn_type,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
@@ -892,7 +908,7 @@ createAcceptedContact db userId agentConnId localDisplayName profileId profile u
(userId, localDisplayName, profileId, True, createdAt, createdAt, xContactId)
contactId <- insertedRowId db
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile, activeConn, viaGroup = Nothing, chatSettings = defaultChatSettings, createdAt = createdAt, updatedAt = createdAt}
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, chatSettings = defaultChatSettings, createdAt = createdAt, updatedAt = createdAt}
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do
@@ -1163,15 +1179,15 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
<$> DB.query
db
[sql|
SELECT c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, c.via_group, c.enable_ntfs, c.created_at, c.updated_at
SELECT c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.local_alias, c.via_group, c.enable_ntfs, c.created_at, c.updated_at
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ?
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe Int64, Maybe Bool, UTCTime, UTCTime)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, viaGroup, enableNtfs_, createdAt, updatedAt)] =
let profile = LocalProfile {profileId, displayName, fullName, image}
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Maybe Bool, UTCTime, UTCTime)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, enableNtfs_, createdAt, updatedAt)] =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
@@ -1188,10 +1204,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image,
pu.display_name, pu.full_name, pu.image, pu.local_alias,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
@@ -1276,10 +1292,10 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image,
pu.display_name, pu.full_name, pu.image, pu.local_alias,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM group_members m
@@ -1367,10 +1383,10 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe Profile -> UTCTime -> ExceptT StoreError IO GroupMember
createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfile createdAt = do
customUserProfileId <- liftIO $ createIncognitoProfile_ db userId createdAt incognitoProfile
(localDisplayName, memberProfile) <- case (incognitoProfile, customUserProfileId) of
incognitoProfileId <- liftIO $ createIncognitoProfile_ db userId createdAt incognitoProfile
(localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
(Just profile@Profile {displayName}, Just profileId) ->
(,toLocalProfile profileId profile) <$> insertMemberIncognitoProfile_ displayName profileId
(,toLocalProfile profileId profile "") <$> insertMemberIncognitoProfile_ displayName profileId
_ -> (,profile' userOrContact) <$> liftIO insertMember_
groupMemberId <- liftIO $ insertedRowId db
pure
@@ -1476,7 +1492,7 @@ getUserGroupDetails db User {userId, userContactId} =
[sql|
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status,
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.local_alias
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
@@ -1506,7 +1522,7 @@ getGroupMember db user@User {userId} groupId groupMemberId =
[sql|
SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM group_members m
@@ -1528,7 +1544,7 @@ getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do
[sql|
SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM group_members m
@@ -1566,20 +1582,20 @@ getGroupInvitation db user groupId = do
findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
findFromContact _ = const Nothing
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData))
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, LocalAlias))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe LocalAlias))
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image)) =
let memberProfile = LocalProfile {profileId, displayName, fullName, image}
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias)) =
let memberProfile = LocalProfile {profileId, displayName, fullName, image, localAlias}
invitedBy = toInvitedBy userContactId invitedById
activeConn = Nothing
in GroupMember {..}
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image))
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, Just localAlias)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias))
toMaybeGroupMember _ _ = Nothing
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> ExceptT StoreError IO GroupMember
@@ -1647,8 +1663,8 @@ updateGroupMemberStatus db userId GroupMember {groupMemberId} memStatus = do
createMemberIncognitoProfile :: DB.Connection -> UserId -> GroupMember -> Maybe Profile -> ExceptT StoreError IO GroupMember
createMemberIncognitoProfile db userId m@GroupMember {groupMemberId} incognitoProfile = do
currentTs <- liftIO getCurrentTime
customUserProfileId <- liftIO $ createIncognitoProfile_ db userId currentTs incognitoProfile
case (incognitoProfile, customUserProfileId) of
incognitoProfileId <- liftIO $ createIncognitoProfile_ db userId currentTs incognitoProfile
case (incognitoProfile, incognitoProfileId) of
(Just profile@Profile {displayName}, Just profileId) ->
ExceptT $
withLocalDisplayName db userId displayName $ \incognitoLdn -> do
@@ -1660,7 +1676,7 @@ createMemberIncognitoProfile db userId m@GroupMember {groupMemberId} incognitoPr
WHERE user_id = ? AND group_member_id = ?
|]
(incognitoLdn, profileId, currentTs, userId, groupMemberId)
pure . Right $ m {localDisplayName = incognitoLdn, memberProfile = toLocalProfile profileId profile}
pure . Right $ m {localDisplayName = incognitoLdn, memberProfile = toLocalProfile profileId profile ""}
_ -> pure m
-- | add new member with profile
@@ -1712,7 +1728,7 @@ createNewMember_
|]
(groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
groupMemberId <- insertedRowId db
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile, memberContactId, memberContactProfileId, activeConn}
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn}
deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId} = do
@@ -1901,10 +1917,10 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image,
pu.display_name, pu.full_name, pu.image, pu.local_alias,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image,
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM group_members m
@@ -1936,7 +1952,7 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
db
[sql|
SELECT
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, ct.via_group, ct.enable_ntfs, ct.created_at, ct.updated_at,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.local_alias, ct.via_group, ct.enable_ntfs, ct.created_at, ct.updated_at,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM contacts ct
@@ -1952,9 +1968,9 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
|]
(userId, groupMemberId)
where
toContact' :: (ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe Int64, Maybe Bool, UTCTime, UTCTime) :. ConnectionRow -> Contact
toContact' ((contactId, profileId, localDisplayName, displayName, fullName, image, viaGroup, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image}
toContact' :: (ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Maybe Bool, UTCTime, UTCTime) :. ConnectionRow -> Contact
toContact' ((contactId, profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
activeConn = toConnection connRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
@@ -2658,7 +2674,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image
p.display_name, p.full_name, p.image, p.local_alias
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN contacts c ON m.contact_id = c.contact_id
@@ -2695,7 +2711,7 @@ getDirectChatPreviews_ db User {userId} = do
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, ct.enable_ntfs, ct.created_at, ct.updated_at,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.enable_ntfs, ct.created_at, ct.updated_at,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id, c.conn_status, c.conn_type,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at,
@@ -2764,7 +2780,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image,
pu.display_name, pu.full_name, pu.image, pu.local_alias,
-- ChatStats
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
-- ChatItem
@@ -2774,13 +2790,13 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- Maybe GroupMember - sender
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image,
p.display_name, p.full_name, p.image, p.local_alias,
-- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image
rp.display_name, rp.full_name, rp.image, rp.local_alias
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
@@ -3035,7 +3051,7 @@ getContact db userId contactId =
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, ct.enable_ntfs, ct.created_at, ct.updated_at,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.enable_ntfs, ct.created_at, ct.updated_at,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id, c.conn_status, c.conn_type,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
@@ -3164,7 +3180,7 @@ getGroupInfo db User {userId, userContactId} groupId =
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
pu.display_name, pu.full_name, pu.image
pu.display_name, pu.full_name, pu.image, pu.local_alias
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id
@@ -3533,13 +3549,13 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.image,
p.display_name, p.full_name, p.image, p.local_alias,
-- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.image
rp.display_name, rp.full_name, rp.image, rp.local_alias
FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
+11 -5
View File
@@ -218,7 +218,10 @@ data Profile = Profile
{ displayName :: ContactName,
fullName :: Text,
image :: Maybe ImageData
-- incognito field should not be read as is into this data type to prevent sending it as part of profile to contacts
-- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
-- - contact_profile_id
-- - incognito
-- - local_alias
}
deriving (Eq, Show, Generic, FromJSON)
@@ -226,11 +229,14 @@ instance ToJSON Profile where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
type LocalAlias = Text
data LocalProfile = LocalProfile
{ profileId :: ProfileId,
displayName :: ContactName,
fullName :: Text,
image :: Maybe ImageData
image :: Maybe ImageData,
localAlias :: LocalAlias
}
deriving (Eq, Show, Generic, FromJSON)
@@ -241,9 +247,9 @@ instance ToJSON LocalProfile where
localProfileId :: LocalProfile -> ProfileId
localProfileId = profileId
toLocalProfile :: ProfileId -> Profile -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, image} =
LocalProfile {profileId, displayName, fullName, image}
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, image} localAlias =
LocalProfile {profileId, displayName, fullName, image, localAlias}
fromLocalProfile :: LocalProfile -> Profile
fromLocalProfile LocalProfile {displayName, fullName, image} =
+16 -4
View File
@@ -117,6 +117,7 @@ responseToView testView = \case
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
CRContactAliasUpdated c -> viewContactAliasUpdated c
CRContactUpdated c c' -> viewContactUpdated c c'
CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
@@ -594,23 +595,29 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
]
viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString]
viewContactInfo Contact {contactId} stats incognitoProfile =
viewContactInfo Contact {contactId, profile = LocalProfile {localAlias}} stats incognitoProfile =
["contact ID: " <> sShow contactId] <> viewConnectionStats stats
<> maybe
["you've shared main profile with this contact"]
(\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p])
incognitoProfile
<> if localAlias /= "" then ["alias: " <> plain localAlias] else ["alias not set"]
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId} stats mainProfile =
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> Maybe LocalProfile -> [StyledString]
viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias = mpLocalAlias}} stats mainProfile =
[ "group ID: " <> sShow groupId,
"member ID: " <> sShow groupMemberId
]
<> maybe ["member not connected"] viewConnectionStats stats
<> maybe
["unknown whether group member uses his main profile or incognito one for the group"]
(\Profile {displayName, fullName} -> ["member is using " <> styleIncognito' "incognito" <> " profile for the group, main profile known: " <> ttyFullName displayName fullName])
(\LocalProfile {displayName, fullName} -> ["member is using " <> styleIncognito' "incognito" <> " profile for the group, main profile known: " <> ttyFullName displayName fullName])
mainProfile
<> if alias /= "" then ["alias: " <> plain alias] else ["no alias for contact"]
where
alias = case mainProfile of
Nothing -> mpLocalAlias
Just LocalProfile {localAlias = lpLocalAlias} -> lpLocalAlias
viewConnectionStats :: ConnectionStats -> [StyledString]
viewConnectionStats ConnectionStats {rcvServers, sndServers} =
@@ -644,6 +651,11 @@ viewGroupUpdated
where
byMember = maybe "" ((" by " <>) . ttyMember) m
viewContactAliasUpdated :: Contact -> [StyledString]
viewContactAliasUpdated Contact {localDisplayName = n, profile = LocalProfile {localAlias}}
| localAlias == "" = ["contact " <> ttyContact n <> " alias removed"]
| otherwise = ["contact " <> ttyContact n <> " alias updated: " <> plain localAlias]
viewContactUpdated :: Contact -> Contact -> [StyledString]
viewContactUpdated
Contact {localDisplayName = n, profile = LocalProfile {fullName}}