use online status in network information (#1094)

* use online status in network information

* test

* refactor

* flip condition

* fix
This commit is contained in:
Evgeny Poberezkin
2024-04-12 22:22:24 +01:00
committed by GitHub
parent 036b7523a5
commit b741b65700
3 changed files with 48 additions and 19 deletions
+9 -6
View File
@@ -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
+2 -1
View File
@@ -405,7 +405,8 @@ data AgentStatsKey = AgentStatsKey
deriving (Eq, Ord, Show)
data UserNetworkInfo = UserNetworkInfo
{ networkType :: UserNetworkType
{ networkType :: UserNetworkType,
online :: Bool
}
deriving (Show)
+37 -12
View File
@@ -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