From c31668ce286380ed6cf6829f1fa0b246cd52d828 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 19 Jun 2023 14:51:14 +0400 Subject: [PATCH] return updated ConnectionStats from switchConnectionAsync (#777) --- src/Simplex/Messaging/Agent.hs | 10 +++--- tests/AgentTests/FunctionalAPITests.hs | 48 ++++++++++++++++---------- 2 files changed, 36 insertions(+), 22 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 315c4260b..b729c7bd9 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -205,7 +205,7 @@ ackMessageAsync :: forall m. AgentErrorMonad m => AgentClient -> ACorrId -> Conn ackMessageAsync c = withAgentEnv c .:. ackMessageAsync' c -- | Switch connection to the new receive queue -switchConnectionAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> ConnId -> m () +switchConnectionAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> ConnId -> m ConnectionStats switchConnectionAsync c = withAgentEnv c .: switchConnectionAsync' c -- | Delete SMP agent connection (DEL command) asynchronously, no synchronous response @@ -529,15 +529,17 @@ deleteConnectionsAsync_ onSuccess c connIds = case connIds of deleteConnQueues c True rqs >> onSuccess -- | Add connection to the new receive queue -switchConnectionAsync' :: AgentMonad m => AgentClient -> ACorrId -> ConnId -> m () +switchConnectionAsync' :: AgentMonad m => AgentClient -> ACorrId -> ConnId -> m ConnectionStats switchConnectionAsync' c corrId connId = withConnLock c connId "switchConnectionAsync" $ withStore c (`getConn` connId) >>= \case - SomeConn _ (DuplexConnection _ rqs@(rq :| _rqs) _) + SomeConn _ (DuplexConnection cData rqs@(rq :| _rqs) sqs) | isJust (switchingRQ rqs) -> throwError $ CMD PROHIBITED | otherwise -> do - void $ withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted + rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted enqueueCommand c corrId connId Nothing $ AClientCommand $ APC SAEConn SWCH + let rqs' = updatedQs rq1 rqs + pure . connectionStats $ DuplexConnection cData rqs' sqs _ -> throwError $ CMD PROHIBITED newConn :: AgentMonad m => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe CRClientData -> m (ConnId, ConnectionRequestUri c) diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 5f07288e6..e33c52a09 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -988,7 +988,8 @@ testSwitchConnection servers = do testFullSwitch :: AgentClient -> ByteString -> AgentClient -> ByteString -> Int64 -> ExceptT AgentErrorType IO () testFullSwitch a bId b aId msgId = do - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] switchComplete a bId b aId exchangeGreetingsMsgId msgId a bId b aId @@ -1039,7 +1040,8 @@ testSwitchAsync servers = do let withA' = sessionSubscribe withA [bId] withB' = sessionSubscribe withB [aId] withA' $ \a -> do - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] withB' $ \b -> do phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing] @@ -1082,7 +1084,8 @@ testSwitchDelete servers = do (aId, bId) <- makeConnection a b exchangeGreetingsMsgId 4 a bId b aId disconnectAgentClient b - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] deleteConnectionAsync a bId get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId; _ -> False @@ -1099,20 +1102,22 @@ testAbortSwitchStarted servers = do let withA' = sessionSubscribe withA [bId] withB' = sessionSubscribe withB [aId] withA' $ \a -> do - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] -- repeat switch is prohibited Left Agent.CMD {cmdErr = PROHIBITED} <- runExceptT $ switchConnectionAsync a "" bId -- abort current switch - stats <- abortConnectionSwitch a bId - liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Nothing] + stats' <- abortConnectionSwitch a bId + liftIO $ rcvSwchStatuses' stats' `shouldMatchList` [Nothing] withB' $ \b -> do phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing] phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing] withA' $ \a -> do get a ##> ("", bId, ERR (AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}})) -- repeat switch - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] withA $ \a -> withB $ \b -> runRight_ $ do subscribeConnection a bId @@ -1147,13 +1152,15 @@ testAbortSwitchStartedReinitiate servers = do let withA' = sessionSubscribe withA [bId] withB' = sessionSubscribe withB [aId] withA' $ \a -> do - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] -- abort current switch - stats <- abortConnectionSwitch a bId - liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Nothing] + stats' <- abortConnectionSwitch a bId + liftIO $ rcvSwchStatuses' stats' `shouldMatchList` [Nothing] -- repeat switch - switchConnectionAsync a "" bId + stats'' <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats'' `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] withB' $ \b -> do phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing] @@ -1212,7 +1219,8 @@ testCannotAbortSwitchSecured servers = do let withA' = sessionSubscribe withA [bId] withB' = sessionSubscribe withB [aId] withA' $ \a -> do - switchConnectionAsync a "" bId + stats <- switchConnectionAsync a "" bId + liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing] withB' $ \b -> do phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing] @@ -1250,9 +1258,11 @@ testSwitch2Connections servers = do pure (aId1, bId1, aId2, bId2) withA $ \a -> runRight_ $ do void $ subscribeConnections a [bId1, bId2] - switchConnectionAsync a "" bId1 + stats1 <- switchConnectionAsync a "" bId1 + liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing] - switchConnectionAsync a "" bId2 + stats2 <- switchConnectionAsync a "" bId2 + liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing] withA $ \a -> withB $ \b -> runRight_ $ do void $ subscribeConnections a [bId1, bId2] @@ -1306,13 +1316,15 @@ testSwitch2ConnectionsAbort1 servers = do let withA' = sessionSubscribe withA [bId1, bId2] withB' = sessionSubscribe withB [aId1, aId2] withA' $ \a -> do - switchConnectionAsync a "" bId1 + stats1 <- switchConnectionAsync a "" bId1 + liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing] - switchConnectionAsync a "" bId2 + stats2 <- switchConnectionAsync a "" bId2 + liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted] phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing] -- abort switch of second connection - stats <- abortConnectionSwitch a bId2 - liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Nothing] + stats2' <- abortConnectionSwitch a bId2 + liftIO $ rcvSwchStatuses' stats2' `shouldMatchList` [Nothing] withB' $ \b -> do liftIO . getInAnyOrder b $ [ switchPhaseSndP aId1 SPStarted [Just SSSendingQKEY, Nothing],