diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index c42c0fa34..d8df98d1b 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1545,9 +1545,8 @@ processSubResults c tSess@(userId, srv, _) sessId serviceId_ rs = do (Map SMP.RecipientId SMPClientError, ([RcvQueueSub], [RcvQueueSub]), [(RcvQueueSub, Maybe ClientNotice)], Int) partitionResults pendingSubs (rq@RcvQueueSub {rcvId, clientNoticeId}, r) acc@(failed, subscribed@(qs, sQs), notices, ignored) = case r of Left e -> case smpErrorClientNotice e of - Just notice_ -> (failed', subscribed, (rq, notice_) : notices, ignored) + Just notice_ -> (failed', subscribed, notices', ignored) where - -- TODO [certs rcv] not used? notices' = if isJust notice_ || isJust clientNoticeId then (rq, notice_) : notices else notices Nothing | temporaryClientError e -> acc diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 2aa5c0aca..11548c9e9 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -122,6 +122,8 @@ import XFTPClient (testXFTPServer) #if defined(dbPostgres) import Fixtures +import Simplex.Messaging.Agent.Store (RcvQueue, RcvQueueSub (..), ServiceAssoc) +import Simplex.Messaging.Agent.Store.AgentStore (deleteClientService, getSubscriptionService, getUserServerRcvQueueSubs, removeRcvServiceAssocs, setRcvServiceAssocs) #endif #if defined(dbServerPostgres) import qualified Database.PostgreSQL.Simple as PSQL @@ -786,7 +788,7 @@ runAgentClientStressTestOneWay n pqSupport sqSecured viaProxy alice bob baseId = msgId = subtract baseId . fst runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () -runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do +runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob _baseId = runRight_ $ do (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob amId <- newTVarIO 0 bmId <- newTVarIO 0 @@ -803,7 +805,6 @@ runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = r liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice" liftIO $ noMessagesIngoreQCONT bob "nothing else should be delivered to bob" where - msgId = subtract baseId . fst pqEnc = PQEncryption $ supportPQ pqSupport proxySrv = if viaProxy then Just testSMPServer else Nothing message i = "message " <> bshow i @@ -816,11 +817,11 @@ runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = r timeout 100000 (get a) >>= mapM_ (\case ("", _, QCONT) -> drain; r -> expectationFailure $ "unexpected: " <> show r) loop (0, 0, 0, 0) = pure () - loop acc@(!s, !m, !r, !o) = + loop acc@(s, !m, !r, !o) = timeout 3000000 (get a) >>= \case Nothing -> error $ "timeout " <> show acc Just evt -> case evt of - ("", c, A.SENT mId srv) -> do + ("", c, A.SENT _mId srv) -> do liftIO $ c == bId && srv == proxySrv `shouldBe` True unless (s > 0) $ error "unexpected SENT" loop (s - 1, m, r, o) @@ -834,7 +835,7 @@ runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = r ackMessageAsync a "123" bId mId (Just "") unless (m > 0) $ error "unexpected MSG" loop (s, m - 1, r, o) - ("", c, Rcvd' mId rcvdMsgId) -> do + ("", c, Rcvd' mId _rcvdMsgId) -> do liftIO $ (mId >) <$> atomically (swapTVar mIdVar mId) `shouldReturn` True liftIO $ c == bId `shouldBe` True ackMessageAsync a "123" bId mId Nothing