Merge pull request #898 from simplex-chat/ab/fix-agent-leak

agent: fix leak in AgentOpState counters

src/Simplex/Messaging/Agent/Client.hs

@@ -276,7 +276,7 @@ agentOpSel = \case
 agentOperations :: [AgentClient -> TVar AgentOpState]
 agentOperations = [ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp]
 
-data AgentOpState = AgentOpState {opSuspended :: Bool, opsInProgress :: Int}
+data AgentOpState = AgentOpState {opSuspended :: !Bool, opsInProgress :: !Int}
 
 data AgentState = ASForeground | ASSuspending | ASSuspended
   deriving (Eq, Show)

tests/Test.hs

@@ -1,8 +1,11 @@
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 import AgentTests (agentTests)
 import AgentTests.SchemaDump (schemaDumpTest)
 import CLITests
+import Control.Concurrent (threadDelay)
+import qualified Control.Exception as E
 import Control.Logger.Simple
 import CoreTests.BatchingTests
 import CoreTests.CryptoFileTests
@@ -13,6 +16,8 @@ import CoreTests.RetryIntervalTests
 import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
 import FileDescriptionTests (fileDescriptionTests)
+import GHC.IO.Exception (IOException (..))
+import qualified GHC.IO.Exception as IOException
 import NtfServerTests (ntfServerTests)
 import RemoteControl (remoteControlTests)
 import ServerTests
@@ -36,7 +41,7 @@ main = do
     setEnv "APNS_KEY_FILE" "./tests/fixtures/AuthKey_H82WD9K9AQ.p8"
     hspec
       . before_ (createDirectoryIfMissing False "tests/tmp")
-      . after_ (removeDirectoryRecursive "tests/tmp")
+      . after_ (eventuallyRemove "tests/tmp" 3)
       $ do
         describe "Agent SQLite schema dump" schemaDumpTest
         describe "Core tests" $ do
@@ -59,3 +64,12 @@ main = do
           describe "XFTP agent" xftpAgentTests
         describe "XRCP" remoteControlTests
         describe "Server CLIs" cliTests
+
+eventuallyRemove :: FilePath -> Int -> IO ()
+eventuallyRemove path retries = case retries of
+  0 -> action
+  n -> action `E.catch` \ioe@IOError {ioe_type, ioe_filename} -> case ioe_type of
+    IOException.UnsatisfiedConstraints | ioe_filename == Just path -> threadDelay 1000000 >> eventuallyRemove path (n - 1)
+    _ -> E.throwIO ioe
+  where
+    action = removeDirectoryRecursive path