From b741b6570047cf7ad8d2652c417df87a2646e0c2 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Fri, 12 Apr 2024 22:22:24 +0100
Subject: [PATCH] use online status in network information (#1094)

* use online status in network information

* test

* refactor

* flip condition

* fix
---
 src/Simplex/Messaging/Agent.hs         | 15 ++++----
 src/Simplex/Messaging/Agent/Client.hs  |  3 +-
 tests/AgentTests/FunctionalAPITests.hs | 49 +++++++++++++++++++-------
 3 files changed, 48 insertions(+), 19 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 3f7ed0d90..e0cfb2aca 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -419,15 +419,18 @@ getNetworkConfig = fmap snd . readTVarIO . useNetworkConfig
 {-# INLINE getNetworkConfig #-}
 
 setUserNetworkInfo :: AgentClient -> UserNetworkInfo -> IO ()
-setUserNetworkInfo c@AgentClient {userNetworkState} UserNetworkInfo {networkType = nt'} = withAgentEnv' c $ do
+setUserNetworkInfo c@AgentClient {userNetworkState} UserNetworkInfo {networkType = nt', online} = withAgentEnv' c $ do
   d <- asks $ initialInterval . userNetworkInterval . config
   ts <- liftIO getCurrentTime
   atomically $ do
-    ns@UserNetworkState {networkType = nt} <- readTVar userNetworkState
-    when (nt' /= nt) $
-      writeTVar userNetworkState $! case nt' of
-        UNNone -> ns {networkType = nt', offline = Just UNSOffline {offlineDelay = d, offlineFrom = ts}}
-        _ -> ns {networkType = nt', offline = Nothing}
+    ns@UserNetworkState {networkType = nt, offline} <- readTVar userNetworkState
+    when (nt' /= nt || online /= isNothing offline) $
+      writeTVar userNetworkState $!
+        let offline'
+              | nt' /= UNNone && online = Nothing
+              | isJust offline = offline
+              | otherwise = Just UNSOffline {offlineDelay = d, offlineFrom = ts}
+         in ns {networkType = nt', offline = offline'}
 
 reconnectAllServers :: AgentClient -> IO ()
 reconnectAllServers c = do
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 3091fba87..7041f10c6 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -405,7 +405,8 @@ data AgentStatsKey = AgentStatsKey
   deriving (Eq, Ord, Show)
 
 data UserNetworkInfo = UserNetworkInfo
-  { networkType :: UserNetworkType
+  { networkType :: UserNetworkType,
+    online :: Bool
   }
   deriving (Show)
 
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 7d6884b27..301be97b4 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -428,6 +428,7 @@ functionalAPITests t = do
     it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent t
   describe "user network info" $ do
     it "should wait for user network" testWaitForUserNetwork
+    it "should not reset offline interval while offline" testDoNotResetOfflineInterval
 
 testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> IO Int
 testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 = do
@@ -2661,32 +2662,56 @@ testServerMultipleIdentities =
           }
         testE2ERatchetParams12
 
-testWaitForUserNetwork :: HasCallStack => IO ()
+testWaitForUserNetwork :: IO ()
 testWaitForUserNetwork = do
   a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
   noNetworkDelay a
-  setUserNetworkInfo a $ UserNetworkInfo UNNone
+  setUserNetworkInfo a $ UserNetworkInfo UNNone False
   networkDelay a 100000
   networkDelay a 150000
   networkDelay a 200000
   networkDelay a 200000
-  setUserNetworkInfo a $ UserNetworkInfo UNCellular
+  setUserNetworkInfo a $ UserNetworkInfo UNCellular True
   noNetworkDelay a
-  setUserNetworkInfo a $ UserNetworkInfo UNNone
+  setUserNetworkInfo a $ UserNetworkInfo UNCellular False
   networkDelay a 100000
   concurrently_
-    (threadDelay 50000 >> setUserNetworkInfo a (UserNetworkInfo UNCellular))
+    (threadDelay 50000 >> setUserNetworkInfo a (UserNetworkInfo UNCellular True))
     (networkDelay a 50000)
   noNetworkDelay a
   where
     aCfg = agentCfg {userNetworkInterval = RetryInterval {initialInterval = 100000, increaseAfter = 0, maxInterval = 200000}}
-    noNetworkDelay a = (10000 >) <$> waitNetwork a `shouldReturn` True
-    networkDelay a d' = (\d -> d' < d && d < d' + 15000) <$> waitNetwork a `shouldReturn` True
-    waitNetwork a = do
-      t <- getCurrentTime
-      waitForUserNetwork a `runReaderT` agentEnv a
-      t' <- getCurrentTime
-      pure $ diffToMicroseconds $ diffUTCTime t' t
+
+testDoNotResetOfflineInterval :: IO ()
+testDoNotResetOfflineInterval = do
+  a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
+  noNetworkDelay a
+  setUserNetworkInfo a $ UserNetworkInfo UNWifi False
+  networkDelay a 100000
+  networkDelay a 150000
+  setUserNetworkInfo a $ UserNetworkInfo UNCellular False
+  networkDelay a 200000
+  setUserNetworkInfo a $ UserNetworkInfo UNNone False
+  networkDelay a 200000
+  setUserNetworkInfo a $ UserNetworkInfo UNCellular True
+  noNetworkDelay a
+  setUserNetworkInfo a $ UserNetworkInfo UNCellular False
+  networkDelay a 100000
+  where
+    aCfg = agentCfg {userNetworkInterval = RetryInterval {initialInterval = 100000, increaseAfter = 0, maxInterval = 200000}}
+
+noNetworkDelay :: AgentClient -> IO ()
+noNetworkDelay a = (10000 >) <$> waitNetwork a `shouldReturn` True
+
+networkDelay :: AgentClient -> Int64 -> IO ()
+networkDelay a d' = (\d -> d' < d && d < d' + 15000) <$> waitNetwork a `shouldReturn` True
+
+waitNetwork :: AgentClient -> IO Int64
+waitNetwork a = do
+  t <- getCurrentTime
+  waitForUserNetwork a `runReaderT` agentEnv a
+  t' <- getCurrentTime
+  pure $ diffToMicroseconds $ diffUTCTime t' t
 
 exchangeGreetings :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 exchangeGreetings = exchangeGreetings_ PQEncOn