update stats logging and make it opt-in (#472)
* update stats logging and make it opt-in * hSetBuffering * update var name
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
3a4f8cb6eb
commit
cde8a11693
|
|
@ -60,9 +60,10 @@ smpServerCLIConfig =
|
|||
\# and restoring it when the server is started.\n\
|
||||
\# Log is compacted on start (deleted objects are removed).\n"
|
||||
<> ("enable: " <> (if enableStoreLog then "on" else "off") <> "\n")
|
||||
<> "# The messages are optionally saved and restored when the server restarts,\n\
|
||||
\# they are deleted after restarting.\n"
|
||||
<> ("restore_messages: " <> (if enableStoreLog then "on" else "off") <> "\n\n")
|
||||
<> "# Undelivered messages are optionally saved and restored when the server restarts,\n\
|
||||
\# they are preserved in the .bak file until the next restart.\n"
|
||||
<> ("restore_messages: " <> (if enableStoreLog then "on" else "off") <> "\n")
|
||||
<> ("log_stats: off\n\n")
|
||||
<> "[TRANSPORT]\n"
|
||||
<> ("port: " <> defaultServerPort <> "\n")
|
||||
<> "websockets: off\n\n"
|
||||
|
|
@ -72,38 +73,38 @@ smpServerCLIConfig =
|
|||
<> ("# ttl: " <> show (ttl defaultInactiveClientExpiration) <> "\n")
|
||||
<> ("# check_interval: " <> show (checkInterval defaultInactiveClientExpiration) <> "\n"),
|
||||
mkServerConfig = \storeLogFile transports ini ->
|
||||
ServerConfig
|
||||
{ transports,
|
||||
tbqSize = 16,
|
||||
serverTbqSize = 64,
|
||||
msgQueueQuota = 128,
|
||||
queueIdBytes = 24,
|
||||
msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
|
||||
caCertificateFile = caCrtFile,
|
||||
privateKeyFile = serverKeyFile,
|
||||
certificateFile = serverCrtFile,
|
||||
storeLogFile,
|
||||
storeMsgsFile =
|
||||
let messagesPath = combine logPath "smp-server-messages.log"
|
||||
in case lookupValue "STORE_LOG" "restore_messages" ini of
|
||||
Right "on" -> Just messagesPath
|
||||
Right _ -> Nothing
|
||||
-- if the setting is not set, it is enabled when store log is enabled
|
||||
_ -> storeLogFile $> messagesPath,
|
||||
allowNewQueues = True,
|
||||
messageExpiration = Just defaultMessageExpiration,
|
||||
inactiveClientExpiration =
|
||||
if lookupValue "INACTIVE_CLIENTS" "disconnect" ini == Right "on"
|
||||
then
|
||||
Just
|
||||
ExpirationConfig
|
||||
let settingIsOn section name = if lookupValue section name ini == Right "on" then Just () else Nothing
|
||||
logStats = settingIsOn "STORE_LOG" "log_stats"
|
||||
in ServerConfig
|
||||
{ transports,
|
||||
tbqSize = 16,
|
||||
serverTbqSize = 64,
|
||||
msgQueueQuota = 128,
|
||||
queueIdBytes = 24,
|
||||
msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
|
||||
caCertificateFile = caCrtFile,
|
||||
privateKeyFile = serverKeyFile,
|
||||
certificateFile = serverCrtFile,
|
||||
storeLogFile,
|
||||
storeMsgsFile =
|
||||
let messagesPath = combine logPath "smp-server-messages.log"
|
||||
in case lookupValue "STORE_LOG" "restore_messages" ini of
|
||||
Right "on" -> Just messagesPath
|
||||
Right _ -> Nothing
|
||||
-- if the setting is not set, it is enabled when store log is enabled
|
||||
_ -> storeLogFile $> messagesPath,
|
||||
allowNewQueues = True,
|
||||
messageExpiration = Just defaultMessageExpiration,
|
||||
inactiveClientExpiration =
|
||||
settingIsOn "INACTIVE_CLIENTS" "disconnect"
|
||||
$> ExpirationConfig
|
||||
{ ttl = readStrictIni "INACTIVE_CLIENTS" "ttl" ini,
|
||||
checkInterval = readStrictIni "INACTIVE_CLIENTS" "check_interval" ini
|
||||
}
|
||||
else Nothing,
|
||||
logStatsInterval = Just 86400, -- seconds
|
||||
logStatsStartTime = 0, -- seconds from 00:00 UTC
|
||||
serverStatsFile = Just $ combine logPath "smp-server-stats.log",
|
||||
smpServerVRange = supportedSMPServerVRange
|
||||
}
|
||||
},
|
||||
logStatsInterval = logStats $> 86400, -- seconds
|
||||
logStatsStartTime = 0, -- seconds from 00:00 UTC
|
||||
serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
|
||||
serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
|
||||
smpServerVRange = supportedSMPServerVRange
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -78,6 +78,7 @@ import Simplex.Messaging.Transport
|
|||
import Simplex.Messaging.Transport.Server
|
||||
import Simplex.Messaging.Util
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO (hPutStrLn)
|
||||
import System.Mem.Weak (deRefWeak)
|
||||
import UnliftIO.Concurrent
|
||||
import UnliftIO.Directory (doesFileExist, renameFile)
|
||||
|
|
@ -165,32 +166,34 @@ smpServer started = do
|
|||
>>= atomically . (`deleteExpiredMsgs` old)
|
||||
|
||||
serverStatsThread_ :: ServerConfig -> [m ()]
|
||||
serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime} =
|
||||
[logServerStats logStatsStartTime interval]
|
||||
serverStatsThread_ ServerConfig {logStatsInterval = Just interval, logStatsStartTime, serverStatsLogFile} =
|
||||
[logServerStats logStatsStartTime interval serverStatsLogFile]
|
||||
serverStatsThread_ _ = []
|
||||
|
||||
logServerStats :: Int -> Int -> m ()
|
||||
logServerStats startAt logInterval = do
|
||||
logServerStats :: Int -> Int -> FilePath -> m ()
|
||||
logServerStats startAt logInterval statsFilePath = do
|
||||
initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
|
||||
logInfo "fromTime,qCreated,qSecured,qDeleted,msgSent,msgRecv,dayMsgQueues,weekMsgQueues,monthMsgQueues"
|
||||
liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
|
||||
threadDelay $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
|
||||
ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, dayMsgQueues, weekMsgQueues, monthMsgQueues} <- asks serverStats
|
||||
let interval = 1000000 * logInterval
|
||||
forever $ do
|
||||
ts <- liftIO getCurrentTime
|
||||
fromTime' <- atomically $ swapTVar fromTime ts
|
||||
qCreated' <- atomically $ swapTVar qCreated 0
|
||||
qSecured' <- atomically $ swapTVar qSecured 0
|
||||
qDeleted' <- atomically $ swapTVar qDeleted 0
|
||||
msgSent' <- atomically $ swapTVar msgSent 0
|
||||
msgRecv' <- atomically $ swapTVar msgRecv 0
|
||||
let day = utctDay ts
|
||||
(_, wDay) = mondayStartWeek day
|
||||
MonthDay _ mDay = day
|
||||
(dayMsgQueues', weekMsgQueues', monthMsgQueues') <-
|
||||
atomically $ (,,) <$> periodCount 1 dayMsgQueues <*> periodCount wDay weekMsgQueues <*> periodCount mDay monthMsgQueues
|
||||
logInfo . T.pack $ intercalate "," [iso8601Show fromTime', show qCreated', show qSecured', show qDeleted', show msgSent', show msgRecv', show dayMsgQueues', weekMsgQueues', monthMsgQueues']
|
||||
threadDelay interval
|
||||
withFile statsFilePath AppendMode $ \h -> liftIO $ do
|
||||
hSetBuffering h LineBuffering
|
||||
forever $ do
|
||||
ts <- getCurrentTime
|
||||
fromTime' <- atomically $ swapTVar fromTime ts
|
||||
qCreated' <- atomically $ swapTVar qCreated 0
|
||||
qSecured' <- atomically $ swapTVar qSecured 0
|
||||
qDeleted' <- atomically $ swapTVar qDeleted 0
|
||||
msgSent' <- atomically $ swapTVar msgSent 0
|
||||
msgRecv' <- atomically $ swapTVar msgRecv 0
|
||||
let day = utctDay ts
|
||||
(_, wDay) = mondayStartWeek day
|
||||
MonthDay _ mDay = day
|
||||
(dayMsgQueues', weekMsgQueues', monthMsgQueues') <-
|
||||
atomically $ (,,) <$> periodCount 1 dayMsgQueues <*> periodCount wDay weekMsgQueues <*> periodCount mDay monthMsgQueues
|
||||
hPutStrLn h $ intercalate "," [iso8601Show $ utctDay fromTime', show qCreated', show qSecured', show qDeleted', show msgSent', show msgRecv', dayMsgQueues', weekMsgQueues', monthMsgQueues']
|
||||
threadDelay interval
|
||||
where
|
||||
periodCount :: Int -> TVar (Set RecipientId) -> STM String
|
||||
periodCount 1 pVar = show . S.size <$> swapTVar pVar S.empty
|
||||
|
|
@ -714,7 +717,7 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
|
|||
|
||||
saveServerStats :: (MonadUnliftIO m, MonadReader Env m) => m ()
|
||||
saveServerStats =
|
||||
asks (serverStatsFile . config)
|
||||
asks (serverStatsBackupFile . config)
|
||||
>>= mapM_ (\f -> asks serverStats >>= atomically . getServerStatsData >>= liftIO . saveStats f)
|
||||
where
|
||||
saveStats f stats = do
|
||||
|
|
@ -723,7 +726,7 @@ saveServerStats =
|
|||
logInfo "server stats saved"
|
||||
|
||||
restoreServerStats :: (MonadUnliftIO m, MonadReader Env m) => m ()
|
||||
restoreServerStats = asks (serverStatsFile . config) >>= mapM_ restoreStats
|
||||
restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
|
||||
where
|
||||
restoreStats f = whenM (doesFileExist f) $ do
|
||||
logInfo $ "restoring server stats from file " <> T.pack f
|
||||
|
|
|
|||
|
|
@ -55,8 +55,10 @@ data ServerConfig = ServerConfig
|
|||
-- | time of the day when the stats are logged first, to log at consistent times,
|
||||
-- irrespective of when the server is started (seconds from 00:00 UTC)
|
||||
logStatsStartTime :: Int,
|
||||
-- | file to log stats
|
||||
serverStatsLogFile :: FilePath,
|
||||
-- | file to save and restore stats
|
||||
serverStatsFile :: Maybe FilePath,
|
||||
serverStatsBackupFile :: Maybe FilePath,
|
||||
-- | CA certificate private key is not needed for initialization
|
||||
caCertificateFile :: FilePath,
|
||||
privateKeyFile :: FilePath,
|
||||
|
|
|
|||
|
|
@ -47,8 +47,8 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
|
|||
testStoreMsgsFile :: FilePath
|
||||
testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
|
||||
|
||||
testServerStatsFile :: FilePath
|
||||
testServerStatsFile = "tests/tmp/smp-server-stats.log"
|
||||
testServerStatsBackupFile :: FilePath
|
||||
testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
|
||||
|
||||
testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
|
||||
testSMPClient client =
|
||||
|
|
@ -76,7 +76,7 @@ cfg =
|
|||
inactiveClientExpiration = Just defaultInactiveClientExpiration,
|
||||
logStatsInterval = Nothing,
|
||||
logStatsStartTime = 0,
|
||||
serverStatsFile = Nothing,
|
||||
serverStatsBackupFile = Nothing,
|
||||
caCertificateFile = "tests/fixtures/ca.crt",
|
||||
privateKeyFile = "tests/fixtures/server.key",
|
||||
certificateFile = "tests/fixtures/server.crt",
|
||||
|
|
@ -87,10 +87,10 @@ withSmpServerStoreMsgLogOnV2 :: (MonadUnliftIO m, MonadRandom m) => ATransport -
|
|||
withSmpServerStoreMsgLogOnV2 t = withSmpServerConfigOn t cfgV2 {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile}
|
||||
|
||||
withSmpServerStoreMsgLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
|
||||
withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsFile = Just testServerStatsFile}
|
||||
withSmpServerStoreMsgLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
|
||||
|
||||
withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
|
||||
withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsFile = Just testServerStatsFile}
|
||||
withSmpServerStoreLogOn t = withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile, serverStatsBackupFile = Just testServerStatsBackupFile}
|
||||
|
||||
withSmpServerConfigOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServerConfig -> ServiceName -> (ThreadId -> m a) -> m a
|
||||
withSmpServerConfigOn t cfg' port' =
|
||||
|
|
|
|||
Reference in New Issue