agent: fix rare race conditions in async API (#1792)

* agent: fix rare race conditions in async API

* split async accept too

* fix, reduce diff

* composition

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny
2026-07-03 15:24:43 +01:00
committed by GitHub
co-authored by Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
parent 836254a4c6
commit a45d764eaa
2 changed files with 49 additions and 47 deletions
+27 -36
View File
@@ -49,6 +49,7 @@ module Simplex.Messaging.Agent
deleteUser,
setUserService,
connRequestPQSupport,
prepareConnectionToCreate,
createConnectionAsync,
setConnShortLinkAsync,
getConnShortLinkAsync,
@@ -358,9 +359,14 @@ setUserService :: AgentClient -> UserId -> Bool -> AE ()
setUserService c = withAgentEnv c .: setUserService' c
{-# INLINE setUserService #-}
-- | Create SMP agent connection (NEW command) asynchronously, synchronous response is new connection id
createConnectionAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AE ConnId
createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAsync c userId aCorrId enableNtfs
-- | Create SMP agent connection without queue (to be used with createConnectionAsync).
prepareConnectionToCreate :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AE ConnId
prepareConnectionToCreate c userId enableNtfs = withAgentEnv c .: newConnNoQueues c userId enableNtfs
{-# INLINE prepareConnectionToCreate #-}
-- | Enqueue NEW command for a prepared connection.
createConnectionAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AE ()
createConnectionAsync c aCorrId connId enableNtfs = withAgentEnv c .:. newConnAsync c aCorrId connId enableNtfs
{-# INLINE createConnectionAsync #-}
-- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
@@ -373,10 +379,9 @@ getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Con
getConnShortLinkAsync c = withAgentEnv c .:: getConnShortLinkAsync' c
{-# INLINE getConnShortLinkAsync #-}
-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id.
-- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync.
joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs
-- | Enqueue JOIN command for a prepared connection.
joinConnectionAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ()
joinConnectionAsync c aCorrId updateConn connId enableNtfs = withAgentEnv c .:: joinConnAsync c aCorrId updateConn connId enableNtfs
{-# INLINE joinConnectionAsync #-}
-- | Allow connection to continue after CONF notification (LET command), no synchronous response
@@ -384,9 +389,9 @@ allowConnectionAsync :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> Co
allowConnectionAsync c = withAgentEnv c .:: allowConnectionAsync' c
{-# INLINE allowConnectionAsync #-}
-- | Accept contact after REQ notification (ACPT command) asynchronously, synchronous response is new connection id
acceptContactAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId
acceptContactAsync c userId aCorrId enableNtfs = withAgentEnv c .:: acceptContactAsync' c userId aCorrId enableNtfs
-- | Accept contact after REQ notification (ACPT command) asynchronously, for a prepared connection.
acceptContactAsync :: AgentClient -> ACorrId -> ConnId -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ()
acceptContactAsync c aCorrId connId enableNtfs = withAgentEnv c .:: acceptContactAsync' c aCorrId connId enableNtfs
{-# INLINE acceptContactAsync #-}
-- | Acknowledge message (ACK command) asynchronously, no synchronous response
@@ -846,11 +851,10 @@ setUserService' c userId enable = do
unless ok $ throwE $ CMD PROHIBITED "setUserService"
when (changed && not enable) $ withStore' c (`deleteClientServices` userId)
newConnAsync :: ConnectionModeI c => AgentClient -> UserId -> ACorrId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM ConnId
newConnAsync c userId corrId enableNtfs cMode pqInitKeys subMode = do
connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys)
newConnAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> Bool -> SConnectionMode c -> CR.InitialKeys -> SubscriptionMode -> AM ()
newConnAsync c corrId connId enableNtfs cMode pqInitKeys subMode =
enqueueCommand c corrId connId Nothing $ AClientCommand $ NEW enableNtfs (ACM cMode) pqInitKeys subMode
pure connId
{-# INLINE newConnAsync #-}
newConnNoQueues :: AgentClient -> UserId -> Bool -> SConnectionMode c -> PQSupport -> AM ConnId
newConnNoQueues c userId enableNtfs cMode pqSupport = do
@@ -861,34 +865,21 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
-- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection,
-- and join should retry, the same as 1-time invitation joins.
joinConnAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI"
withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
joinConnAsync :: AgentClient -> ACorrId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ()
joinConnAsync c corrId updateConn connId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do
when updateConn $ throwE $ CMD PROHIBITED "joinConnAsync: updateConn not allowed for invitation URI"
withInvLock c (strEncode cReqUri) "joinConnAsync" $
lift (compatibleInvitationUri cReqUri) >>= \case
Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
g <- asks random
let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
connId <- withStore c $ \db -> createNewConn db g cData SCMInvitation
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
pure connId
Nothing -> throwE $ AGENT A_VERSION
joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do
joinConnAsync c corrId updateConn connId enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode =
lift (compatibleContactUri cReqUri) >>= \case
Just (_, Compatible connAgentVersion) -> do
let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing
connId <- case connId_ of
Just cId -> do
-- update connection record created by getConnShortLinkAsync
withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs
pure cId
Nothing -> do
g <- asks random
let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
withStore c $ \db -> createNewConn db g cData SCMInvitation
when updateConn $ withStore' c $ \db -> updateNewConnJoin db connId connAgentVersion pqSupport enableNtfs
enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo
pure connId
Nothing -> throwE $ AGENT A_VERSION
allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
@@ -904,11 +895,11 @@ allowConnectionAsync' c corrId connId confId ownConnInfo =
-- and also it can't be triggered by user concurrently several times in a row. It could be improved similarly to
-- `acceptContact` by creating a new map for invitation locks and taking lock here, and removing `unacceptInvitation`
-- while marking invitation as accepted inside "lock level transaction" after successful `joinConnAsync`.
acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId
acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do
acceptContactAsync' :: AgentClient -> ACorrId -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ()
acceptContactAsync' c corrId connId enableNtfs invId ownConnInfo pqSupport subMode = do
Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId
withStore' c $ \db -> acceptInvitation db invId ownConnInfo
joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
joinConnAsync c corrId False connId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do
withStore' c (`unacceptInvitation` invId)
throwE err