From ee8e4067b02c520a41b82ab972e262b24f58cd69 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 5 May 2024 12:12:19 +0100 Subject: [PATCH] agent: prepare connection record before joining to prevent race conditions (#1128) * agent: prepare connection record before joining to prevent race conditions * prepare connection for contact address as well * clean up --- src/Simplex/Messaging/Agent.hs | 100 +++++++++++++++++-------- src/Simplex/Messaging/Client.hs | 1 - tests/AgentTests/FunctionalAPITests.hs | 12 ++- 3 files changed, 75 insertions(+), 38 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 38112b030..f93d03e35 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -55,6 +55,7 @@ module Simplex.Messaging.Agent deleteConnectionAsync, deleteConnectionsAsync, createConnection, + prepareConnectionToJoin, joinConnection, allowConnection, acceptContact, @@ -149,7 +150,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..)) import Simplex.FileTransfer.Util (removePath) import Simplex.Messaging.Agent.Client import Simplex.Messaging.Agent.Env.SQLite -import Simplex.Messaging.Agent.Lock (withLock', withLock) +import Simplex.Messaging.Agent.Lock (withLock, withLock') import Simplex.Messaging.Agent.NtfSubSupervisor import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.RetryInterval @@ -160,7 +161,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Client (ProtocolClient (..), ServerTransmission) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs) -import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOn, pattern PQEncOff, pattern PQSupportOn, pattern PQSupportOff) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -198,7 +199,7 @@ getSMPAgentClient_ clientId cfg initServers store backgroundMode = liftIO $ newSMPAgentEnv cfg store >>= runReaderT runAgent where runAgent = do - c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers =<< ask + c@AgentClient {acThread} <- atomically . newAgentClient clientId initServers =<< ask t <- runAgentThreads c `forkFinally` const (liftIO $ disconnectAgentClient c) atomically . writeTVar acThread . Just =<< mkWeakThreadId t pure c @@ -239,7 +240,7 @@ createUser c = withAgentEnv c .: createUser' c {-# INLINE createUser #-} -- | Delete user record optionally deleting all user's connections on SMP servers -deleteUser :: AgentClient -> UserId -> Bool -> AE () +deleteUser :: AgentClient -> UserId -> Bool -> AE () deleteUser c = withAgentEnv c .: deleteUser' c {-# INLINE deleteUser #-} @@ -288,9 +289,18 @@ createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe createConnection c userId enableNtfs = withAgentEnv c .:: newConn c userId "" enableNtfs {-# INLINE createConnection #-} --- | Join SMP agent connection (JOIN command) -joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId -joinConnection c userId enableNtfs = withAgentEnv c .:: joinConn c userId "" enableNtfs +-- | Create SMP agent connection without queue (to be joined with joinConnection passing connection ID). +-- This method is required to prevent race condition when confirmation from peer is received before +-- the caller of joinConnection saves connection ID to the database. +-- Instead of it we could send confirmation asynchronously, but then it would be harder to report +-- "link deleted" (SMP AUTH) interactively, so this approach is simpler overall. +prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE ConnId +prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs + +-- | Join SMP agent connection (JOIN command). +joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId +joinConnection c userId Nothing enableNtfs = withAgentEnv c .:: joinConn c userId "" False enableNtfs +joinConnection c userId (Just connId) enableNtfs = withAgentEnv c .:: joinConn c userId connId True enableNtfs {-# INLINE joinConnection #-} -- | Allow connection to continue after CONF notification (LET command) @@ -575,7 +585,7 @@ processCommand :: AgentClient -> (EntityId, APartyCmd 'Client) -> AM (EntityId, processCommand c (connId, APC e cmd) = second (APC e) <$> case cmd of NEW enableNtfs (ACM cMode) pqIK subMode -> second (INV . ACR cMode) <$> newConn c userId connId enableNtfs cMode Nothing pqIK subMode - JOIN enableNtfs (ACR _ cReq) pqEnc subMode connInfo -> (,OK) <$> joinConn c userId connId enableNtfs cReq connInfo pqEnc subMode + JOIN enableNtfs (ACR _ cReq) pqEnc subMode connInfo -> (,OK) <$> joinConn c userId connId False enableNtfs cReq connInfo pqEnc subMode LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK) ACPT invId pqEnc ownCInfo -> (,OK) <$> acceptContact' c connId True invId ownCInfo pqEnc SMSubscribe RJCT invId -> rejectContact' c connId invId $> (connId, OK) @@ -708,11 +718,14 @@ switchConnectionAsync' c corrId connId = newConn :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, ConnectionRequestUri c) newConn c userId connId enableNtfs cMode clientData pqInitKeys subMode = - getSMPServer c userId >>= newConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode + getSMPServer c userId >>= newConnSrv c userId connId False enableNtfs cMode clientData pqInitKeys subMode -newConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c) -newConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv = do - connId' <- newConnNoQueues c userId connId enableNtfs cMode (CR.connPQEncryption pqInitKeys) +newConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c) +newConnSrv c userId connId hasNewConn enableNtfs cMode clientData pqInitKeys subMode srv = do + connId' <- + if hasNewConn + then pure connId + else newConnNoQueues c userId connId enableNtfs cMode (CR.connPQEncryption pqInitKeys) newRcvConnSrv c userId connId' enableNtfs cMode clientData pqInitKeys subMode srv newRcvConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, ConnectionRequestUri c) @@ -738,18 +751,36 @@ newRcvConnSrv c userId connId enableNtfs cMode clientData pqInitKeys subMode srv withStore' c $ \db -> createRatchetX3dhKeys db connId pk1 pk2 pKem pure (connId, CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange) -joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId -joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do +newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> PQSupport -> AM ConnId +newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of + CRInvitationUri {} -> + lift (compatibleInvitationUri cReq) >>= \case + Just (_, (Compatible (CR.E2ERatchetParams v _ _ _)), aVersion) -> create aVersion (Just v) + Nothing -> throwError $ AGENT A_VERSION + CRContactUri {} -> + lift (compatibleContactUri cReq) >>= \case + Just (_, aVersion) -> create aVersion Nothing + Nothing -> throwError $ AGENT A_VERSION + where + create :: Compatible VersionSMPA -> Maybe CR.VersionE2E -> AM ConnId + create (Compatible connAgentVersion) e2eV_ = do + g <- asks random + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion e2eV_ + cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} + withStore c $ \db -> createNewConn db g cData SCMInvitation + +joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId +joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do srv <- case cReq of CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> getNextServer c userId [qServer q] _ -> getSMPServer c userId - joinConnSrv c userId connId enableNtfs cReq cInfo pqSupport subMode srv + joinConnSrv c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode srv -startJoinInvitation :: UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (Compatible VersionSMPA, ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448) +startJoinInvitation :: UserId -> ConnId -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, NewSndQueue, CR.Ratchet 'C.X448, CR.SndE2ERatchetParams 'C.X448) startJoinInvitation userId connId enableNtfs cReqUri pqSup = lift (compatibleInvitationUri cReqUri) >>= \case - Just (qInfo, (Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_)), aVersion@(Compatible connAgentVersion)) -> do + Just (qInfo, (Compatible e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_)), Compatible connAgentVersion) -> do g <- asks random let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v) (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport) @@ -760,7 +791,7 @@ startJoinInvitation userId connId enableNtfs cReqUri pqSup = rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams q <- lift $ newSndQueue userId "" qInfo let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} - pure (aVersion, cData, q, rc, e2eSndParams) + pure (cData, q, rc, e2eSndParams) Nothing -> throwError $ AGENT A_VERSION connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport)) @@ -786,40 +817,43 @@ compatibleContactUri (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = AgentConfig {smpClientVRange, smpAgentVRange} <- asks config pure $ (,) - <$> (qUri `compatibleVersion` smpClientVRange) + <$> (qUri `compatibleVersion` smpClientVRange) <*> (crAgentVRange `compatibleVersion` smpAgentVRange) versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} -joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId -joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv = +joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId +joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do - (aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSup + (cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSup g <- asks random (connId', sq) <- withStore c $ \db -> runExceptT $ do - r@(connId', _) <- ExceptT $ createSndConn db g cData q + r@(connId', _) <- + if hasNewConn + then (connId,) <$> ExceptT (updateNewConnSnd db connId q) + else ExceptT $ createSndConn db g cData q liftIO $ createRatchet db connId' rc pure r let cData' = (cData :: ConnData) {connId = connId'} - tryError (confirmQueue aVersion c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case + tryError (confirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case Right _ -> pure connId' Left e -> do -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md void $ withStore' c $ \db -> deleteConn db Nothing connId' throwError e -joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = +joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, vrsn) -> do - (connId', cReq) <- newConnSrv c userId connId enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv + (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv sendInvitation c userId qInfo vrsn cReq cInfo pure connId' Nothing -> throwError $ AGENT A_VERSION joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM () joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do - (_aVersion, cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSupport + (cData, q, rc, e2eSndParams) <- startJoinInvitation userId connId enableNtfs inv pqSupport q' <- withStore c $ \db -> runExceptT $ do liftIO $ createRatchet db connId rc ExceptT $ updateNewConnSnd db connId q @@ -861,7 +895,7 @@ acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withCon withStore c (`getConn` contactConnId) >>= \case SomeConn _ (ContactConnection ConnData {userId} _) -> do withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConn c userId connId enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do + joinConn c userId connId False enableNtfs connReq ownConnInfo pqSupport subMode `catchAgentError` \err -> do withStore' c (`unacceptInvitation` invId) throwError err _ -> throwError $ CMD PROHIBITED @@ -1207,7 +1241,7 @@ enqueueMessage c cData sq msgFlags aMessage = {-# INLINE enqueueMessage #-} -- this function is used only for sending messages in batch, it returns the list of successes to enqueue additional deliveries -enqueueMessageB :: forall t. (Traversable t) => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe (ConnData, [SndQueue], AgentMsgId)))) +enqueueMessageB :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType (ConnData, NonEmpty SndQueue, Maybe PQEncryption, MsgFlags, AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe (ConnData, [SndQueue], AgentMsgId)))) enqueueMessageB c reqs = do cfg <- asks config reqMids <- withStoreBatch c $ \db -> fmap (bindRight $ storeSentMsg db cfg) reqs @@ -1239,7 +1273,7 @@ enqueueSavedMessage :: AgentClient -> ConnData -> AgentMsgId -> SndQueue -> AM' enqueueSavedMessage c cData msgId sq = enqueueSavedMessageB c $ Identity (cData, [sq], msgId) {-# INLINE enqueueSavedMessage #-} -enqueueSavedMessageB :: (Foldable t) => AgentClient -> t (ConnData, [SndQueue], AgentMsgId) -> AM' () +enqueueSavedMessageB :: Foldable t => AgentClient -> t (ConnData, [SndQueue], AgentMsgId) -> AM' () enqueueSavedMessageB c reqs = do -- saving to the database is in the start to avoid race conditions when delivery is read from queue before it is saved void $ withStoreBatch' c $ \db -> concatMap (storeDeliveries db) reqs @@ -2565,8 +2599,8 @@ confirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode lift $ submitPendingMsg c cData sq -confirmQueue :: Compatible VersionSMPA -> AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM () -confirmQueue (Compatible agentVersion) c cData@ConnData {connId, pqSupport} sq srv connInfo e2eEncryption_ subMode = do +confirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM () +confirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode sendConfirmation c sq msg withStore' c $ \db -> setSndQueueStatus db sq Confirmed @@ -2578,7 +2612,7 @@ confirmQueue (Compatible agentVersion) c cData@ConnData {connId, pqSupport} sq s void . liftIO $ updateSndIds db connId let pqEnc = CR.pqSupportToEnc pqSupport (encConnInfo, _) <- agentRatchetEncrypt db cData (smpEncode aMessage) e2eEncConnInfoLength (Just pqEnc) currentE2EVersion - pure . smpEncode $ AgentConfirmation {agentVersion, e2eEncryption_, encConnInfo} + pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo} mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage mkAgentConfirmation c cData sq srv connInfo subMode = do diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 8d3c5e54f..38c36f9f2 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -113,7 +113,6 @@ import Simplex.Messaging.Transport.WebSockets (WS) import Simplex.Messaging.Util (bshow, diffToMicroseconds, raceAny_, threadDelay', whenM) import Simplex.Messaging.Version import System.Timeout (timeout) -import UnliftIO (pooledMapConcurrentlyN) -- | 'SMPClient' is a handle used to send commands to a specific SMP server. -- diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 79742efab..d3e4e6924 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -244,7 +244,7 @@ createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQSupportOn) joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE ConnId -joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId enableNtfs cReq connInfo PQSupportOn +joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId Nothing enableNtfs cReq connInfo PQSupportOn sendMessage :: AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> AE AgentMsgId sendMessage c connId msgFlags msgBody = do @@ -503,7 +503,7 @@ runAgentClientTest :: HasCallStack => PQSupport -> AgentClient -> AgentClient -> runAgentClientTest pqSupport alice@AgentClient {} bob baseId = runRight_ $ do (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (IKNoPQ pqSupport) SMSubscribe - aliceId <- A.joinConnection bob 1 True qInfo "bob's connInfo" pqSupport SMSubscribe + aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" pqSupport SMSubscribe ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport allowConnection alice bobId confId "alice's connInfo" @@ -630,7 +630,9 @@ runAgentClientContactTest :: HasCallStack => PQSupport -> AgentClient -> AgentCl runAgentClientContactTest pqSupport alice bob baseId = runRight_ $ do (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing (IKNoPQ pqSupport) SMSubscribe - aliceId <- A.joinConnection bob 1 True qInfo "bob's connInfo" pqSupport SMSubscribe + aliceId <- A.prepareConnectionToJoin bob 1 True qInfo pqSupport + aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe + liftIO $ aliceId' `shouldBe` aliceId ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport bobId <- acceptContact alice True invId "alice's connInfo" PQSupportOn SMSubscribe @@ -1399,7 +1401,9 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn makeConnectionForUsers_ :: PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqSupport) SMSubscribe - aliceId <- A.joinConnection bob bobUserId True qInfo "bob's connInfo" pqSupport SMSubscribe + aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport + aliceId' <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe + liftIO $ aliceId' `shouldBe` aliceId ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport allowConnection alice bobId confId "alice's connInfo"