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
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 147 additions and 77 deletions

View File

@ -47,6 +47,7 @@ library
Simplex.Chat.Migrations.M20220818_chat_notifications Simplex.Chat.Migrations.M20220818_chat_notifications
Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id
Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items Simplex.Chat.Migrations.M20220823_delete_broken_group_event_chat_items
Simplex.Chat.Migrations.M20220824_profiles_local_alias
Simplex.Chat.Mobile Simplex.Chat.Mobile
Simplex.Chat.Options Simplex.Chat.Options
Simplex.Chat.ProfileGenerator Simplex.Chat.ProfileGenerator

View File

@ -578,6 +578,11 @@ processChatCommand = \case
withCurrentCall contactId $ \userId ct call -> withCurrentCall contactId $ \userId ct call ->
updateCallItemStatus userId ct call receivedStatus Nothing $> Just call updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
APIUpdateProfile profile -> withUser (`updateProfile` profile) 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 APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text
APIGetNtfToken -> withUser $ \_ -> crNtfToken <$> withAgent getNtfToken APIGetNtfToken -> withUser $ \_ -> crNtfToken <$> withAgent getNtfToken
APIRegisterToken token mode -> CRNtfTokenStatus <$> withUser (\_ -> withAgent $ \a -> registerNtfToken a token mode) 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 ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db userId contactId
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
connectionStats <- withAgent (`getConnectionServers` contactConnId ct) 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 APIGroupMemberInfo gId gMemberId -> withUser $ \user@User {userId} -> do
-- [incognito] print group member main profile -- [incognito] print group member main profile
(g, m@GroupMember {memberContactProfileId}) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId (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 unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
(,) <$> getFileSize fsFilePath <*> asks (fileChunkSize . config) (,) <$> getFileSize fsFilePath <*> asks (fileChunkSize . config)
updateProfile :: User -> Profile -> m ChatResponse 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 | p' == fromLocalProfile p = pure CRUserProfileNoChange
| otherwise = do | otherwise = do
withStore $ \db -> updateUserProfile db user p' 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') asks currentUser >>= atomically . (`writeTVar` Just user')
-- [incognito] filter out contacts with whom user has incognito connections -- [incognito] filter out contacts with whom user has incognito connections
contacts <- contacts <-
@ -1365,7 +1370,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
CONF confId _ connInfo -> do CONF confId _ connInfo -> do
-- [incognito] send saved profile -- [incognito] send saved profile
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) 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 saveConnInfo conn connInfo
allowAgentConnection conn confId $ XInfo profileToSend allowAgentConnection conn confId $ XInfo profileToSend
INFO connInfo -> INFO connInfo ->
@ -1430,7 +1435,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
Nothing -> do Nothing -> do
-- [incognito] print incognito profile used for this contact -- [incognito] print incognito profile used for this contact
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
toView $ CRContactConnected ct incognitoProfile toView $ CRContactConnected ct (fmap fromLocalProfile incognitoProfile)
setActive $ ActiveC c setActive $ ActiveC c
showToast (c <> "> ") "connected" showToast (c <> "> ") "connected"
forM_ viaUserContactLink $ \userContactLinkId -> do forM_ viaUserContactLink $ \userContactLinkId -> do
@ -1512,14 +1517,14 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
case memberCategory m of case memberCategory m of
GCHostMember -> do GCHostMember -> do
-- [incognito] chat item & event with indication that host connected incognito -- [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 memberConnectedChatItem gInfo m mainProfile
toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} (memberIncognito membership) toView $ CRUserJoinedGroup gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} (memberIncognito membership)
setActive $ ActiveG gName setActive $ ActiveG gName
showToast ("#" <> gName) "you are connected to group" showToast ("#" <> gName) "you are connected to group"
GCInviteeMember -> do GCInviteeMember -> do
-- [incognito] chat item & event with indication that invitee connected incognito -- [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 memberConnectedChatItem gInfo m mainProfile
toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected} mainProfile toView $ CRJoinedGroupMember gInfo m {memberStatus = GSMemConnected} mainProfile
setActive $ ActiveG gName setActive $ ActiveG gName
@ -2575,6 +2580,7 @@ chatCommandP =
"/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP), "/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP),
"/_call get" $> APIGetCallInvitations, "/_call get" $> APIGetCallInvitations,
"/_profile " *> (APIUpdateProfile <$> jsonP), "/_profile " *> (APIUpdateProfile <$> jsonP),
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
"/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString), "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString),
"/_ntf get" $> APIGetNtfToken, "/_ntf get" $> APIGetNtfToken,
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP), "/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
@ -2685,6 +2691,7 @@ chatCommandP =
fullNameP name = do fullNameP name = do
n <- (A.space *> A.takeByteString) <|> pure "" n <- (A.space *> A.takeByteString) <|> pure ""
pure $ if B.null n then name else safeDecodeUtf8 n pure $ if B.null n then name else safeDecodeUtf8 n
textP = safeDecodeUtf8 <$> A.takeByteString
filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString
searchP = T.unpack . safeDecodeUtf8 <$> (" search=" *> A.takeByteString) searchP = T.unpack . safeDecodeUtf8 <$> (" search=" *> A.takeByteString)
memberRole = memberRole =

View File

@ -133,6 +133,7 @@ data ChatCommand
| APIGetCallInvitations | APIGetCallInvitations
| APICallStatus ContactId WebRTCCallStatus | APICallStatus ContactId WebRTCCallStatus
| APIUpdateProfile Profile | APIUpdateProfile Profile
| APISetContactAlias ContactId LocalAlias
| APIParseMarkdown Text | APIParseMarkdown Text
| APIGetNtfToken | APIGetNtfToken
| APIRegisterToken DeviceToken NotificationsMode | APIRegisterToken DeviceToken NotificationsMode
@ -214,7 +215,7 @@ data ChatResponse
| CRUserSMPServers {smpServers :: [SMPServer]} | CRUserSMPServers {smpServers :: [SMPServer]}
| CRNetworkConfig {networkConfig :: NetworkConfig} | CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile} | 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} | CRNewChatItem {chatItem :: AChatItem}
| CRChatItemStatusUpdated {chatItem :: AChatItem} | CRChatItemStatusUpdated {chatItem :: AChatItem}
| CRChatItemUpdated {chatItem :: AChatItem} | CRChatItemUpdated {chatItem :: AChatItem}
@ -267,6 +268,7 @@ data ChatResponse
| CRSndFileRcvCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer} | CRSndFileRcvCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndGroupFileCancelled {chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]} | CRSndGroupFileCancelled {chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile} | CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {toContact :: Contact}
| CRContactConnecting {contact :: Contact} | CRContactConnecting {contact :: Contact}
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile} | CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactAnotherClient {contact :: Contact} | CRContactAnotherClient {contact :: Contact}

View File

@ -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;
|]

View File

@ -14,7 +14,8 @@ CREATE TABLE contact_profiles(
updated_at TEXT CHECK(updated_at NOT NULL), updated_at TEXT CHECK(updated_at NOT NULL),
image TEXT, image TEXT,
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE, 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( CREATE INDEX contact_profiles_index ON contact_profiles(
display_name, display_name,

View File

@ -38,6 +38,7 @@ module Simplex.Chat.Store
getContactIdByName, getContactIdByName,
updateUserProfile, updateUserProfile,
updateContactProfile, updateContactProfile,
updateContactAlias,
getUserContacts, getUserContacts,
createUserContactLink, createUserContactLink,
getUserContactLinkConnections, getUserContactLinkConnections,
@ -232,6 +233,7 @@ import Simplex.Chat.Migrations.M20220812_incognito_profiles
import Simplex.Chat.Migrations.M20220818_chat_notifications import Simplex.Chat.Migrations.M20220818_chat_notifications
import Simplex.Chat.Migrations.M20220822_groups_host_conn_custom_user_profile_id 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.M20220823_delete_broken_group_event_chat_items
import Simplex.Chat.Migrations.M20220824_profiles_local_alias
import Simplex.Chat.Protocol import Simplex.Chat.Protocol
import Simplex.Chat.Types import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..)) import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@ -265,7 +267,8 @@ schemaMigrations =
("20220812_incognito_profiles", m20220812_incognito_profiles), ("20220812_incognito_profiles", m20220812_incognito_profiles),
("20220818_chat_notifications", m20220818_chat_notifications), ("20220818_chat_notifications", m20220818_chat_notifications),
("20220822_groups_host_conn_custom_user_profile_id", m20220822_groups_host_conn_custom_user_profile_id), ("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 -- | 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, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData) -> User
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image) = 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} in User {userId, userContactId, localDisplayName = displayName, profile, activeUser}
setActiveUser :: DB.Connection -> UserId -> IO () setActiveUser :: DB.Connection -> UserId -> IO ()
@ -370,7 +373,7 @@ getConnReqContactXContactId db userId cReqHash = do
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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) (displayName, fullName, image, userId, Just True, createdAt, createdAt)
insertedRowId db insertedRowId db
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO Profile getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById db userId profileId = getProfileById db userId profileId =
ExceptT . firstRow toProfile (SEProfileNotFound profileId) $ ExceptT . firstRow toProfile (SEProfileNotFound profileId) $
DB.query DB.query
db db
[sql| [sql|
SELECT display_name, full_name, image SELECT display_name, full_name, image, local_alias
FROM contact_profiles FROM contact_profiles
WHERE user_id = ? AND contact_profile_id = ? WHERE user_id = ? AND contact_profile_id = ?
|] |]
(userId, profileId) (userId, profileId)
where where
toProfile :: (ContactName, Text, Maybe ImageData) -> Profile toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias) -> LocalProfile
toProfile (displayName, fullName, image) = Profile {displayName, fullName, image} 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.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 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 createDirectContact db userId activeConn@Connection {connId} profile = do
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId connId profile Nothing createdAt (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.Connection -> UserId -> Int64 -> Profile -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId connId Profile {displayName, fullName, image} viaGroup currentTs = 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 updateContact_ db userId userContactId localDisplayName newName currentTs
updateContactProfile :: DB.Connection -> UserId -> Contact -> Profile -> ExceptT StoreError IO Contact 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 = | 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 = | otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId contactId localDisplayName ldn 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.Connection -> UserId -> ProfileId -> Profile -> IO ()
updateContactProfile_ db userId profileId profile = do updateContactProfile_ db userId profileId profile = do
@ -574,18 +590,18 @@ updateContact_ db userId contactId displayName newName updatedAt = do
(newName, updatedAt, userId, contactId) (newName, updatedAt, userId, contactId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId) 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 :: ContactRow :. ConnectionRow -> Contact
toContact ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, enableNtfs_, createdAt, updatedAt) :. connRow) = toContact ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image} let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
activeConn = toConnection connRow activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt} in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
toContactOrError :: ContactRow :. MaybeConnectionRow -> Either StoreError Contact toContactOrError :: ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, enableNtfs_, createdAt, updatedAt) :. connRow) = toContactOrError ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image} let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in case toMaybeConnection connRow of in case toMaybeConnection connRow of
Just activeConn -> Just activeConn ->
@ -769,7 +785,7 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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) (userId, localDisplayName, profileId, True, createdAt, createdAt, xContactId)
contactId <- insertedRowId db contactId <- insertedRowId db
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt 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.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do getLiveSndFileTransfers db User {userId} = do
@ -1163,15 +1179,15 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
<$> DB.query <$> DB.query
db db
[sql| [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 FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ? WHERE c.user_id = ? AND c.contact_id = ?
|] |]
(userId, contactId) (userId, contactId)
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe Int64, Maybe Bool, UTCTime, UTCTime)] -> Either StoreError Contact 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, viaGroup, enableNtfs_, createdAt, updatedAt)] = toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, enableNtfs_, createdAt, updatedAt)] =
let profile = LocalProfile {profileId, displayName, fullName, image} let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt} in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" 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.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, 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}} -- 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 -- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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 FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) 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 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.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, 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}} -- 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 -- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 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_ :: 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 createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfile createdAt = do
customUserProfileId <- liftIO $ createIncognitoProfile_ db userId createdAt incognitoProfile incognitoProfileId <- liftIO $ createIncognitoProfile_ db userId createdAt incognitoProfile
(localDisplayName, memberProfile) <- case (incognitoProfile, customUserProfileId) of (localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
(Just profile@Profile {displayName}, Just profileId) -> (Just profile@Profile {displayName}, Just profileId) ->
(,toLocalProfile profileId profile) <$> insertMemberIncognitoProfile_ displayName profileId (,toLocalProfile profileId profile "") <$> insertMemberIncognitoProfile_ displayName profileId
_ -> (,profile' userOrContact) <$> liftIO insertMember_ _ -> (,profile' userOrContact) <$> liftIO insertMember_
groupMemberId <- liftIO $ insertedRowId db groupMemberId <- liftIO $ insertedRowId db
pure pure
@ -1476,7 +1492,7 @@ getUserGroupDetails db User {userId, userContactId} =
[sql| [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, 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.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 FROM groups g
JOIN group_profiles gp USING (group_profile_id) JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id) JOIN group_members mu USING (group_id)
@ -1506,7 +1522,7 @@ getGroupMember db user@User {userId} groupId groupMemberId =
[sql| [sql|
SELECT SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 FROM group_members m
@ -1528,7 +1544,7 @@ getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do
[sql| [sql|
SELECT SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 FROM group_members m
@ -1566,20 +1582,20 @@ getGroupInvitation db user groupId = do
findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId) findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
findFromContact _ = const Nothing 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 :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, 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} let memberProfile = LocalProfile {profileId, displayName, fullName, image, localAlias}
invitedBy = toInvitedBy userContactId invitedById invitedBy = toInvitedBy userContactId invitedById
activeConn = Nothing activeConn = Nothing
in GroupMember {..} in GroupMember {..}
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe 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)) = 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)) Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias))
toMaybeGroupMember _ _ = Nothing toMaybeGroupMember _ _ = Nothing
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> ExceptT StoreError IO GroupMember 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.Connection -> UserId -> GroupMember -> Maybe Profile -> ExceptT StoreError IO GroupMember
createMemberIncognitoProfile db userId m@GroupMember {groupMemberId} incognitoProfile = do createMemberIncognitoProfile db userId m@GroupMember {groupMemberId} incognitoProfile = do
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
customUserProfileId <- liftIO $ createIncognitoProfile_ db userId currentTs incognitoProfile incognitoProfileId <- liftIO $ createIncognitoProfile_ db userId currentTs incognitoProfile
case (incognitoProfile, customUserProfileId) of case (incognitoProfile, incognitoProfileId) of
(Just profile@Profile {displayName}, Just profileId) -> (Just profile@Profile {displayName}, Just profileId) ->
ExceptT $ ExceptT $
withLocalDisplayName db userId displayName $ \incognitoLdn -> do withLocalDisplayName db userId displayName $ \incognitoLdn -> do
@ -1660,7 +1676,7 @@ createMemberIncognitoProfile db userId m@GroupMember {groupMemberId} incognitoPr
WHERE user_id = ? AND group_member_id = ? WHERE user_id = ? AND group_member_id = ?
|] |]
(incognitoLdn, profileId, currentTs, userId, groupMemberId) (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 _ -> pure m
-- | add new member with profile -- | add new member with profile
@ -1712,7 +1728,7 @@ createNewMember_
|] |]
(groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt) (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
groupMemberId <- insertedRowId db 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.Connection -> User -> GroupMember -> IO ()
deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId} = do 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.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, 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}} -- 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 -- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 FROM group_members m
@ -1936,7 +1952,7 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
db db
[sql| [sql|
SELECT 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.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 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 FROM contacts ct
@ -1952,9 +1968,9 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
|] |]
(userId, groupMemberId) (userId, groupMemberId)
where where
toContact' :: (ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe Int64, Maybe Bool, UTCTime, UTCTime) :. ConnectionRow -> Contact toContact' :: (ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Maybe Bool, UTCTime, UTCTime) :. ConnectionRow -> Contact
toContact' ((contactId, profileId, localDisplayName, displayName, fullName, image, viaGroup, enableNtfs_, createdAt, updatedAt) :. connRow) = toContact' ((contactId, profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, enableNtfs_, createdAt, updatedAt) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image} let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
activeConn = toConnection connRow activeConn = toConnection connRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt} in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
@ -2658,7 +2674,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
-- GroupMember -- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, 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, 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 FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) 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 LEFT JOIN contacts c ON m.contact_id = c.contact_id
@ -2695,7 +2711,7 @@ getDirectChatPreviews_ db User {userId} = do
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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, 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 -- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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 -- ChatStats
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0),
-- ChatItem -- ChatItem
@ -2774,13 +2790,13 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- Maybe GroupMember - sender -- Maybe GroupMember - sender
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, 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, 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 -- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember -- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, 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, 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 FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id JOIN group_members mu ON mu.group_id = g.group_id
@ -3035,7 +3051,7 @@ getContact db userId contactId =
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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 -- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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 FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_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 -- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, 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, 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 -- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember -- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, 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, 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 FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id 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 LEFT JOIN group_members m ON m.group_member_id = i.group_member_id

View File

@ -218,7 +218,10 @@ data Profile = Profile
{ displayName :: ContactName, { displayName :: ContactName,
fullName :: Text, fullName :: Text,
image :: Maybe ImageData 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) deriving (Eq, Show, Generic, FromJSON)
@ -226,11 +229,14 @@ instance ToJSON Profile where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
type LocalAlias = Text
data LocalProfile = LocalProfile data LocalProfile = LocalProfile
{ profileId :: ProfileId, { profileId :: ProfileId,
displayName :: ContactName, displayName :: ContactName,
fullName :: Text, fullName :: Text,
image :: Maybe ImageData image :: Maybe ImageData,
localAlias :: LocalAlias
} }
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)
@ -241,9 +247,9 @@ instance ToJSON LocalProfile where
localProfileId :: LocalProfile -> ProfileId localProfileId :: LocalProfile -> ProfileId
localProfileId = profileId localProfileId = profileId
toLocalProfile :: ProfileId -> Profile -> LocalProfile toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, image} = toLocalProfile profileId Profile {displayName, fullName, image} localAlias =
LocalProfile {profileId, displayName, fullName, image} LocalProfile {profileId, displayName, fullName, image, localAlias}
fromLocalProfile :: LocalProfile -> Profile fromLocalProfile :: LocalProfile -> Profile
fromLocalProfile LocalProfile {displayName, fullName, image} = fromLocalProfile LocalProfile {displayName, fullName, image} =

View File

@ -117,6 +117,7 @@ responseToView testView = \case
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p' CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
CRContactAliasUpdated c -> viewContactAliasUpdated c
CRContactUpdated c c' -> viewContactUpdated c c' CRContactUpdated c c' -> viewContactUpdated c c'
CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
@ -594,23 +595,29 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
] ]
viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString] 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 ["contact ID: " <> sShow contactId] <> viewConnectionStats stats
<> maybe <> maybe
["you've shared main profile with this contact"] ["you've shared main profile with this contact"]
(\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p]) (\p -> ["you've shared incognito profile with this contact: " <> incognitoProfile' p])
incognitoProfile incognitoProfile
<> if localAlias /= "" then ["alias: " <> plain localAlias] else ["alias not set"]
viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> Maybe LocalProfile -> [StyledString]
viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId} stats mainProfile = viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias = mpLocalAlias}} stats mainProfile =
[ "group ID: " <> sShow groupId, [ "group ID: " <> sShow groupId,
"member ID: " <> sShow groupMemberId "member ID: " <> sShow groupMemberId
] ]
<> maybe ["member not connected"] viewConnectionStats stats <> maybe ["member not connected"] viewConnectionStats stats
<> maybe <> maybe
["unknown whether group member uses his main profile or incognito one for the group"] ["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 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 -> [StyledString]
viewConnectionStats ConnectionStats {rcvServers, sndServers} = viewConnectionStats ConnectionStats {rcvServers, sndServers} =
@ -644,6 +651,11 @@ viewGroupUpdated
where where
byMember = maybe "" ((" by " <>) . ttyMember) m 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 -> Contact -> [StyledString]
viewContactUpdated viewContactUpdated
Contact {localDisplayName = n, profile = LocalProfile {fullName}} Contact {localDisplayName = n, profile = LocalProfile {fullName}}

View File

@ -95,6 +95,7 @@ chatTests = do
it "create group incognito" testCreateGroupIncognito it "create group incognito" testCreateGroupIncognito
it "join group incognito" testJoinGroupIncognito it "join group incognito" testJoinGroupIncognito
it "can't invite contact to whom user connected incognito to non incognito group" testCantInviteIncognitoConnectionNonIncognitoGroup it "can't invite contact to whom user connected incognito to non incognito group" testCantInviteIncognitoConnectionNonIncognitoGroup
it "set contact alias" testSetAlias
describe "SMP servers" $ describe "SMP servers" $
it "get and set SMP servers" testGetSetSMPServers it "get and set SMP servers" testGetSetSMPServers
describe "async connection handshake" $ do describe "async connection handshake" $ do
@ -2440,6 +2441,13 @@ testCantInviteIncognitoConnectionNonIncognitoGroup = testChat2 aliceProfile bobP
alice ##> "/a club bob" alice ##> "/a club bob"
alice <## "you're using main profile for this group - prohibited to invite contact to whom you are connected incognito" alice <## "you're using main profile for this group - prohibited to invite contact to whom you are connected incognito"
testSetAlias :: IO ()
testSetAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #$> ("/_set alias @2 my friend bob", id, "contact bob alias updated: my friend bob")
alice #$> ("/_set alias @2", id, "contact bob alias removed")
testGetSetSMPServers :: IO () testGetSetSMPServers :: IO ()
testGetSetSMPServers = testGetSetSMPServers =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $

View File

@ -31,9 +31,9 @@ activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\"
activeUser :: String activeUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\"},\"activeUser\":true}}}}" activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"activeUser\":true}}}}"
#else #else
activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\"},\"activeUser\":true}}}" activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"activeUser\":true}}}"
#endif #endif
chatStarted :: String chatStarted :: String