mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-29 04:39:53 +00:00
remove group requests (revert)
This commit is contained in:
parent
3a9811f1c0
commit
a3dc90be6e
10 changed files with 140 additions and 162 deletions
|
@ -922,18 +922,22 @@ acceptContactRequestAsync
|
||||||
liftIO $ setCommandConnId db user cmdId connId
|
liftIO $ setCommandConnId db user cmdId connId
|
||||||
getContact db vr user contactId
|
getContact db vr user contactId
|
||||||
|
|
||||||
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> GroupMember -> UserContactRequest -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
|
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
|
||||||
acceptGroupJoinRequestAsync
|
acceptGroupJoinRequestAsync
|
||||||
user
|
user
|
||||||
uclId
|
uclId
|
||||||
gInfo@GroupInfo {groupProfile, membership, businessChat}
|
gInfo@GroupInfo {groupProfile, membership, businessChat}
|
||||||
member@GroupMember {groupMemberId, memberId}
|
cReqInvId
|
||||||
ucr@UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange}
|
cReqChatVRange
|
||||||
|
cReqProfile
|
||||||
|
cReqXContactId_
|
||||||
gAccepted
|
gAccepted
|
||||||
gLinkMemRole
|
gLinkMemRole
|
||||||
incognitoProfile = do
|
incognitoProfile = do
|
||||||
|
gVar <- asks random
|
||||||
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
|
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
|
||||||
_member' <- withStore' $ \db -> setMemberRoleStatus db member gLinkMemRole initialStatus
|
(groupMemberId, memberId) <- withStore $ \db ->
|
||||||
|
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ gLinkMemRole initialStatus
|
||||||
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
|
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
|
||||||
let Profile {displayName} = profileToSendOnAccept user incognitoProfile True
|
let Profile {displayName} = profileToSendOnAccept user incognitoProfile True
|
||||||
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||||
|
@ -953,19 +957,22 @@ acceptGroupJoinRequestAsync
|
||||||
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
||||||
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
|
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
|
||||||
withStore $ \db -> do
|
withStore $ \db -> do
|
||||||
liftIO $ setContactRequestAccepted db ucr
|
|
||||||
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
||||||
getGroupMemberById db vr user groupMemberId
|
getGroupMemberById db vr user groupMemberId
|
||||||
|
|
||||||
acceptGroupJoinSendRejectAsync :: User -> Int64 -> GroupInfo -> GroupMember -> UserContactRequest -> GroupRejectionReason -> CM GroupMember
|
acceptGroupJoinSendRejectAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupRejectionReason -> CM GroupMember
|
||||||
acceptGroupJoinSendRejectAsync
|
acceptGroupJoinSendRejectAsync
|
||||||
user
|
user
|
||||||
uclId
|
uclId
|
||||||
GroupInfo {groupProfile, membership}
|
gInfo@GroupInfo {groupProfile, membership}
|
||||||
member@GroupMember {groupMemberId, memberId}
|
cReqInvId
|
||||||
ucr@UserContactRequest {agentInvitationId = AgentInvId cReqInvId, cReqChatVRange}
|
cReqChatVRange
|
||||||
|
cReqProfile
|
||||||
|
cReqXContactId_
|
||||||
rejectionReason = do
|
rejectionReason = do
|
||||||
_member' <- withStore' $ \db -> setMemberRoleStatus db member GRObserver GSMemRejected
|
gVar <- asks random
|
||||||
|
(groupMemberId, memberId) <- withStore $ \db ->
|
||||||
|
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ GRObserver GSMemRejected
|
||||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||||
msg =
|
msg =
|
||||||
XGrpLinkReject $
|
XGrpLinkReject $
|
||||||
|
@ -980,7 +987,6 @@ acceptGroupJoinSendRejectAsync
|
||||||
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
||||||
connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
|
connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
|
||||||
withStore $ \db -> do
|
withStore $ \db -> do
|
||||||
liftIO $ setContactRequestAccepted db ucr
|
|
||||||
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
||||||
getGroupMemberById db vr user groupMemberId
|
getGroupMemberById db vr user groupMemberId
|
||||||
|
|
||||||
|
|
|
@ -1238,93 +1238,94 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||||
where
|
where
|
||||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> CM ()
|
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> CM ()
|
||||||
profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ welcomeMsgId_ requestMsg_ reqPQSup = do
|
profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ welcomeMsgId_ requestMsg_ reqPQSup = do
|
||||||
uclGLinkInfo <- withStore $ \db -> getUserContactLinkById db userId uclId
|
(ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId
|
||||||
let (UserContactLink {connLinkContact = CCLink connReq _, shortLinkDataSet, addressSettings}, gLinkInfo_) = uclGLinkInfo
|
let v = maxVersion chatVRange
|
||||||
AddressSettings {autoAccept} = addressSettings
|
case gLinkInfo_ of
|
||||||
isSimplexTeam = sameConnReqContact connReq adminContactReq
|
-- ##### Contact requests (regular and business contacts) #####
|
||||||
v = maxVersion chatVRange
|
Nothing -> do
|
||||||
gVar <- asks random
|
let UserContactLink {connLinkContact = CCLink connReq _, shortLinkDataSet, addressSettings} = ucl
|
||||||
withStore (\db -> createOrUpdateContactRequest db gVar vr user uclId uclGLinkInfo isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup) >>= \case
|
AddressSettings {autoAccept} = addressSettings
|
||||||
RSAcceptedRequest _ucr re -> case re of
|
isSimplexTeam = sameConnReqContact connReq adminContactReq
|
||||||
REContact ct ->
|
gVar <- asks random
|
||||||
-- TODO update request msg
|
withStore (\db -> createOrUpdateContactRequest db gVar vr user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup) >>= \case
|
||||||
toView $ CEvtContactRequestAlreadyAccepted user ct
|
RSAcceptedRequest _ucr re -> case re of
|
||||||
REBusinessChat gInfo _clientMember ->
|
REContact ct ->
|
||||||
-- TODO update request msg
|
|
||||||
toView $ CEvtBusinessRequestAlreadyAccepted user gInfo
|
|
||||||
REGroupMember _gInfo _m -> pure ()
|
|
||||||
RSCurrentRequest ucr re_ repeatRequest -> case re_ of
|
|
||||||
Nothing -> toView $ CEvtReceivedContactRequest user ucr Nothing
|
|
||||||
Just (REContact ct) -> do
|
|
||||||
-- TODO [short links] prevent duplicate items
|
|
||||||
-- update welcome message if changed (send update event to UI) and add updated feature items.
|
|
||||||
-- Do not created e2e item on repeat request
|
|
||||||
if repeatRequest
|
|
||||||
then do
|
|
||||||
-- TODO update request msg
|
-- TODO update request msg
|
||||||
-- ....
|
toView $ CEvtContactRequestAlreadyAccepted user ct
|
||||||
acceptOrShow Nothing -- pass item?
|
REBusinessChat gInfo _clientMember ->
|
||||||
else do
|
-- TODO update request msg
|
||||||
-- TODO [short links] save sharedMsgId instead of the last Nothing
|
toView $ CEvtBusinessRequestAlreadyAccepted user gInfo
|
||||||
let createItem content = createChatItem user (CDDirectRcv ct) False content Nothing Nothing
|
RSCurrentRequest ucr re_ repeatRequest -> case re_ of
|
||||||
void $ createItem $ CIRcvDirectE2EEInfo $ E2EInfo $ Just $ CR.pqSupportToEnc $ reqPQSup
|
Nothing -> toView $ CEvtReceivedContactRequest user ucr Nothing
|
||||||
void $ createFeatureEnabledItems_ user ct
|
Just (REContact ct) -> do
|
||||||
|
-- TODO [short links] prevent duplicate items
|
||||||
|
-- update welcome message if changed (send update event to UI) and add updated feature items.
|
||||||
|
-- Do not created e2e item on repeat request
|
||||||
|
if repeatRequest
|
||||||
|
then do
|
||||||
|
-- TODO update request msg
|
||||||
|
-- ....
|
||||||
|
acceptOrShow Nothing -- pass item?
|
||||||
|
else do
|
||||||
|
-- TODO [short links] save sharedMsgId instead of the last Nothing
|
||||||
|
let createItem content = createChatItem user (CDDirectRcv ct) False content Nothing Nothing
|
||||||
|
void $ createItem $ CIRcvDirectE2EEInfo $ E2EInfo $ Just $ CR.pqSupportToEnc $ reqPQSup
|
||||||
|
void $ createFeatureEnabledItems_ user ct
|
||||||
|
-- TODO [short links] save sharedMsgId
|
||||||
|
aci <- forM requestMsg_ $ \(sharedMsgId, mc) -> do
|
||||||
|
aci <- createItem $ CIRcvMsgContent mc
|
||||||
|
unlessM (asks $ coreApi . config) $ toView $ CEvtNewChatItems user [aci]
|
||||||
|
pure aci
|
||||||
|
acceptOrShow aci
|
||||||
|
where
|
||||||
|
acceptOrShow aci_ =
|
||||||
|
case autoAccept of
|
||||||
|
Nothing -> do
|
||||||
|
let cInfo = DirectChat ct
|
||||||
|
chat = AChat SCTDirect $ case aci_ of
|
||||||
|
Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
|
||||||
|
_ -> Chat cInfo [] emptyChatStats
|
||||||
|
toView $ CEvtReceivedContactRequest user ucr (Just chat)
|
||||||
|
Just AutoAccept {acceptIncognito} -> do
|
||||||
|
incognitoProfile <-
|
||||||
|
if not shortLinkDataSet && acceptIncognito
|
||||||
|
then Just . NewIncognito <$> liftIO generateRandomProfile
|
||||||
|
else pure Nothing
|
||||||
|
ct' <- acceptContactRequestAsync user uclId ct ucr incognitoProfile
|
||||||
|
-- chat in event?
|
||||||
|
toView $ CEvtAcceptingContactRequest user ct'
|
||||||
|
Just (REBusinessChat gInfo clientMember) -> do
|
||||||
|
-- TODO [short links] prevent duplicate items (use repeatRequest like for REContact)
|
||||||
|
(_gInfo', _clientMember') <- acceptBusinessJoinRequestAsync user uclId gInfo clientMember ucr
|
||||||
|
-- TODO [short links] add welcome message if welcomeMsgId is present
|
||||||
|
-- forM_ autoReply $ \arMC ->
|
||||||
|
-- when (shortLinkDataSet && v >= shortLinkDataVersion) $
|
||||||
|
-- createInternalChatItem user (CDGroupSnd gInfo Nothing) (CISndMsgContent arMC) Nothing
|
||||||
-- TODO [short links] save sharedMsgId
|
-- TODO [short links] save sharedMsgId
|
||||||
aci <- forM requestMsg_ $ \(sharedMsgId, mc) -> do
|
forM_ requestMsg_ $ \(sharedMsgId, mc) ->
|
||||||
aci <- createItem $ CIRcvMsgContent mc
|
createInternalChatItem user (CDGroupRcv gInfo Nothing clientMember) (CIRcvMsgContent mc) Nothing
|
||||||
unlessM (asks $ coreApi . config) $ toView $ CEvtNewChatItems user [aci]
|
toView $ CEvtAcceptingBusinessRequest user gInfo
|
||||||
pure aci
|
-- ##### Group link join requests #####
|
||||||
acceptOrShow aci
|
Just gli@GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
|
||||||
where
|
-- TODO deduplicate request by xContactId?
|
||||||
acceptOrShow aci_ =
|
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
|
||||||
case autoAccept of
|
acceptMember_ <- asks $ acceptMember . chatHooks . config
|
||||||
Nothing -> do
|
maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case
|
||||||
let cInfo = DirectChat ct
|
Right (acceptance, useRole)
|
||||||
chat = AChat SCTDirect $ case aci_ of
|
| v < groupFastLinkJoinVersion ->
|
||||||
Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
|
messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
|
||||||
_ -> Chat cInfo [] emptyChatStats
|
| otherwise -> do
|
||||||
toView $ CEvtReceivedContactRequest user ucr (Just chat)
|
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||||
Just AutoAccept {acceptIncognito} -> do
|
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ acceptance useRole profileMode
|
||||||
incognitoProfile <-
|
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
|
||||||
if not shortLinkDataSet && acceptIncognito
|
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||||
then Just . NewIncognito <$> liftIO generateRandomProfile
|
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
|
||||||
else pure Nothing
|
Left rjctReason
|
||||||
ct' <- acceptContactRequestAsync user uclId ct ucr incognitoProfile
|
| v < groupJoinRejectVersion ->
|
||||||
-- chat in event?
|
messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked"
|
||||||
toView $ CEvtAcceptingContactRequest user ct'
|
| otherwise -> do
|
||||||
Just (REBusinessChat gInfo clientMember) -> do
|
mem <- acceptGroupJoinSendRejectAsync user uclId gInfo invId chatVRange p xContactId_ rjctReason
|
||||||
-- TODO [short links] prevent duplicate items (use repeatRequest like for REContact)
|
toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
|
||||||
(_gInfo', _clientMember') <- acceptBusinessJoinRequestAsync user uclId gInfo clientMember ucr
|
|
||||||
-- TODO [short links] add welcome message if welcomeMsgId is present
|
|
||||||
-- forM_ autoReply $ \arMC ->
|
|
||||||
-- when (shortLinkDataSet && v >= shortLinkDataVersion) $
|
|
||||||
-- createInternalChatItem user (CDGroupSnd gInfo Nothing) (CISndMsgContent arMC) Nothing
|
|
||||||
-- TODO [short links] save sharedMsgId
|
|
||||||
forM_ requestMsg_ $ \(sharedMsgId, mc) ->
|
|
||||||
createInternalChatItem user (CDGroupRcv gInfo Nothing clientMember) (CIRcvMsgContent mc) Nothing
|
|
||||||
toView $ CEvtAcceptingBusinessRequest user gInfo
|
|
||||||
Just (REGroupMember gInfo mem) -> case gLinkInfo_ of
|
|
||||||
Nothing -> throwChatError $ CEException "processUserContactRequest: no group link info not found for group member request"
|
|
||||||
Just gli@GroupLinkInfo {memberRole = gLinkMemRole} -> do
|
|
||||||
acceptMember_ <- asks $ acceptMember . chatHooks . config
|
|
||||||
maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case
|
|
||||||
Right (acceptance, useRole)
|
|
||||||
| v < groupFastLinkJoinVersion -> do
|
|
||||||
withStore' $ \db -> deleteGroupMember db user mem
|
|
||||||
messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
|
|
||||||
| otherwise -> do
|
|
||||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
|
||||||
mem' <- acceptGroupJoinRequestAsync user uclId gInfo mem ucr 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 -> do
|
|
||||||
withStore' $ \db -> deleteGroupMember db user mem
|
|
||||||
messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked"
|
|
||||||
| otherwise -> do
|
|
||||||
mem' <- acceptGroupJoinSendRejectAsync user uclId gInfo mem ucr rjctReason
|
|
||||||
toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem' rjctReason
|
|
||||||
|
|
||||||
memberCanSend :: GroupMember -> Maybe MsgScope -> CM () -> CM ()
|
memberCanSend :: GroupMember -> Maybe MsgScope -> CM () -> CM ()
|
||||||
memberCanSend m@GroupMember {memberRole} msgScope a = case msgScope of
|
memberCanSend m@GroupMember {memberRole} msgScope a = case msgScope of
|
||||||
|
|
|
@ -28,7 +28,6 @@ import Simplex.Chat.Store.Shared
|
||||||
import Simplex.Chat.Store.Profiles
|
import Simplex.Chat.Store.Profiles
|
||||||
import Simplex.Chat.Types
|
import Simplex.Chat.Types
|
||||||
import Simplex.Chat.Types.Preferences
|
import Simplex.Chat.Types.Preferences
|
||||||
import Simplex.Chat.Types.Shared
|
|
||||||
import Simplex.Messaging.Agent.Protocol (InvitationId)
|
import Simplex.Messaging.Agent.Protocol (InvitationId)
|
||||||
import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow)
|
import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow)
|
||||||
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
|
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
|
||||||
|
@ -50,7 +49,7 @@ createOrUpdateContactRequest ::
|
||||||
-> VersionRangeChat
|
-> VersionRangeChat
|
||||||
-> User
|
-> User
|
||||||
-> Int64
|
-> Int64
|
||||||
-> (UserContactLink, Maybe GroupLinkInfo)
|
-> UserContactLink
|
||||||
-> Bool
|
-> Bool
|
||||||
-> InvitationId
|
-> InvitationId
|
||||||
-> VersionRangeChat
|
-> VersionRangeChat
|
||||||
|
@ -66,7 +65,7 @@ createOrUpdateContactRequest
|
||||||
vr
|
vr
|
||||||
user@User {userId, userContactId}
|
user@User {userId, userContactId}
|
||||||
uclId
|
uclId
|
||||||
uclGLinkInfo
|
UserContactLink {addressSettings = AddressSettings {businessAddress}}
|
||||||
isSimplexTeam
|
isSimplexTeam
|
||||||
invId
|
invId
|
||||||
cReqChatVRange@(VersionRange minV maxV)
|
cReqChatVRange@(VersionRange minV maxV)
|
||||||
|
@ -150,7 +149,7 @@ createOrUpdateContactRequest
|
||||||
[sql|
|
[sql|
|
||||||
SELECT
|
SELECT
|
||||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
||||||
cr.contact_id, cr.group_member_id, cr.business_group_id, cr.user_contact_link_id,
|
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
|
||||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id,
|
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id,
|
||||||
cr.pq_support, cr.accepted, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
cr.pq_support, cr.accepted, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
||||||
cr.created_at, cr.updated_at,
|
cr.created_at, cr.updated_at,
|
||||||
|
@ -188,18 +187,12 @@ createOrUpdateContactRequest
|
||||||
contactRequestId <- liftIO $ insertedRowId db
|
contactRequestId <- liftIO $ insertedRowId db
|
||||||
createRequestEntity ldn profileId contactRequestId currentTs
|
createRequestEntity ldn profileId contactRequestId currentTs
|
||||||
where
|
where
|
||||||
createRequestEntity ldn profileId contactRequestId currentTs = do
|
createRequestEntity ldn profileId contactRequestId currentTs
|
||||||
let (UserContactLink {addressSettings}, gLinkInfo_) = uclGLinkInfo
|
| businessAddress =
|
||||||
AddressSettings {businessAddress} = addressSettings
|
|
||||||
if businessAddress
|
|
||||||
then
|
|
||||||
if isSimplexTeam && maxV < businessChatsVersion
|
if isSimplexTeam && maxV < businessChatsVersion
|
||||||
then createContact'
|
then createContact'
|
||||||
else createBusinessChat
|
else createBusinessChat
|
||||||
else
|
| otherwise = createContact'
|
||||||
case gLinkInfo_ of
|
|
||||||
Nothing -> createContact'
|
|
||||||
Just gli -> createGroupMember gli
|
|
||||||
where
|
where
|
||||||
createContact' = do
|
createContact' = do
|
||||||
liftIO $
|
liftIO $
|
||||||
|
@ -216,17 +209,6 @@ createOrUpdateContactRequest
|
||||||
ucr <- getContactRequest db user contactRequestId
|
ucr <- getContactRequest db user contactRequestId
|
||||||
ct <- getContact db vr user contactId
|
ct <- getContact db vr user contactId
|
||||||
pure $ RSCurrentRequest ucr (Just $ REContact ct) False
|
pure $ RSCurrentRequest ucr (Just $ REContact ct) False
|
||||||
createGroupMember GroupLinkInfo {groupId} = do
|
|
||||||
gInfo <- getGroupInfo db vr user groupId
|
|
||||||
gmId <- createJoiningMember db gVar user gInfo cReqChatVRange profileId ldn GRObserver GSMemUnknown
|
|
||||||
gm <- getGroupMemberById db vr user gmId
|
|
||||||
liftIO $
|
|
||||||
DB.execute
|
|
||||||
db
|
|
||||||
"UPDATE contact_requests SET group_member_id = ? WHERE contact_request_id = ?"
|
|
||||||
(gmId, contactRequestId)
|
|
||||||
ucr <- getContactRequest db user contactRequestId
|
|
||||||
pure $ RSCurrentRequest ucr (Just $ REGroupMember gInfo gm) False
|
|
||||||
createBusinessChat = do
|
createBusinessChat = do
|
||||||
let Profile {preferences = userPreferences} = profileToSendOnAccept user Nothing True
|
let Profile {preferences = userPreferences} = profileToSendOnAccept user Nothing True
|
||||||
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs userPreferences
|
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs userPreferences
|
||||||
|
@ -301,23 +283,19 @@ createOrUpdateContactRequest
|
||||||
(ldn, currentTs, contactId)
|
(ldn, currentTs, contactId)
|
||||||
safeDeleteLDN db user oldLdn
|
safeDeleteLDN db user oldLdn
|
||||||
getRequestEntity :: UserContactRequest -> ExceptT StoreError IO (Maybe RequestEntity)
|
getRequestEntity :: UserContactRequest -> ExceptT StoreError IO (Maybe RequestEntity)
|
||||||
getRequestEntity UserContactRequest {contactRequestId, contactId_, groupMemberId_, businessGroupId_} =
|
getRequestEntity UserContactRequest {contactRequestId, contactId_, businessGroupId_} =
|
||||||
case (contactId_, groupMemberId_, businessGroupId_) of
|
case (contactId_, businessGroupId_) of
|
||||||
(Just contactId, Nothing, Nothing) -> do
|
(Just contactId, Nothing) -> do
|
||||||
ct <- getContact db vr user contactId
|
ct <- getContact db vr user contactId
|
||||||
pure $ Just (REContact ct)
|
pure $ Just (REContact ct)
|
||||||
(Nothing, Just groupMemberId, Nothing) -> do
|
(Nothing, Just businessGroupId) -> do
|
||||||
gm@GroupMember {groupId} <- getGroupMemberById db vr user groupMemberId
|
|
||||||
gInfo <- getGroupInfo db vr user groupId
|
|
||||||
pure $ Just (REGroupMember gInfo gm)
|
|
||||||
(Nothing, Nothing, Just businessGroupId) -> do
|
|
||||||
gInfo <- getGroupInfo db vr user businessGroupId
|
gInfo <- getGroupInfo db vr user businessGroupId
|
||||||
case gInfo of
|
case gInfo of
|
||||||
GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
|
GroupInfo {businessChat = Just BusinessChatInfo {customerId}} -> do
|
||||||
clientMember <- getGroupMemberByMemberId db vr user gInfo customerId
|
clientMember <- getGroupMemberByMemberId db vr user gInfo customerId
|
||||||
pure $ Just (REBusinessChat gInfo clientMember)
|
pure $ Just (REBusinessChat gInfo clientMember)
|
||||||
_ -> throwError SEInvalidBusinessChatContactRequest
|
_ -> throwError SEInvalidBusinessChatContactRequest
|
||||||
(Nothing, Nothing, Nothing) -> pure Nothing
|
(Nothing, Nothing) -> pure Nothing
|
||||||
_ -> throwError $ SEInvalidContactRequestEntity contactRequestId
|
_ -> throwError $ SEInvalidContactRequestEntity contactRequestId
|
||||||
|
|
||||||
setContactRequestAccepted :: DB.Connection -> UserContactRequest -> IO ()
|
setContactRequestAccepted :: DB.Connection -> UserContactRequest -> IO ()
|
||||||
|
|
|
@ -688,7 +688,7 @@ getContactRequest db User {userId} contactRequestId =
|
||||||
[sql|
|
[sql|
|
||||||
SELECT
|
SELECT
|
||||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
||||||
cr.contact_id, cr.group_member_id, cr.business_group_id, cr.user_contact_link_id,
|
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
|
||||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id,
|
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id,
|
||||||
cr.pq_support, cr.accepted, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
cr.pq_support, cr.accepted, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
||||||
cr.created_at, cr.updated_at,
|
cr.created_at, cr.updated_at,
|
||||||
|
|
|
@ -76,7 +76,6 @@ module Simplex.Chat.Store.Groups
|
||||||
createNewContactMember,
|
createNewContactMember,
|
||||||
createNewContactMemberAsync,
|
createNewContactMemberAsync,
|
||||||
createJoiningMember,
|
createJoiningMember,
|
||||||
setMemberRoleStatus,
|
|
||||||
createJoiningMemberConnection,
|
createJoiningMemberConnection,
|
||||||
createBusinessRequestGroup,
|
createBusinessRequestGroup,
|
||||||
getContactViaMember,
|
getContactViaMember,
|
||||||
|
@ -1231,51 +1230,46 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo
|
||||||
:. (minV, maxV)
|
:. (minV, maxV)
|
||||||
)
|
)
|
||||||
|
|
||||||
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Int64 -> ContactName -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO GroupMemberId
|
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||||
createJoiningMember
|
createJoiningMember
|
||||||
db
|
db
|
||||||
gVar
|
gVar
|
||||||
User {userId, userContactId}
|
User {userId, userContactId}
|
||||||
GroupInfo {groupId, membership}
|
GroupInfo {groupId, membership}
|
||||||
cReqChatVRange
|
cReqChatVRange
|
||||||
profileId
|
Profile {displayName, fullName, image, contactLink, preferences}
|
||||||
ldn
|
cReqXContactId_
|
||||||
memberRole
|
memberRole
|
||||||
memberStatus = do
|
memberStatus = do
|
||||||
currentTs <- liftIO getCurrentTime
|
currentTs <- liftIO getCurrentTime
|
||||||
createWithRandomId gVar $ \memId -> do
|
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
|
||||||
insertMember_ (MemberId memId) currentTs
|
liftIO $
|
||||||
liftIO $ insertedRowId db
|
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
|
where
|
||||||
VersionRange minV maxV = cReqChatVRange
|
VersionRange minV maxV = cReqChatVRange
|
||||||
insertMember_ memberId currentTs =
|
insertMember_ ldn profileId memberId currentTs =
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
[sql|
|
[sql|
|
||||||
INSERT INTO group_members
|
INSERT INTO group_members
|
||||||
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, created_at, updated_at,
|
||||||
peer_chat_min_version, peer_chat_max_version)
|
peer_chat_min_version, peer_chat_max_version)
|
||||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||||
|]
|
|]
|
||||||
( (groupId, memberId, memberRole, GCInviteeMember, memberStatus, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
( (groupId, memberId, memberRole, GCInviteeMember, memberStatus, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
||||||
:. (userId, ldn, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
|
:. (userId, ldn, Nothing :: (Maybe Int64), profileId, cReqXContactId_, currentTs, currentTs)
|
||||||
:. (minV, maxV)
|
:. (minV, maxV)
|
||||||
)
|
)
|
||||||
|
|
||||||
setMemberRoleStatus :: DB.Connection -> GroupMember -> GroupMemberRole -> GroupMemberStatus -> IO GroupMember
|
|
||||||
setMemberRoleStatus db gm@GroupMember {groupMemberId} newRole newStatus = do
|
|
||||||
currentTs <- getCurrentTime
|
|
||||||
DB.execute
|
|
||||||
db
|
|
||||||
[sql|
|
|
||||||
UPDATE group_members
|
|
||||||
SET member_role = ?, member_status = ?, updated_at = ?
|
|
||||||
WHERE group_member_id = ?
|
|
||||||
|]
|
|
||||||
(newRole, newStatus, currentTs, groupMemberId)
|
|
||||||
pure gm {memberRole = newRole, memberStatus = newStatus, updatedAt = currentTs}
|
|
||||||
|
|
||||||
createJoiningMemberConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> GroupMemberId -> SubscriptionMode -> IO ()
|
createJoiningMemberConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> GroupMemberId -> SubscriptionMode -> IO ()
|
||||||
createJoiningMemberConnection
|
createJoiningMemberConnection
|
||||||
db
|
db
|
||||||
|
|
|
@ -1050,7 +1050,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
|
||||||
[sql|
|
[sql|
|
||||||
SELECT
|
SELECT
|
||||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
|
||||||
cr.contact_id, cr.group_member_id, cr.business_group_id, cr.user_contact_link_id,
|
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
|
||||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id,
|
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id,
|
||||||
cr.pq_support, cr.accepted, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
cr.pq_support, cr.accepted, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
|
||||||
cr.created_at, cr.updated_at,
|
cr.created_at, cr.updated_at,
|
||||||
|
|
|
@ -15,12 +15,13 @@ ALTER TABLE contacts ADD COLUMN welcome_shared_msg_id BLOB;
|
||||||
ALTER TABLE contacts ADD COLUMN contact_request_id INTEGER REFERENCES contact_requests ON DELETE SET NULL;
|
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);
|
CREATE INDEX idx_contacts_contact_request_id ON contacts(contact_request_id);
|
||||||
|
|
||||||
ALTER TABLE contact_requests ADD COLUMN group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE;
|
|
||||||
ALTER TABLE contact_requests ADD COLUMN business_group_id INTEGER REFERENCES groups(group_id) ON DELETE CASCADE;
|
ALTER TABLE contact_requests ADD COLUMN business_group_id INTEGER REFERENCES groups(group_id) ON DELETE CASCADE;
|
||||||
ALTER TABLE contact_requests ADD COLUMN accepted INTEGER NOT NULL DEFAULT 0;
|
ALTER TABLE contact_requests ADD COLUMN accepted INTEGER NOT NULL DEFAULT 0;
|
||||||
ALTER TABLE contact_requests ADD COLUMN welcome_shared_msg_id BLOB;
|
ALTER TABLE contact_requests ADD COLUMN welcome_shared_msg_id BLOB;
|
||||||
ALTER TABLE contact_requests ADD COLUMN request_shared_msg_id BLOB;
|
ALTER TABLE contact_requests ADD COLUMN request_shared_msg_id BLOB;
|
||||||
|
|
||||||
|
ALTER TABLE group_members ADD COLUMN member_xcontact_id BLOB;
|
||||||
|
|
||||||
ALTER TABLE user_contact_links ADD COLUMN short_link_data_set INTEGER NOT NULL DEFAULT 0;
|
ALTER TABLE user_contact_links ADD COLUMN short_link_data_set INTEGER NOT NULL DEFAULT 0;
|
||||||
ALTER TABLE user_contact_links ADD COLUMN address_welcome_message TEXT;
|
ALTER TABLE user_contact_links ADD COLUMN address_welcome_message TEXT;
|
||||||
|
|
||||||
|
|
|
@ -181,6 +181,7 @@ CREATE TABLE group_members(
|
||||||
support_chat_items_member_attention INTEGER NOT NULL DEFAULT 0,
|
support_chat_items_member_attention INTEGER NOT NULL DEFAULT 0,
|
||||||
support_chat_items_mentions INTEGER NOT NULL DEFAULT 0,
|
support_chat_items_mentions INTEGER NOT NULL DEFAULT 0,
|
||||||
support_chat_last_msg_from_member_ts TEXT,
|
support_chat_last_msg_from_member_ts TEXT,
|
||||||
|
member_xcontact_id BLOB,
|
||||||
FOREIGN KEY(user_id, local_display_name)
|
FOREIGN KEY(user_id, local_display_name)
|
||||||
REFERENCES display_names(user_id, local_display_name)
|
REFERENCES display_names(user_id, local_display_name)
|
||||||
ON DELETE CASCADE
|
ON DELETE CASCADE
|
||||||
|
@ -355,7 +356,6 @@ CREATE TABLE contact_requests(
|
||||||
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
|
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
|
||||||
pq_support INTEGER NOT NULL DEFAULT 0,
|
pq_support INTEGER NOT NULL DEFAULT 0,
|
||||||
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
|
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
|
||||||
group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
|
|
||||||
business_group_id INTEGER REFERENCES groups(group_id) ON DELETE CASCADE,
|
business_group_id INTEGER REFERENCES groups(group_id) ON DELETE CASCADE,
|
||||||
accepted INTEGER NOT NULL DEFAULT 0,
|
accepted INTEGER NOT NULL DEFAULT 0,
|
||||||
welcome_shared_msg_id BLOB,
|
welcome_shared_msg_id BLOB,
|
||||||
|
|
|
@ -472,13 +472,13 @@ getProfileById db userId profileId =
|
||||||
toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, Maybe Preferences) -> LocalProfile
|
toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, Maybe Preferences) -> LocalProfile
|
||||||
toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||||
|
|
||||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupMemberId, Maybe GroupId, Int64) :. (AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact) :. (Maybe XContactId, PQSupport, BoolInt, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
|
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Int64) :. (AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact) :. (Maybe XContactId, PQSupport, BoolInt, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
|
||||||
|
|
||||||
toContactRequest :: ContactRequestRow -> UserContactRequest
|
toContactRequest :: ContactRequestRow -> UserContactRequest
|
||||||
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, contactId_, groupMemberId_, businessGroupId_, userContactLinkId) :. (agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, pqSupport, BI accepted, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
|
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId) :. (agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, pqSupport, BI accepted, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
|
||||||
let profile = Profile {displayName, fullName, image, contactLink, preferences}
|
let profile = Profile {displayName, fullName, image, contactLink, preferences}
|
||||||
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||||
in UserContactRequest {contactRequestId, agentInvitationId, contactId_, groupMemberId_, businessGroupId_, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, accepted, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt}
|
in UserContactRequest {contactRequestId, agentInvitationId, contactId_, businessGroupId_, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, accepted, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt}
|
||||||
|
|
||||||
userQuery :: Query
|
userQuery :: Query
|
||||||
userQuery =
|
userQuery =
|
||||||
|
|
|
@ -345,7 +345,6 @@ data UserContactRequest = UserContactRequest
|
||||||
{ contactRequestId :: Int64,
|
{ contactRequestId :: Int64,
|
||||||
agentInvitationId :: AgentInvId,
|
agentInvitationId :: AgentInvId,
|
||||||
contactId_ :: Maybe ContactId,
|
contactId_ :: Maybe ContactId,
|
||||||
groupMemberId_ :: Maybe GroupMemberId,
|
|
||||||
businessGroupId_ :: Maybe GroupId,
|
businessGroupId_ :: Maybe GroupId,
|
||||||
userContactLinkId :: Int64,
|
userContactLinkId :: Int64,
|
||||||
agentContactConnId :: AgentConnId, -- connection id of user contact
|
agentContactConnId :: AgentConnId, -- connection id of user contact
|
||||||
|
@ -402,7 +401,6 @@ instance ToJSON ConnReqUriHash where
|
||||||
data RequestEntity
|
data RequestEntity
|
||||||
= REContact Contact
|
= REContact Contact
|
||||||
| REBusinessChat GroupInfo GroupMember
|
| REBusinessChat GroupInfo GroupMember
|
||||||
| REGroupMember GroupInfo GroupMember
|
|
||||||
|
|
||||||
type RepeatRequest = Bool
|
type RepeatRequest = Bool
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue