server: configuration to expire inactive clients in ini file (#369)

* server: configuration to expire inactive clients in ini file

* corrections

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2022-05-11 12:43:54 +01:00
committed by GitHub
parent 964daf5442
commit 4e4eea34f9
5 changed files with 80 additions and 44 deletions
+7 -4
View File
@@ -131,7 +131,8 @@ smpServer started = do
atomically $ TM.lookupDelete qId (clientSubs c)
expireMessagesThread_ :: ServerConfig -> [m ()]
expireMessagesThread_ = maybe [] ((: []) . expireMessages) . messageExpiration
expireMessagesThread_ ServerConfig {messageExpiration = Just msgExp} = [expireMessages msgExp]
expireMessagesThread_ _ = []
expireMessages :: ExpirationConfig -> m ()
expireMessages expCfg = do
@@ -147,8 +148,9 @@ smpServer started = do
>>= atomically . (`deleteExpiredMsgs` old)
serverStatsThread_ :: ServerConfig -> [m ()]
serverStatsThread_ ServerConfig {logStatsInterval, logStatsStartTime} =
maybe [] ((: []) . logServerStats logStatsStartTime) logStatsInterval
serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime} =
[logServerStats logStatsStartTime interval]
serverStatsThread_ _ = []
logServerStats :: Int -> Int -> m ()
logServerStats startAt logInterval = do
@@ -186,7 +188,8 @@ runClientTransport th@THandle {sessionId} = do
raceAny_ ([send th c, client c s, receive th c] <> disconnectThread_ c expCfg)
`finally` clientDisconnected c
where
disconnectThread_ c expCfg = maybe [] ((: []) . disconnectTransport th c activeAt) expCfg
disconnectThread_ c (Just expCfg) = [disconnectTransport th c activeAt expCfg]
disconnectThread_ _ _ = []
clientDisconnected :: (MonadUnliftIO m, MonadReader Env m) => Client -> m ()
clientDisconnected c@Client {subscriptions, connected} = do