From a860936072172e261480fa6bdd95203976e366b2 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 5 Dec 2023 23:14:33 +0000
Subject: [PATCH] agent: do not account for delivery of stored messages for
 agent suspension (#916)

---
 src/Simplex/Messaging/Agent.hs        | 17 ++++++++++-------
 src/Simplex/Messaging/Agent/Client.hs |  2 +-
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 10cc644ed..e8769b749 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1103,20 +1103,23 @@ resumeMsgDelivery c cData@ConnData {connId} sq@SndQueue {server, sndId} = do
       >>= \a -> atomically (TM.insert qKey a $ smpQueueMsgDeliveries c)
   unlessM msgsQueued $
     withStore' c (\db -> getPendingMsgs db connId sq)
-      >>= queuePendingMsgs c sq
+      >>= queuePendingMsgs' c False sq
   where
     queueDelivering qKey = atomically $ TM.member qKey (smpQueueMsgDeliveries c)
     msgsQueued = atomically $ isJust <$> TM.lookupInsert (server, sndId) True (pendingMsgsQueued c)
 
 queuePendingMsgs :: AgentMonad' m => AgentClient -> SndQueue -> [InternalId] -> m ()
-queuePendingMsgs c sq msgIds = atomically $ do
-  modifyTVar' (msgDeliveryOp c) $ \s -> s {opsInProgress = opsInProgress s + length msgIds}
+queuePendingMsgs c = queuePendingMsgs' c True
+
+queuePendingMsgs' :: AgentMonad' m => AgentClient -> Bool -> SndQueue -> [InternalId] -> m ()
+queuePendingMsgs' c setDeliveryOps sq msgIds = atomically $ do
+  when setDeliveryOps $ modifyTVar' (msgDeliveryOp c) $ \s -> s {opsInProgress = opsInProgress s + length msgIds}
   -- s <- readTVar (msgDeliveryOp c)
   -- unsafeIOToSTM $ putStrLn $ "msgDeliveryOp: " <> show (opsInProgress s)
   (mq, _) <- getPendingMsgQ c sq
-  mapM_ (writeTQueue mq) msgIds
+  mapM_ (writeTQueue mq . (,setDeliveryOps)) msgIds
 
-getPendingMsgQ :: AgentClient -> SndQueue -> STM (TQueue InternalId, TMVar ())
+getPendingMsgQ :: AgentClient -> SndQueue -> STM (TQueue (InternalId, Bool), TMVar ())
 getPendingMsgQ c SndQueue {server, sndId} = do
   let qKey = (server, sndId)
   maybe (newMsgQueue qKey) pure =<< TM.lookup qKey (smpQueueMsgQueues c)
@@ -1134,9 +1137,9 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} cData@ConnData {userId, connId, dupl
     atomically $ endAgentOperation c AOSndNetwork
     atomically $ throwWhenInactive c
     atomically $ throwWhenNoDelivery c sq
-    msgId <- atomically $ readTQueue mq
+    (msgId, deliveryOp) <- atomically $ readTQueue mq
     atomically $ beginAgentOperation c AOSndNetwork
-    atomically $ endAgentOperation c AOMsgDelivery -- this operation begins in queuePendingMsgs
+    when deliveryOp $ atomically $ endAgentOperation c AOMsgDelivery -- this operation begins in queuePendingMsgs
     let mId = unId msgId
     tryAgentError (withStore c $ \db -> getPendingMsgData db connId msgId) >>= \case
       Left e -> notify $ MERR mId e
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 00a7407be..253be2811 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -234,7 +234,7 @@ data AgentClient = AgentClient
     pendingSubs :: TRcvQueues,
     removedSubs :: TMap (UserId, SMPServer, SMP.RecipientId) SMPClientError,
     pendingMsgsQueued :: TMap SndQAddr Bool,
-    smpQueueMsgQueues :: TMap SndQAddr (TQueue InternalId, TMVar ()),
+    smpQueueMsgQueues :: TMap SndQAddr (TQueue (InternalId, Bool), TMVar ()),
     smpQueueMsgDeliveries :: TMap SndQAddr (Async ()),
     connCmdsQueued :: TMap ConnId Bool,
     asyncCmdQueues :: TMap (Maybe SMPServer) (TQueue AsyncCmdId),