mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-02 13:39:49 +00:00
use online status in network information (#1094)
* use online status in network information * test * refactor * flip condition * fix
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -405,7 +405,8 @@ data AgentStatsKey = AgentStatsKey
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data UserNetworkInfo = UserNetworkInfo
|
||||
{ networkType :: UserNetworkType
|
||||
{ networkType :: UserNetworkType,
|
||||
online :: Bool
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user