mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-22 17:31:55 +00:00
core: use concurrency-safe agent async api (#7035)
* core: use concurrency-safe agent async api * simplexmq * simplexmq * combine transactions (build fails, names need to be merged first) * fix build * update simplexmq * remove uncurry * remove createAgentConnectionAsync * remove prepareJoinMemberContact * mapM * fix tests --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
EvgenyandEvgeny @ SimpleX Chat authored and GitHub committed
1 parent
6bb1da9e8d
commit
712effe34f
5 files changed
+73
-44
No files matched your search
@@ -929,13 +929,15 @@ acceptContactRequestAsync
|
||||
profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True
|
||||
cxt <- chatStoreCxt
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
(cmdId, acId) <- agentAcceptContactAsync user True cReqInvId (XInfo profileToSend) subMode cReqPQSup chatV
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId cReqPQSup
|
||||
currentTs <- liftIO getCurrentTime
|
||||
withStore $ \db -> do
|
||||
ct' <- withStore $ \db -> do
|
||||
forM_ xContactId $ \xcId -> liftIO $ setContactAcceptedXContactId db ct xcId
|
||||
Connection {connId} <- liftIO $ createAcceptedContactConn db user (Just uclId) contactId acId chatV cReqChatVRange cReqPQSup incognitoProfile subMode currentTs
|
||||
liftIO $ setCommandConnId db user cmdId connId
|
||||
getContact db cxt user contactId
|
||||
agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend) cReqPQSup chatV subMode
|
||||
pure ct'
|
||||
|
||||
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember
|
||||
acceptGroupJoinRequestAsync
|
||||
@@ -983,10 +985,12 @@ acceptGroupJoinRequestAsync
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
|
||||
withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
m <- withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
getGroupMemberById db cxt user groupMemberId
|
||||
agentAcceptContactAsync cmdId acId True cReqInvId msg PQSupportOff chatV subMode
|
||||
pure m
|
||||
|
||||
acceptGroupJoinSendRejectAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> GroupRejectionReason -> CM GroupMember
|
||||
acceptGroupJoinSendRejectAsync
|
||||
@@ -1013,10 +1017,12 @@ acceptGroupJoinSendRejectAsync
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user False cReqInvId msg subMode PQSupportOff chatV
|
||||
withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
||||
(cmdId, acId) <- prepareAgentAccept user False cReqInvId PQSupportOff
|
||||
m <- withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
getGroupMemberById db cxt user groupMemberId
|
||||
agentAcceptContactAsync cmdId acId False cReqInvId msg PQSupportOff chatV subMode
|
||||
pure m
|
||||
|
||||
acceptBusinessJoinRequestAsync :: User -> Int64 -> GroupInfo -> GroupMember -> UserContactRequest -> CM (GroupInfo, GroupMember)
|
||||
acceptBusinessJoinRequestAsync
|
||||
@@ -1045,10 +1051,11 @@ acceptBusinessJoinRequestAsync
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
withStore' $ \db -> do
|
||||
forM_ xContactId $ \xcId -> setBusinessChatAcceptedXContactId db gInfo xcId
|
||||
createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
||||
createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
agentAcceptContactAsync cmdId acId True cReqInvId msg PQSupportOff chatV subMode
|
||||
let cd = CDGroupSnd gInfo Nothing
|
||||
-- TODO [short links] move to profileContactRequest?
|
||||
createInternalChatItem user cd (CISndGroupE2EEInfo $ e2eInfoGroup gInfo) Nothing
|
||||
@@ -1071,12 +1078,14 @@ acceptRelayJoinRequestAsync
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
cxt <- chatStoreCxt
|
||||
let chatV = vr cxt `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user True cReqInvId msg subMode PQSupportOff chatV
|
||||
withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId connIds chatV cReqChatVRange groupMemberId subMode
|
||||
(cmdId, acId) <- prepareAgentAccept user True cReqInvId PQSupportOff
|
||||
r <- withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user uclId (cmdId, acId) chatV cReqChatVRange groupMemberId subMode
|
||||
gInfo' <- liftIO $ updateRelayOwnStatusFromTo db gInfo RSInvited RSAccepted
|
||||
ownerMember' <- getGroupMemberById db cxt user groupMemberId
|
||||
pure (gInfo', ownerMember')
|
||||
agentAcceptContactAsync cmdId acId True cReqInvId msg PQSupportOff chatV subMode
|
||||
pure r
|
||||
|
||||
rejectRelayInvitationAsync
|
||||
:: User
|
||||
@@ -1096,9 +1105,10 @@ rejectRelayInvitationAsync user uclId cxt groupRelayInv invId reqChatVRange init
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
chatVR <- chatVersionRange
|
||||
let chatV = chatVR `peerConnChatVersion` reqChatVRange
|
||||
connIds <- agentAcceptContactAsync user False invId msg subMode PQSupportOff chatV
|
||||
(cmdId, acId) <- prepareAgentAccept user False invId PQSupportOff
|
||||
withStore' $ \db ->
|
||||
createJoiningMemberConnection db user uclId connIds chatV reqChatVRange groupMemberId subMode
|
||||
createJoiningMemberConnection db user uclId (cmdId, acId) chatV reqChatVRange groupMemberId subMode
|
||||
agentAcceptContactAsync cmdId acId False invId msg PQSupportOff chatV subMode
|
||||
|
||||
businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
|
||||
businessGroupProfile Profile {displayName, fullName, shortDescr, image} groupPreferences =
|
||||
@@ -2752,18 +2762,24 @@ msgContentHasLink mc ft_ = case msgContentTag mc of
|
||||
MCLink_ -> True
|
||||
_ -> maybe False hasLinks ft_
|
||||
|
||||
createAgentConnectionAsync :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> CM (CommandId, ConnId)
|
||||
createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do
|
||||
prepareAgentCreation :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> CM (CommandId, ConnId)
|
||||
prepareAgentCreation user cmdFunction enableNtfs cMode = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction
|
||||
connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode
|
||||
connId <- withAgent $ \a -> prepareConnectionToCreate a (aUserId user) enableNtfs cMode PQSupportOff
|
||||
pure (cmdId, connId)
|
||||
|
||||
joinAgentConnectionAsync :: User -> Maybe Connection -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId)
|
||||
joinAgentConnectionAsync user conn_ enableNtfs cReqUri cInfo subMode = do
|
||||
prepareAgentJoin :: User -> Maybe Connection -> Bool -> ConnectionRequestUri c -> CM (CommandId, ConnId)
|
||||
prepareAgentJoin user conn_ enableNtfs cReqUri = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user (dbConnId <$> conn_) CFJoinConn
|
||||
connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) (aConnId <$> conn_) enableNtfs cReqUri cInfo PQSupportOff subMode
|
||||
connId <- case conn_ of
|
||||
Just conn -> pure $ aConnId conn
|
||||
Nothing -> withAgent $ \a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff
|
||||
pure (cmdId, connId)
|
||||
|
||||
joinAgentConnectionAsync :: ConnectionModeI c => CommandId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM ()
|
||||
joinAgentConnectionAsync cmdId updateConn connId enableNtfs cReqUri cInfo subMode =
|
||||
withAgent $ \a -> joinConnectionAsync a (aCorrId cmdId) updateConn connId enableNtfs cReqUri cInfo PQSupportOff subMode
|
||||
|
||||
allowAgentConnectionAsync :: MsgEncodingI e => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> CM ()
|
||||
allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersion} confId msg = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn
|
||||
@@ -2771,13 +2787,17 @@ allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersi
|
||||
withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm
|
||||
withStore' $ \db -> updateConnectionStatus db conn ConnAccepted
|
||||
|
||||
agentAcceptContactAsync :: MsgEncodingI e => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> PQSupport -> VersionChat -> CM (CommandId, ConnId)
|
||||
agentAcceptContactAsync user enableNtfs invId msg subMode pqSup chatV = do
|
||||
prepareAgentAccept :: User -> Bool -> InvitationId -> PQSupport -> CM (CommandId, ConnId)
|
||||
prepareAgentAccept user enableNtfs invId pqSup = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact
|
||||
dm <- encodeConnInfoPQ pqSup chatV msg
|
||||
connId <- withAgent $ \a -> acceptContactAsync a (aUserId user) (aCorrId cmdId) enableNtfs invId dm pqSup subMode
|
||||
connId <- withAgent $ \a -> prepareConnectionToAccept a (aUserId user) enableNtfs invId pqSup
|
||||
pure (cmdId, connId)
|
||||
|
||||
agentAcceptContactAsync :: MsgEncodingI e => CommandId -> ConnId -> Bool -> InvitationId -> ChatMsgEvent e -> PQSupport -> VersionChat -> SubscriptionMode -> CM ()
|
||||
agentAcceptContactAsync cmdId connId enableNtfs invId msg pqSup chatV subMode = do
|
||||
dm <- encodeConnInfoPQ pqSup chatV msg
|
||||
withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) connId enableNtfs invId dm pqSup subMode
|
||||
|
||||
deleteAgentConnectionAsync :: ConnId -> CM ()
|
||||
deleteAgentConnectionAsync acId = deleteAgentConnectionAsync' acId False
|
||||
{-# INLINE deleteAgentConnectionAsync #-}
|
||||
|
||||
Reference in new issue
Block a user