diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index d2a96a5ed..a3bda8629 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1684,15 +1684,18 @@ ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM () ackQueueMessage c rq@RcvQueue {userId, connId, server} srvMsgId = do atomically $ incSMPServerStat c userId server ackAttempts tryAgentError (sendAck c rq srvMsgId) >>= \case - Right _ -> do - atomically $ incSMPServerStat c userId server ackMsgs - whenM (liftIO $ hasGetLock c rq) $ do - brokerTs_ <- (Just <$> withStore c (\db -> getRcvMsgBrokerTs db connId srvMsgId)) `catchAgentError` \_ -> pure Nothing - atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_) - Left (SMP _ SMP.NO_MSG) -> atomically $ incSMPServerStat c userId server ackNoMsgErrs + Right _ -> sendMsgNtf ackMsgs + Left (SMP _ SMP.NO_MSG) -> sendMsgNtf ackNoMsgErrs Left e -> do unless (temporaryOrHostError e) $ atomically $ incSMPServerStat c userId server ackOtherErrs throwE e + where + sendMsgNtf stat = do + atomically $ incSMPServerStat c userId server stat + whenM (liftIO $ hasGetLock c rq) $ do + atomically $ releaseGetLock c rq + brokerTs_ <- eitherToMaybe <$> tryAgentError (withStore c $ \db -> getRcvMsgBrokerTs db connId srvMsgId) + atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_) -- | Suspend SMP agent connection (OFF command) in Reader monad suspendConnection' :: AgentClient -> ConnId -> AM () diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 1c6fa38f8..13d554f3c 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -92,6 +92,7 @@ module Simplex.Messaging.Agent.Client hasActiveSubscription, hasPendingSubscription, hasGetLock, + releaseGetLock, activeClientSession, agentClientStore, agentDRG, @@ -1647,8 +1648,8 @@ disableQueuesNtfs = sendTSessionBatches "NDEL" snd disableQueues_ sendAck :: AgentClient -> RcvQueue -> MsgId -> AM () sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId = - withSMPClient c rq ("ACK:" <> logSecret' msgId) (\smp -> ackSMPMessage smp rcvPrivateKey rcvId msgId) - `agentFinally` atomically (releaseGetLock c rq) + withSMPClient c rq ("ACK:" <> logSecret' msgId) $ \smp -> + ackSMPMessage smp rcvPrivateKey rcvId msgId hasGetLock :: AgentClient -> RcvQueue -> IO Bool hasGetLock c RcvQueue {server, rcvId} =