Merge branch 'master' into master-ghc9

This commit is contained in:
Evgeny Poberezkin
2023-09-18 21:46:27 +01:00
97 changed files with 15372 additions and 12624 deletions
+4 -4
View File
@@ -72,18 +72,18 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
[sql|
SELECT
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)] =
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = ExceptT $ do
+5 -5
View File
@@ -147,7 +147,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
@@ -205,7 +205,7 @@ createDirectContact db user@User {userId} activeConn@Connection {connId, localAl
let profile = toLocalProfile profileId p localAlias
userPreferences = emptyChatPrefs
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt}
pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
@@ -463,7 +463,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
@@ -608,7 +608,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
contactId <- insertedRowId db
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt}
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
getContactIdByName db User {userId} cName =
@@ -627,7 +627,7 @@ getContact_ db user@User {userId} contactId deleted =
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
+190 -7
View File
@@ -37,6 +37,7 @@ module Simplex.Chat.Store.Groups
updateGroupProfile,
getGroupIdByName,
getGroupMemberIdByName,
getActiveMembersByName,
getGroupInfoByName,
getGroupMember,
getGroupMemberById,
@@ -87,6 +88,12 @@ module Simplex.Chat.Store.Groups
getXGrpMemIntroContDirect,
getXGrpMemIntroContGroup,
getHostConnId,
createMemberContact,
getMemberContact,
setContactGrpInvSent,
createMemberContactInvited,
updateMemberContactInvited,
resetMemberContactFields,
)
where
@@ -96,7 +103,9 @@ import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Either (rights)
import Data.Int (Int64)
import Data.List (sortOn)
import Data.Maybe (fromMaybe, isNothing)
import Data.Ord (Down (..))
import Data.Text (Text)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..))
@@ -110,7 +119,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Protocol (SubscriptionMode)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (eitherToMaybe)
import Simplex.Messaging.Version
import UnliftIO.STM
@@ -625,7 +634,7 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode
pure member
where
createMember_ memberId createdAt = do
@@ -692,7 +701,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
@@ -1036,7 +1045,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
[sql|
SELECT
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
@@ -1053,13 +1062,13 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
|]
(userId, groupMemberId)
where
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)) :. ConnectionRow -> Contact
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)) :. ConnectionRow -> Contact
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
activeConn = toConnection connRow
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
@@ -1126,6 +1135,27 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName =
ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName)
getActiveMembersByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName db user@User {userId} groupMemberName = do
groupMemberIds :: [(GroupId, GroupMemberId)] <-
liftIO $
DB.query
db
[sql|
SELECT group_id, group_member_id
FROM group_members
WHERE user_id = ? AND local_display_name = ?
AND member_status IN (?,?) AND member_category != ?
|]
(userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember)
possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do
groupInfo <- getGroupInfo db user groupId
groupMember <- getGroupMember db user groupId groupMemberId
pure (groupInfo, groupMember)
pure $ sortOn (Down . ts . fst) possibleMembers
where
ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs
getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact]
getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do
contactIds <-
@@ -1361,3 +1391,156 @@ getHostConnId db user@User {userId} groupId = do
hostMemberId <- getHostMemberId_ db user groupId
ExceptT . firstRow fromOnly (SEConnectionNotFoundByMemberId hostMemberId) $
DB.query db "SELECT connection_id FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, hostMemberId)
createMemberContact :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO Contact
createMemberContact
db
user@User {userId, profile = LocalProfile {preferences}}
acId
cReq
GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId}
Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
subMode = do
currentTs <- getCurrentTime
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
customUserProfileId = localProfileId <$> incognitoProfile
userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
DB.execute
db
[sql|
INSERT INTO contacts (
user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, contact_used,
contact_group_member_id, contact_grp_inv_sent, created_at, updated_at, chat_ts
) VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, localDisplayName, memberContactProfileId, True, userPreferences, True)
:. (groupMemberId, False, currentTs, currentTs, currentTs)
)
contactId <- insertedRowId db
DB.execute
db
"UPDATE group_members SET contact_id = ?, updated_at = ? WHERE group_member_id = ?"
(contactId, currentTs, groupMemberId)
DB.execute
db
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_req_inv, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, contactId, customUserProfileId)
:. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db user contactId = do
ct <- getContact db user contactId
let Contact {contactGroupMemberId, activeConn = Connection {connId}} = ct
cReq <- getConnReqInv db connId
case contactGroupMemberId of
Just groupMemberId -> do
m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId
g <- getGroupInfo db user groupId
pure (g, m, ct, cReq)
_ ->
throwError $ SEMemberContactGroupMemberNotFound contactId
setContactGrpInvSent :: DB.Connection -> Contact -> Bool -> IO ()
setContactGrpInvSent db Contact {contactId} xGrpDirectInvSent = do
currentTs <- getCurrentTime
DB.execute
db
"UPDATE contacts SET contact_grp_inv_sent = ?, updated_at = ? WHERE contact_id = ?"
(xGrpDirectInvSent, currentTs, contactId)
createMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO (Contact, GroupMember)
createMemberContactInvited
db
user@User {userId, profile = LocalProfile {preferences}}
connIds
gInfo@GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
m@GroupMember {groupMemberId, localDisplayName = memberLDN, memberProfile, memberContactProfileId}
mConn
subMode = do
currentTs <- liftIO getCurrentTime
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
contactId <- createContactUpdateMember currentTs userPreferences
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
m' = m {memberContactId = Just contactId}
pure (mCt', m')
where
createContactUpdateMember :: UTCTime -> Preferences -> IO ContactId
createContactUpdateMember currentTs userPreferences = do
DB.execute
db
[sql|
INSERT INTO contacts (
user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, contact_used,
created_at, updated_at, chat_ts
) VALUES (?,?,?,?,?,?,?,?,?)
|]
( (userId, memberLDN, memberContactProfileId, True, userPreferences, True)
:. (currentTs, currentTs, currentTs)
)
contactId <- insertedRowId db
DB.execute
db
"UPDATE group_members SET contact_id = ?, updated_at = ? WHERE group_member_id = ?"
(contactId, currentTs, groupMemberId)
pure contactId
updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> Contact -> SubscriptionMode -> IO Contact
updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = oldContactConn} subMode = do
updateConnectionStatus db oldContactConn ConnDeleted
activeConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
ct' <- resetMemberContactFields db ct
pure (ct' :: Contact) {activeConn}
resetMemberContactFields :: DB.Connection -> Contact -> IO Contact
resetMemberContactFields db ct@Contact {contactId} = do
currentTs <- liftIO getCurrentTime
DB.execute
db
[sql|
UPDATE contacts
SET contact_group_member_id = NULL, contact_grp_inv_sent = 0, updated_at = ?
WHERE contact_id = ?
|]
(currentTs, contactId)
pure ct {contactGroupMemberId = Nothing, contactGrpInvSent = False, updatedAt = currentTs}
createMemberContactConn_ :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> ContactId -> SubscriptionMode -> IO Connection
createMemberContactConn_
db
user@User {userId}
(cmdId, acId)
GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
_memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
contactId
subMode = do
currentTs <- liftIO getCurrentTime
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
customUserProfileId = localProfileId <$> incognitoProfile
DB.execute
db
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, ConnNew, ConnContact, contactId, customUserProfileId)
:. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
setCommandConnId db user cmdId connId
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
+1 -1
View File
@@ -479,7 +479,7 @@ getDirectChatPreviews_ db user@User {userId} = do
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
+3 -1
View File
@@ -79,6 +79,7 @@ import Simplex.Chat.Migrations.M20230814_indexes
import Simplex.Chat.Migrations.M20230827_file_encryption
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
import Simplex.Chat.Migrations.M20230913_member_contacts
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -157,7 +158,8 @@ schemaMigrations =
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption),
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe)
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts)
]
-- | The list of migrations in ascending order by date
+17 -8
View File
@@ -64,6 +64,7 @@ data StoreError
| SEGroupMemberNameNotFound {groupId :: GroupId, groupMemberName :: ContactName}
| SEGroupMemberNotFound {groupMemberId :: GroupMemberId}
| SEGroupMemberNotFoundByMemberId {memberId :: MemberId}
| SEMemberContactGroupMemberNotFound {contactId :: ContactId}
| SEGroupWithoutUser
| SEDuplicateGroupMember
| SEGroupAlreadyJoined
@@ -145,7 +146,7 @@ toConnection :: ConnectionRow -> Connection
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) =
let entityId = entityId_ connType
connectionCode = SecurityCode <$> code_ <*> verifiedAt_
peerChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
peerChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias, entityId, connectionCode, authErrCounter, createdAt}
where
entityId_ :: ConnType -> Maybe Int64
@@ -179,7 +180,7 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
:. (minV, maxV, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange = JVersionRange peerChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
where
ent ct = if connType == ct then entityId else Nothing
@@ -240,24 +241,24 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|]
[":user_id" := userId, ":profile_id" := profileId]
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)
toContact :: User -> ContactRow :. ConnectionRow -> Contact
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
in case toMaybeConnection connRow of
Just activeConn ->
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
_ -> Left $ SEContactNotReady localDisplayName
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
@@ -280,7 +281,7 @@ type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, In
toContactRequest :: ContactRequestRow -> UserContactRequest
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
let profile = Profile {displayName, fullName, image, contactLink, preferences}
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
cReqChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt}
userQuery :: Query
@@ -305,6 +306,14 @@ toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, Mayb
toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, viaUserContactLink, groupLinkId, customUserProfileId, connReqInv, localAlias, createdAt, updatedAt) =
PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, viaUserContactLink, groupLinkId, customUserProfileId, connReqInv, localAlias, createdAt, updatedAt}
getConnReqInv :: DB.Connection -> Int64 -> ExceptT StoreError IO ConnReqInvitation
getConnReqInv db connId =
ExceptT . firstRow fromOnly (SEConnectionNotFoundById connId) $
DB.query
db
"SELECT conn_req_inv FROM connections WHERE connection_id = ?"
(Only connId)
-- | Saves unique local display name based on passed displayName, suffixed with _N if required.
-- This function should be called inside transaction.
withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO (Either StoreError a)) -> IO (Either StoreError a)