dandri/simplex-chat
1
0 Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-10-22 15:22:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

core, ios: create contact requests with attached contact (#5967)

Browse Source
This commit is contained in:
spaced4ndy authored and GitHub committed 2025-06-09 16:18:01 +00:00
1 parent ed97606003
commit 2bc4836338
32 files changed
+663 -305
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

src/Simplex/Chat/Controller.hs
+2 -2
View File
@@ -668,7 +668,7 @@ data ChatResponse
| CRContactsList {user :: User, contacts :: [Contact]}
| CRUserContactLink {user :: User, contactLink :: UserContactLink}
| CRUserContactLinkUpdated {user :: User, contactLink :: UserContactLink}
| CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
| CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest, contact_ :: Maybe Contact}
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool}
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
@@ -781,7 +781,7 @@ data ChatEvent
| CEvtGroupMemberUpdated {user :: User, groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember}
| CEvtContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
| CEvtContactDeletedByContact {user :: User, contact :: Contact}
| CEvtReceivedContactRequest {user :: User, contactRequest :: UserContactRequest}
| CEvtReceivedContactRequest {user :: User, contactRequest :: UserContactRequest, contact_ :: Maybe Contact}
| CEvtAcceptingContactRequest {user :: User, contact :: Contact} -- there is the same command response
| CEvtAcceptingBusinessRequest {user :: User, groupInfo :: GroupInfo}
| CEvtContactRequestAlreadyAccepted {user :: User, contact :: Contact}
src/Simplex/Chat/Library/Commands.hs
+16 -5
View File
@@ -1144,6 +1144,12 @@ processChatCommand' vr = \case
withFastStore' $ \db -> deleteNoteFolderCIs db user nf
pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf)
_ -> throwCmdError "not supported"
-- TODO [short links] prohibit incognito if short link data is set for address
-- TODO - add user_contact_links.short_link_data_set; UserContactLink.shortLinkDataSet
-- TODO - same for auto-accept:
-- TODO - set incognito to false on setting short link data
-- TODO - ignore on accept (for foolproofing)
-- TODO - hide in UI
APIAcceptContact incognito connReqId -> withUser $ \_ -> do
userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId
withUserContactLock "acceptContact" userContactLinkId $ do
@@ -1163,12 +1169,17 @@ processChatCommand' vr = \case
APIRejectContact connReqId -> withUser $ \user -> do
userContactLinkId <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId
withUserContactLock "rejectContact" userContactLinkId $ do
cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <-
withFastStore $ \db ->
getContactRequest db user connReqId
`storeFinally` liftIO (deleteContactRequest db user connReqId)
(cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId}, ct_) <-
withFastStore $ \db -> do
cReq@UserContactRequest {contactId_} <- getContactRequest db user connReqId
ct_ <- forM contactId_ $ \contactId -> do
ct <- getContact db vr user contactId
deleteContact db user ct
pure ct
liftIO $ deleteContactRequest db user connReqId
pure (cReq, ct_)
withAgent $ \a -> rejectContact a connId invId
pure $ CRContactRequestRejected user cReq
pure $ CRContactRequestRejected user cReq ct_
APISendCallInvitation contactId callType -> withUser $ \user -> do
-- party initiating call
ct <- withFastStore $ \db -> getContact db vr user contactId
src/Simplex/Chat/Library/Internal.hs
+55 -36
View File
@@ -878,12 +878,17 @@ acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId =
Nothing -> do
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
connId <- withAgent $ \a -> prepareConnectionToAccept a True invId pqSup'
(ct, conn) <- withStore' $ \db -> createAcceptedContact db user connId chatV cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' False
(ct, conn) <- withStore' $ \db -> createContactFromRequest db user userContactLinkId connId chatV cReqChatVRange cName profileId cp xContactId incognitoProfile subMode pqSup' False
pure (ct, conn, incognitoProfile)
Just contactId -> do
ct <- withFastStore $ \db -> getContact db vr user contactId
case contactConn ct of
Nothing -> throwChatError $ CECommandError "contact has no connection"
Nothing -> do
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
connId <- withAgent $ \a -> prepareConnectionToAccept a True invId pqSup'
currentTs <- liftIO getCurrentTime
conn <- withStore' $ \db -> createAcceptedContactConn db user userContactLinkId contactId connId chatV cReqChatVRange pqSup' incognitoProfile subMode currentTs
pure (ct {activeConn = Just conn}, conn, incognitoProfile)
Just conn@Connection {customUserProfileId} -> do
incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
pure (ct, conn, ExistingIncognito <$> incognitoProfile)
@@ -891,32 +896,41 @@ acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId =
dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
(ct,conn,) <$> withAgent (\a -> acceptContact a (aConnId conn) True invId dm pqSup' subMode)
acceptContactRequestAsync :: User -> UserContactRequest -> Maybe IncognitoProfile -> PQSupport -> CM Contact
acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile pqSup = do
subMode <- chatReadVar subscriptionMode
let profileToSend = profileToSendOnAccept user incognitoProfile False
vr <- chatVersionRange
let chatV = vr `peerConnChatVersion` cReqChatVRange
(cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode pqSup chatV
withStore' $ \db -> do
(ct, Connection {connId}) <- createAcceptedContact db user acId chatV cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup True
deleteContactRequestRec db user cReq
setCommandConnId db user cmdId connId
pure ct
acceptContactRequestAsync :: User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> Maybe IncognitoProfile -> CM Contact
acceptContactRequestAsync
user
uclId
cReqInvId
cReqChatVRange
cReqProfile
cReqXContactId_
cReqPQSup
incognitoProfile = do
subMode <- chatReadVar subscriptionMode
let profileToSend = profileToSendOnAccept user incognitoProfile False
vr <- chatVersionRange
let chatV = vr `peerConnChatVersion` cReqChatVRange
(cmdId, acId) <- agentAcceptContactAsync user True cReqInvId (XInfo profileToSend) subMode cReqPQSup chatV
withStore $ \db -> do
(ct, Connection {connId}) <- createAcceptedContact db vr user uclId acId chatV cReqChatVRange cReqProfile cReqXContactId_ cReqPQSup incognitoProfile subMode
liftIO $ setCommandConnId db user cmdId connId
pure ct
acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
acceptGroupJoinRequestAsync
user
uclId
gInfo@GroupInfo {groupProfile, membership, businessChat}
ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange}
cReqInvId
cReqChatVRange
cReqProfile
gAccepted
gLinkMemRole
incognitoProfile = do
gVar <- asks random
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
(groupMemberId, memberId) <- withStore $ \db -> do
liftIO $ deleteContactRequestRec db user ucr
createJoiningMember db gVar user gInfo ucr gLinkMemRole initialStatus
(groupMemberId, memberId) <- withStore $ \db ->
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile gLinkMemRole initialStatus
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
let Profile {displayName} = profileToSendOnAccept user incognitoProfile True
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -934,21 +948,23 @@ acceptGroupJoinRequestAsync
subMode <- chatReadVar subscriptionMode
vr <- chatVersionRange
let chatV = vr `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
liftIO $ createJoiningMemberConnection db user connIds chatV ucr groupMemberId subMode
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
getGroupMemberById db vr user groupMemberId
acceptGroupJoinSendRejectAsync :: User -> GroupInfo -> UserContactRequest -> GroupRejectionReason -> CM GroupMember
acceptGroupJoinSendRejectAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> GroupRejectionReason -> CM GroupMember
acceptGroupJoinSendRejectAsync
user
uclId
gInfo@GroupInfo {groupProfile, membership}
ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange}
cReqInvId
cReqChatVRange
cReqProfile
rejectionReason = do
gVar <- asks random
(groupMemberId, memberId) <- withStore $ \db -> do
liftIO $ deleteContactRequestRec db user ucr
createJoiningMember db gVar user gInfo ucr GRObserver GSMemRejected
(groupMemberId, memberId) <- withStore $ \db ->
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile GRObserver GSMemRejected
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
msg =
XGrpLinkReject $
@@ -961,22 +977,25 @@ acceptGroupJoinSendRejectAsync
subMode <- chatReadVar subscriptionMode
vr <- chatVersionRange
let chatV = vr `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user False invId msg subMode PQSupportOff chatV
connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
withStore $ \db -> do
liftIO $ createJoiningMemberConnection db user connIds chatV ucr groupMemberId subMode
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
getGroupMemberById db vr user groupMemberId
acceptBusinessJoinRequestAsync :: User -> UserContactRequest -> CM GroupInfo
acceptBusinessJoinRequestAsync :: User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> CM (GroupInfo, GroupMember)
acceptBusinessJoinRequestAsync
user
ucr@UserContactRequest {contactRequestId, agentInvitationId = AgentInvId invId, cReqChatVRange} = do
uclId
cReqInvId
cReqChatVRange
cReqProfile
cReqXContactId_ = do
vr <- chatVersionRange
gVar <- asks random
let userProfile@Profile {displayName, preferences} = profileToSendOnAccept user Nothing True
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
(gInfo, clientMember) <- withStore $ \db -> do
liftIO $ deleteContactRequest db user contactRequestId
createBusinessRequestGroup db vr gVar user ucr groupPreferences
(gInfo, clientMember) <- withStore $ \db ->
createBusinessRequestGroup db vr gVar user cReqChatVRange cReqProfile cReqXContactId_ groupPreferences
let GroupInfo {membership} = gInfo
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
GroupMember {groupMemberId, memberId} = clientMember
@@ -996,12 +1015,12 @@ acceptBusinessJoinRequestAsync
}
subMode <- chatReadVar subscriptionMode
let chatV = vr `peerConnChatVersion` cReqChatVRange
connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV
withStore' $ \db -> createJoiningMemberConnection db user connIds chatV ucr groupMemberId subMode
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
withStore' $ \db -> createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
let cd = CDGroupSnd gInfo Nothing
createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
createGroupFeatureItems user cd CISndGroupFeature gInfo
pure gInfo
pure (gInfo, clientMember)
where
businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
businessGroupProfile Profile {displayName, fullName, image} groupPreferences =
src/Simplex/Chat/Library/Subscriber.hs
+58 -44
View File
@@ -668,7 +668,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
_ -> pure ()
where
-- TODO [short links] don't send auto-reply message if it should have been created by connecting client
-- TODO (based on version + whether address has short link data)
-- TODO - based on version + whether address has short link data (shortLinkDataSet)
sendAutoReply ct = \case
Just AutoAccept {autoReply = Just mc} -> do
(msg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
@@ -1208,7 +1208,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
processUserContactRequest :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM ()
processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of
processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId = uclId} = case agentMsg of
REQ invId pqSupport _ connInfo -> do
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
case chatMsgEvent of
@@ -1227,54 +1227,68 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
where
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MsgContent -> PQSupport -> CM ()
profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ mc_ reqPQSup = do
-- TODO [short links] on contact request create contact with message
-- TODO - instead of creating a contact request, create a contact that can be accepted or rejected,
-- TODO and can be opened as a chat to view message
-- TODO - see schema comments on persistence
withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
CORContact contact -> toView $ CEvtContactRequestAlreadyAccepted user contact
CORGroup gInfo -> toView $ CEvtBusinessRequestAlreadyAccepted user gInfo
CORRequest cReq -> do
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
let (UserContactLink {connLinkContact = CCLink connReq _, autoAccept}, gLinkInfo_) = ucl
isSimplexTeam = sameConnReqContact connReq adminContactReq
v = maxVersion chatVRange
case autoAccept of
Just AutoAccept {acceptIncognito, businessAddress}
| businessAddress ->
if isSimplexTeam && v < businessChatsVersion
then do
ct <- acceptContactRequestAsync user cReq Nothing reqPQSup
ucl <- withStore $ \db -> getUserContactLinkById db userId uclId
let (UserContactLink {connLinkContact = CCLink connReq _, autoAccept}, gLinkInfo_) = ucl
isSimplexTeam = sameConnReqContact connReq adminContactReq
v = maxVersion chatVRange
case autoAccept of
Nothing ->
withStore (\db -> createOrUpdateContactRequest db vr user uclId invId chatVRange p xContactId_ reqPQSup) >>= \case
CORContact ct -> toView $ CEvtContactRequestAlreadyAccepted user ct
CORRequest cReq ct_ -> do
forM_ ct_ $ \ct ->
forM_ mc_ $ \mc ->
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
toView $ CEvtReceivedContactRequest user cReq ct_
Just AutoAccept {acceptIncognito, businessAddress}
| businessAddress ->
if isSimplexTeam && v < businessChatsVersion
then
maybe (pure Nothing) (\xContactId -> withStore' (\db -> getAcceptedContactByXContactId db vr user xContactId)) xContactId_ >>= \case
Just ct -> toView $ CEvtContactRequestAlreadyAccepted user ct
Nothing -> do
ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup Nothing
forM_ mc_ $ \mc ->
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
toView $ CEvtAcceptingContactRequest user ct
else do
gInfo <- acceptBusinessJoinRequestAsync user cReq
else
maybe (pure Nothing) (\xContactId -> withStore' (\db -> getAcceptedBusinessChatByXContactId db vr user xContactId)) xContactId_ >>= \case
Just gInfo -> toView $ CEvtBusinessRequestAlreadyAccepted user gInfo
Nothing -> do
(gInfo, clientMember) <- acceptBusinessJoinRequestAsync user uclId invId chatVRange p xContactId_
forM_ mc_ $ \mc ->
createInternalChatItem user (CDGroupRcv gInfo Nothing clientMember) (CIRcvMsgContent mc) Nothing
toView $ CEvtAcceptingBusinessRequest user gInfo
| otherwise -> case gLinkInfo_ of
| otherwise -> case gLinkInfo_ of
Nothing ->
maybe (pure Nothing) (\xContactId -> withStore' (\db -> getAcceptedContactByXContactId db vr user xContactId)) xContactId_ >>= \case
Just ct -> toView $ CEvtContactRequestAlreadyAccepted user ct
Nothing -> do
-- [incognito] generate profile to send, create connection with incognito profile
incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
ct <- acceptContactRequestAsync user cReq incognitoProfile reqPQSup
ct <- acceptContactRequestAsync user uclId invId chatVRange p xContactId_ reqPQSup incognitoProfile
forM_ mc_ $ \mc ->
createInternalChatItem user (CDDirectRcv ct) (CIRcvMsgContent mc) Nothing
toView $ CEvtAcceptingContactRequest user ct
Just gli@GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
acceptMember_ <- asks $ acceptMember . chatHooks . config
maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case
Right (acceptance, useRole)
| v < groupFastLinkJoinVersion ->
messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
| otherwise -> do
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
mem <- acceptGroupJoinRequestAsync user gInfo cReq acceptance useRole profileMode
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
Left rjctReason
| v < groupJoinRejectVersion ->
messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked"
| otherwise -> do
mem <- acceptGroupJoinSendRejectAsync user gInfo cReq rjctReason
toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
_ -> toView $ CEvtReceivedContactRequest user cReq
Just gli@GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
acceptMember_ <- asks $ acceptMember . chatHooks . config
maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case
Right (acceptance, useRole)
| v < groupFastLinkJoinVersion ->
messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
| otherwise -> do
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p acceptance useRole profileMode
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
Left rjctReason
| v < groupJoinRejectVersion ->
messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked"
| otherwise -> do
mem <- acceptGroupJoinSendRejectAsync user uclId gInfo invId chatVRange p rjctReason
toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
memberCanSend :: GroupMember -> Maybe MsgScope -> CM () -> CM ()
memberCanSend m@GroupMember {memberRole} msgScope a = case msgScope of
src/Simplex/Chat/Store/Connections.hs
+3 -3
View File
@@ -112,7 +112,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
[sql|
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
@@ -120,13 +120,13 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) =
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactRequestId, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
connLinkToConnect = toACreatedConnLink_ connFullLink connShortLink
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connLinkToConnect, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connLinkToConnect, contactRequestId, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = do
gm <-
src/Simplex/Chat/Store/Direct.hs
+134 -60
View File
@@ -57,11 +57,15 @@ module Simplex.Chat.Store.Direct
setQuotaErrCounter,
getUserContacts,
createOrUpdateContactRequest,
getAcceptedContactByXContactId,
getAcceptedBusinessChatByXContactId,
getUserContactLinkIdByCReq,
getContactRequest',
getContactRequest,
getContactRequestIdByName,
deleteContactRequest,
createContactFromRequest,
createAcceptedContactConn,
createAcceptedContact,
deleteContactRequestRec,
updateContactAccepted,
@@ -107,7 +111,6 @@ import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util ((<$$>))
import Simplex.Messaging.Version
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
@@ -206,7 +209,7 @@ getContactByConnReqHash db vr 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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@@ -269,6 +272,7 @@ createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToCo
updatedAt = currentTs,
chatTs = Just currentTs,
connLinkToConnect = Just connLinkToConnect,
contactRequestId = Nothing,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
chatTags = [],
@@ -302,6 +306,7 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p
updatedAt = currentTs,
chatTs = Just currentTs,
connLinkToConnect = Nothing,
contactRequestId = Nothing,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
chatTags = [],
@@ -648,24 +653,36 @@ getUserContacts db vr user@User {userId} = do
pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
createOrUpdateContactRequest :: DB.Connection -> VersionRangeChat -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ChatOrRequest
createOrUpdateContactRequest db vr user@User {userId, userContactId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup =
liftIO (maybeM getContactOrGroup xContactId_) >>= \case
Just cr -> pure cr
Nothing -> CORRequest <$> createOrUpdate_
createOrUpdateContactRequest
db
vr
user@User {userId}
uclId
invId
(VersionRange minV maxV)
Profile {displayName, fullName, image, contactLink, preferences}
xContactId_
pqSup =
-- this doesn't return a newly created contact request with contact,
-- because we only set xContactId after contact is accepted
-- (this allows older clients to update contact request by reusing xContactId)
liftIO (maybeM (getAcceptedContactByXContactId db vr user) xContactId_) >>= \case
Just ct -> pure $ CORContact ct
Nothing -> do
(ucr, ct_) <- createOrUpdateRequest
pure $ CORRequest ucr ct_
where
maybeM = maybe (pure Nothing)
getContactOrGroup xContactId =
getContact' xContactId >>= \case
Just ct -> pure $ Just $ CORContact ct
Nothing -> CORGroup <$$> getGroupInfo' xContactId
createOrUpdate_ :: ExceptT StoreError IO UserContactRequest
createOrUpdate_ = do
createOrUpdateRequest :: ExceptT StoreError IO (UserContactRequest, Maybe Contact)
createOrUpdateRequest = do
cReqId <-
ExceptT $
maybeM getContactRequestByXContactId xContactId_ >>= \case
Nothing -> createContactRequest
Just cr@UserContactRequest {contactRequestId} -> updateContactRequest cr $> Right contactRequestId
getContactRequest db user cReqId
ucr@UserContactRequest {contactId_} <- getContactRequest db user cReqId
ct_ <- forM contactId_ $ \contactId -> getContact db vr user contactId
pure (ucr, ct_)
createContactRequest :: IO (Either StoreError Int64)
createContactRequest = do
currentTs <- getCurrentTime
@@ -685,44 +702,20 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
created_at, updated_at, xcontact_id, pq_support)
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
( (userContactLinkId, Binary invId, minV, maxV, profileId, ldn, userId)
( (uclId, Binary invId, minV, maxV, profileId, ldn, userId)
:. (currentTs, currentTs, xContactId_, pqSup)
)
insertedRowId db
getContact' :: XContactId -> IO (Maybe Contact)
getContact' xContactId = do
ct_ <-
maybeFirstRow (toContact vr user []) $
DB.query
contactRequestId <- insertedRowId db
DB.execute
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, xContactId)
mapM (addDirectChatTags db) ct_
getGroupInfo' :: XContactId -> IO (Maybe GroupInfo)
getGroupInfo' xContactId = do
g_ <-
maybeFirstRow (toGroupInfo vr userContactId []) $
DB.query
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?)"
(profileId, ldn, userId, currentTs, currentTs, currentTs, BI True, contactRequestId)
contactId <- insertedRowId db
DB.execute
db
(groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
(xContactId, userId, userContactId)
mapM (addGroupChatTags db) g_
"UPDATE contact_requests SET contact_id = ? WHERE contact_request_id = ?"
(contactId, contactRequestId)
pure contactRequestId
getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
getContactRequestByXContactId xContactId =
maybeFirstRow toContactRequest $
@@ -742,7 +735,7 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
|]
(userId, xContactId)
updateContactRequest :: UserContactRequest -> IO (Either StoreError ())
updateContactRequest UserContactRequest {contactRequestId = cReqId, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do
updateContactRequest UserContactRequest {contactRequestId = cReqId, contactId_, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do
currentTs <- liftIO getCurrentTime
updateProfile currentTs
if displayName == oldDisplayName
@@ -766,6 +759,15 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
WHERE user_id = ? AND contact_request_id = ?
|]
(Binary invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId)
forM_ contactId_ $ \contactId ->
DB.execute
db
[sql|
UPDATE contacts
SET local_display_name = ?, updated_at = ?
WHERE contact_id = ?
|]
(ldn, currentTs, contactId)
safeDeleteLDN db user oldLdn
where
updateProfile currentTs =
@@ -787,6 +789,42 @@ createOrUpdateContactRequest db vr user@User {userId, userContactId} userContact
|]
(displayName, fullName, image, contactLink, currentTs, userId, cReqId)
getAcceptedContactByXContactId :: DB.Connection -> VersionRangeChat -> User -> XContactId -> IO (Maybe Contact)
getAcceptedContactByXContactId db vr user@User {userId} xContactId = do
ct_ <-
maybeFirstRow (toContact vr user []) $
DB.query
db
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
|]
(userId, xContactId)
mapM (addDirectChatTags db) ct_
getAcceptedBusinessChatByXContactId :: DB.Connection -> VersionRangeChat -> User -> XContactId -> IO (Maybe GroupInfo)
getAcceptedBusinessChatByXContactId db vr User {userId, userContactId} xContactId = do
g_ <-
maybeFirstRow (toGroupInfo vr userContactId []) $
DB.query
db
(groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
(xContactId, userId, userContactId)
mapM (addGroupChatTags db) g_
getUserContactLinkIdByCReq :: DB.Connection -> Int64 -> ExceptT StoreError IO Int64
getUserContactLinkIdByCReq db contactRequestId =
ExceptT . firstRow fromOnly (SEContactRequestNotFound contactRequestId) $
@@ -846,20 +884,17 @@ deleteContactRequest db User {userId} contactRequestId = do
(userId, userId, contactRequestId, userId)
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO (Contact, Connection)
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId connChatVersion cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed = do
createdAt <- getCurrentTime
customUserProfileId <- forM incognitoProfile $ \case
NewIncognito p -> createIncognitoProfile_ db userId createdAt p
ExistingIncognito LocalProfile {profileId = pId} -> pure pId
createContactFromRequest :: DB.Connection -> User -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO (Contact, Connection)
createContactFromRequest db user@User {userId, profile = LocalProfile {preferences}} uclId agentConnId connChatVersion cReqChatVRange localDisplayName profileId profile xContactId incognitoProfile subMode pqSup contactUsed = do
currentTs <- getCurrentTime
let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
DB.execute
db
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
(userId, localDisplayName, profileId, BI True, userPreferences, createdAt, createdAt, createdAt, xContactId, BI contactUsed)
(userId, localDisplayName, profileId, BI True, userPreferences, currentTs, currentTs, currentTs, xContactId, BI contactUsed)
contactId <- insertedRowId db
DB.execute db "UPDATE contact_requests SET contact_id = ? WHERE user_id = ? AND local_display_name = ?" (contactId, userId, localDisplayName)
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup
conn <- createAcceptedContactConn db user uclId contactId agentConnId connChatVersion cReqChatVRange pqSup incognitoProfile subMode currentTs
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
ct =
Contact
@@ -873,10 +908,11 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
chatSettings = defaultChatSettings,
userPreferences,
mergedPreferences,
createdAt,
updatedAt = createdAt,
chatTs = Just createdAt,
createdAt = currentTs,
updatedAt = currentTs,
chatTs = Just currentTs,
connLinkToConnect = Nothing,
contactRequestId = Nothing,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
chatTags = [],
@@ -887,6 +923,44 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
}
pure (ct, conn)
createAcceptedContactConn :: DB.Connection -> User -> Int64 -> ContactId -> ConnId -> VersionChat -> VersionRangeChat -> PQSupport -> Maybe IncognitoProfile -> SubscriptionMode -> UTCTime -> IO Connection
createAcceptedContactConn db User {userId} uclId contactId agentConnId connChatVersion cReqChatVRange pqSup incognitoProfile subMode currentTs = do
customUserProfileId <- forM incognitoProfile $ \case
NewIncognito p -> createIncognitoProfile_ db userId currentTs p
ExistingIncognito LocalProfile {profileId = pId} -> pure pId
createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing (Just uclId) customUserProfileId 0 currentTs subMode pqSup
createAcceptedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> Maybe IncognitoProfile -> SubscriptionMode -> ExceptT StoreError IO (Contact, Connection)
createAcceptedContact
db
vr
user@User {userId}
uclId
agentConnId
connChatVersion
cReqChatVRange
Profile {displayName, fullName, image, contactLink, preferences}
xContactId
pqSup
incognitoProfile
subMode = do
currentTs <- liftIO getCurrentTime
let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
contactId <- ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(displayName, fullName, image, contactLink, userId, preferences, currentTs, currentTs)
profileId <- insertedRowId db
DB.execute
db
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
(userId, ldn, profileId, BI True, userPreferences, currentTs, currentTs, currentTs, xContactId, BI True)
Right <$> insertedRowId db
conn <- liftIO $ createAcceptedContactConn db user uclId contactId agentConnId connChatVersion cReqChatVRange pqSup incognitoProfile subMode currentTs
ct <- getContact db vr user contactId
pure (ct, conn)
deleteContactRequestRec :: DB.Connection -> User -> UserContactRequest -> IO ()
deleteContactRequestRec db User {userId} UserContactRequest {contactRequestId} =
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
@@ -916,7 +990,7 @@ getContact_ db vr user@User {userId} contactId deleted = 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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
src/Simplex/Chat/Store/Groups.hs
+28 -17
View File
@@ -1183,23 +1183,31 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo
:. (minV, maxV)
)
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId)
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId)
createJoiningMember
db
gVar
User {userId, userContactId}
GroupInfo {groupId, membership}
UserContactRequest {cReqChatVRange, localDisplayName, profileId}
cReqChatVRange
Profile {displayName, fullName, image, contactLink, preferences}
memberRole
memberStatus =
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
insertMember_ (MemberId memId) createdAt
groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId)
memberStatus = do
currentTs <- liftIO getCurrentTime
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
liftIO $
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(displayName, fullName, image, contactLink, userId, preferences, currentTs, currentTs)
profileId <- liftIO $ insertedRowId db
createWithRandomId gVar $ \memId -> do
insertMember_ ldn profileId (MemberId memId) currentTs
groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId)
where
VersionRange minV maxV = cReqChatVRange
insertMember_ memberId createdAt =
insertMember_ ldn profileId memberId currentTs =
DB.execute
db
[sql|
@@ -1210,30 +1218,33 @@ createJoiningMember
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (groupId, memberId, memberRole, GCInviteeMember, memberStatus, fromInvitedBy userContactId IBUser, groupMemberId' membership)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt)
:. (userId, ldn, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
:. (minV, maxV)
)
createJoiningMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> VersionChat -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
createJoiningMemberConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> GroupMemberId -> SubscriptionMode -> IO ()
createJoiningMemberConnection
db
user@User {userId}
uclId
(cmdId, agentConnId)
chatV
UserContactRequest {cReqChatVRange, userContactLinkId}
cReqChatVRange
groupMemberId
subMode = do
createdAt <- liftIO getCurrentTime
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId ConnNew chatV cReqChatVRange Nothing (Just uclId) Nothing 0 createdAt subMode PQSupportOff
setCommandConnId db user cmdId connId
createBusinessRequestGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> UserContactRequest -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupPreferences -> ExceptT StoreError IO (GroupInfo, GroupMember)
createBusinessRequestGroup
db
vr
gVar
user@User {userId, userContactId}
UserContactRequest {cReqChatVRange, xContactId, profile = Profile {displayName, fullName, image, contactLink, preferences}}
cReqChatVRange
Profile {displayName, fullName, image, contactLink, preferences}
xContactId
groupPreferences = do
currentTs <- liftIO getCurrentTime
(groupId, membership@GroupMember {memberId = userMemberId}) <- insertGroup_ currentTs
@@ -2435,7 +2446,7 @@ createMemberContact
quotaErrCounter = 0
}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connLinkToConnect = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connLinkToConnect = Nothing, contactRequestId = Nothing, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db vr user contactId = do
@@ -2472,7 +2483,7 @@ createMemberContactInvited
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 = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connLinkToConnect = Nothing, contactGroupMemberId = Nothing, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, connLinkToConnect = Nothing, contactRequestId = Nothing, contactGroupMemberId = Nothing, contactGrpInvSent = False, chatTags = [], chatItemTTL = Nothing, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
m' = m {memberContactId = Just contactId}
pure (mCt', m')
where
src/Simplex/Chat/Store/Messages.hs
+1
View File
@@ -1061,6 +1061,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
AND uc.user_id = ?
AND uc.local_display_name = ''
AND uc.group_id IS NULL
AND cr.contact_id IS NULL
AND (
LOWER(cr.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(p.display_name) LIKE '%' || LOWER(?) || '%'
src/Simplex/Chat/Store/SQLite/Migrations/M20250526_short_links.hs
+6 -3
View File
@@ -5,15 +5,15 @@ module Simplex.Chat.Store.SQLite.Migrations.M20250526_short_links where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
-- TODO [short links] contacts with contact requests
-- TODO - contacts.is_contact_request flag?
-- TODO - link contact_requests and contacts?
m20250526_short_links :: Query
m20250526_short_links =
[sql|
ALTER TABLE contacts ADD COLUMN conn_full_link_to_connect BLOB;
ALTER TABLE contacts ADD COLUMN conn_short_link_to_connect BLOB;
ALTER TABLE contacts ADD COLUMN contact_request_id INTEGER REFERENCES contact_requests ON DELETE SET NULL;
CREATE INDEX idx_contacts_contact_request_id ON contacts(contact_request_id);
ALTER TABLE groups ADD COLUMN conn_full_link_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_short_link_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_link_started_connection INTEGER NOT NULL DEFAULT 0;
@@ -25,6 +25,9 @@ down_m20250526_short_links =
ALTER TABLE contacts DROP COLUMN conn_full_link_to_connect;
ALTER TABLE contacts DROP COLUMN conn_short_link_to_connect;
DROP INDEX idx_contacts_contact_request_id;
ALTER TABLE contacts DROP COLUMN contact_request_id;
ALTER TABLE groups DROP COLUMN conn_full_link_to_connect;
ALTER TABLE groups DROP COLUMN conn_short_link_to_connect;
ALTER TABLE groups DROP COLUMN conn_link_started_connection;
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
+44 -28
View File
@@ -1,3 +1,11 @@
Query:
UPDATE contacts
SET local_display_name = ?, updated_at = ?
WHERE contact_id = ?
Plan:
SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE groups
SET chat_ts = ?,
@@ -169,29 +177,6 @@ Query:
Plan:
Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
Plan:
SEARCH ct USING INDEX idx_contacts_chat_ts (user_id=?)
SEARCH cp USING INTEGER PRIMARY KEY (rowid=?)
SEARCH c USING INDEX idx_connections_contact_id (contact_id=?) LEFT-JOIN
USE TEMP B-TREE FOR ORDER BY
Query:
SELECT COUNT(1)
FROM chat_items i
@@ -342,7 +327,7 @@ Plan:
Query:
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
@@ -859,7 +844,7 @@ Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@@ -878,6 +863,29 @@ SEARCH ct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH cp USING INTEGER PRIMARY KEY (rowid=?)
USE TEMP B-TREE FOR ORDER BY
Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
LEFT JOIN connections c ON c.contact_id = ct.contact_id
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
ORDER BY c.created_at DESC
LIMIT 1
Plan:
SEARCH ct USING INDEX idx_contacts_chat_ts (user_id=?)
SEARCH cp USING INTEGER PRIMARY KEY (rowid=?)
SEARCH c USING INDEX idx_connections_contact_id (contact_id=?) LEFT-JOIN
USE TEMP B-TREE FOR ORDER BY
Query:
SELECT
-- GroupInfo
@@ -1431,7 +1439,7 @@ Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@@ -1543,6 +1551,7 @@ Query:
AND uc.user_id = ?
AND uc.local_display_name = ''
AND uc.group_id IS NULL
AND cr.contact_id IS NULL
AND (
LOWER(cr.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(p.display_name) LIKE '%' || LOWER(?) || '%'
@@ -1569,6 +1578,7 @@ Query:
AND uc.user_id = ?
AND uc.local_display_name = ''
AND uc.group_id IS NULL
AND cr.contact_id IS NULL
AND (
LOWER(cr.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(p.display_name) LIKE '%' || LOWER(?) || '%'
@@ -1595,6 +1605,7 @@ Query:
AND uc.user_id = ?
AND uc.local_display_name = ''
AND uc.group_id IS NULL
AND cr.contact_id IS NULL
AND (
LOWER(cr.local_display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(p.display_name) LIKE '%' || LOWER(?) || '%'
@@ -5306,6 +5317,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_profile_id (contact_pr
Query: DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?
Plan:
SEARCH contact_requests USING INTEGER PRIMARY KEY (rowid=?)
SEARCH contacts USING COVERING INDEX idx_contacts_contact_request_id (contact_request_id=?)
Query: DELETE FROM contacts WHERE user_id = ? AND contact_id = ?
Plan:
@@ -5557,6 +5569,10 @@ Query: INSERT INTO contact_profiles (display_name, full_name, image, user_id, pr
Plan:
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, created_at, updated_at, chat_ts, contact_used, contact_request_id) VALUES (?,?,?,?,?,?,?,?)
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
@@ -5940,9 +5956,9 @@ Query: UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1
Plan:
SEARCH connections USING INDEX idx_connections_to_subscribe (to_subscribe=?)
Query: UPDATE contact_requests SET contact_id = ? WHERE user_id = ? AND local_display_name = ?
Query: UPDATE contact_requests SET contact_id = ? WHERE contact_request_id = ?
Plan:
SEARCH contact_requests USING INDEX sqlite_autoindex_contact_requests_1 (user_id=? AND local_display_name=?)
SEARCH contact_requests USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?
Plan:
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
+2
View File
@@ -81,6 +81,7 @@ CREATE TABLE contacts(
chat_item_ttl INTEGER,
conn_full_link_to_connect BLOB,
conn_short_link_to_connect BLOB,
contact_request_id INTEGER REFERENCES contact_requests ON DELETE SET NULL,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@@ -1053,3 +1054,4 @@ CREATE INDEX idx_chat_items_group_scope_item_status ON chat_items(
item_status,
item_ts
);
CREATE INDEX idx_contacts_contact_request_id ON contacts(contact_request_id);
src/Simplex/Chat/Store/Shared.hs
+3 -8
View File
@@ -46,7 +46,6 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..))
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (allFinally)
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
@@ -178,10 +177,6 @@ handleSQLError err e
| constraintError e = err
| otherwise = SEInternalError $ show e
storeFinally :: ExceptT StoreError IO a -> ExceptT StoreError IO b -> ExceptT StoreError IO a
storeFinally = allFinally mkStoreError
{-# INLINE storeFinally #-}
mkStoreError :: E.SomeException -> StoreError
mkStoreError = SEInternalError . show
{-# INLINE mkStoreError #-}
@@ -426,19 +421,19 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|]
(userId, profileId, userId, profileId, userId, profileId)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe GroupMemberId, BoolInt, Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe Int64, Maybe GroupMemberId, BoolInt, Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow = Only ContactId :. ContactRow'
toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactRequestId, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toMaybeConnection vr connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
connLinkToConnect = toACreatedConnLink_ connFullLink connShortLink
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connLinkToConnect, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, connLinkToConnect, contactRequestId, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
toACreatedConnLink_ :: Maybe AConnectionRequestUri -> Maybe AConnShortLink -> Maybe ACreatedConnLink
toACreatedConnLink_ connFullLink connShortLink = case (connFullLink, connShortLink) of
src/Simplex/Chat/Terminal/Output.hs
+1 -1
View File
@@ -211,7 +211,7 @@ chatEventNotification t@ChatTerminal {sendNotification} cc = \case
when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is pending review")
CEvtConnectedToGroupMember u g m _ ->
when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected")
CEvtReceivedContactRequest u UserContactRequest {localDisplayName = n} ->
CEvtReceivedContactRequest u UserContactRequest {localDisplayName = n} _ ->
when (userNtf u) $ sendNtf (viewName n <> ">", "wants to connect to you")
_ -> pure ()
where
src/Simplex/Chat/Types.hs
+5 -1
View File
@@ -189,6 +189,7 @@ data Contact = Contact
updatedAt :: UTCTime,
chatTs :: Maybe UTCTime,
connLinkToConnect :: Maybe ACreatedConnLink,
contactRequestId :: Maybe Int64,
contactGroupMemberId :: Maybe GroupMemberId,
contactGrpInvSent :: Bool,
chatTags :: [ChatTagId],
@@ -366,7 +367,10 @@ instance ToJSON ConnReqUriHash where
toJSON = strToJSON
toEncoding = strToJEncoding
data ChatOrRequest = CORContact Contact | CORGroup GroupInfo | CORRequest UserContactRequest
data ChatOrRequest
= CORContact Contact
-- Contact is Maybe for backward compatibility with legacy requests, all new requests are created with contact
| CORRequest UserContactRequest (Maybe Contact)
type UserName = Text
src/Simplex/Chat/View.hs
+3 -3
View File
@@ -172,7 +172,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
CRContactsList u cs -> ttyUser u $ viewContactsList cs
CRUserContactLink u UserContactLink {connLinkContact, autoAccept} -> ttyUser u $ connReqContact_ "Your chat address:" connLinkContact <> autoAcceptStatus_ autoAccept
CRUserContactLinkUpdated u UserContactLink {autoAccept} -> ttyUser u $ autoAcceptStatus_ autoAccept
CRContactRequestRejected u UserContactRequest {localDisplayName = c} -> ttyUser u [ttyContact c <> ": contact request rejected"]
CRContactRequestRejected u UserContactRequest {localDisplayName = c} _ct_ -> ttyUser u [ttyContact c <> ": contact request rejected"]
CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView
CRGroupMembers u g -> ttyUser u $ viewGroupMembers g
CRMemberSupportChats u g ms -> ttyUser u $ viewMemberSupportChats g ms
@@ -416,7 +416,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
CEvtContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
CEvtGroupMemberUpdated {} -> []
CEvtContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
CEvtReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
CEvtReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} _ct_ -> ttyUser u $ viewReceivedContactRequest c profile
CEvtRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
CEvtRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
CEvtRcvStandaloneFileComplete u _ ft -> ttyUser u $ receivingFileStandalone "completed" ft
@@ -1826,7 +1826,7 @@ viewConnectionUserChanged User {localDisplayName = n} PendingContactConnection {
cReqStr = strEncode $ simplexChatInvitation cReq
viewConnectionPlan :: ChatConfig -> ACreatedConnLink -> ConnectionPlan -> [StyledString]
viewConnectionPlan ChatConfig {logLevel, testView} connLink = \case
viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
CPInvitationLink ilp -> case ilp of
ILPOk contactSLinkData -> [invLink "ok to connect"] <> [viewJSON contactSLinkData | testView]
ILPOwnLink -> [invLink "own link"]