server: make main SMP server queues unbounded (#802)

This commit is contained in:
Evgeny Poberezkin
2023-07-14 21:07:45 +01:00
committed by GitHub
parent 3fee468051
commit 1901e96ecc
4 changed files with 14 additions and 14 deletions
+4 -4
View File
@@ -122,7 +122,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
serverThread ::
forall s.
Server ->
(Server -> TBQueue (QueueId, Client)) ->
(Server -> TQueue (QueueId, Client)) ->
(Server -> TMap QueueId Client) ->
(Client -> TMap QueueId s) ->
(s -> IO ()) ->
@@ -134,7 +134,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
where
updateSubscribers :: STM (Maybe (QueueId, Client))
updateSubscribers = do
(qId, clnt) <- readTBQueue $ subQ s
(qId, clnt) <- readTQueue $ subQ s
let clientToBeNotified = \c' ->
if sameClientSession clnt c'
then pure Nothing
@@ -477,7 +477,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Serv
where
newSub :: m (TVar Sub)
newSub = time "SUB newSub" . atomically $ do
writeTBQueue subscribedQ (rId, clnt)
writeTQueue subscribedQ (rId, clnt)
sub <- newTVar =<< newSubscription NoSub
TM.insert rId sub subscriptions
pure sub
@@ -522,7 +522,7 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Serv
subscribeNotifications :: m (Transmission BrokerMsg)
subscribeNotifications = time "NSUB" . atomically $ do
unlessM (TM.member queueId ntfSubscriptions) $ do
writeTBQueue ntfSubscribedQ (queueId, clnt)
writeTQueue ntfSubscribedQ (queueId, clnt)
TM.insert queueId () ntfSubscriptions
pure ok