mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-01 18:08:36 +00:00
114 lines
4.5 KiB
Haskell
114 lines
4.5 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Simplex.Messaging.Notifications.Server.Stats where
|
|
|
|
import Control.Applicative (optional)
|
|
import qualified Data.Attoparsec.ByteString.Char8 as A
|
|
import qualified Data.ByteString.Char8 as B
|
|
import Data.Time.Clock (UTCTime)
|
|
import Simplex.Messaging.Encoding.String
|
|
import Simplex.Messaging.Notifications.Protocol (NtfTokenId)
|
|
import Simplex.Messaging.Protocol (NotifierId)
|
|
import Simplex.Messaging.Server.Stats
|
|
import UnliftIO.STM
|
|
|
|
data NtfServerStats = NtfServerStats
|
|
{ fromTime :: TVar UTCTime,
|
|
tknCreated :: TVar Int,
|
|
tknVerified :: TVar Int,
|
|
tknDeleted :: TVar Int,
|
|
subCreated :: TVar Int,
|
|
subDeleted :: TVar Int,
|
|
ntfReceived :: TVar Int,
|
|
ntfDelivered :: TVar Int,
|
|
activeTokens :: PeriodStats NtfTokenId,
|
|
activeSubs :: PeriodStats NotifierId
|
|
}
|
|
|
|
data NtfServerStatsData = NtfServerStatsData
|
|
{ _fromTime :: UTCTime,
|
|
_tknCreated :: Int,
|
|
_tknVerified :: Int,
|
|
_tknDeleted :: Int,
|
|
_subCreated :: Int,
|
|
_subDeleted :: Int,
|
|
_ntfReceived :: Int,
|
|
_ntfDelivered :: Int,
|
|
_activeTokens :: PeriodStatsData NtfTokenId,
|
|
_activeSubs :: PeriodStatsData NotifierId
|
|
}
|
|
|
|
newNtfServerStats :: UTCTime -> STM NtfServerStats
|
|
newNtfServerStats ts = do
|
|
fromTime <- newTVar ts
|
|
tknCreated <- newTVar 0
|
|
tknVerified <- newTVar 0
|
|
tknDeleted <- newTVar 0
|
|
subCreated <- newTVar 0
|
|
subDeleted <- newTVar 0
|
|
ntfReceived <- newTVar 0
|
|
ntfDelivered <- newTVar 0
|
|
activeTokens <- newPeriodStats
|
|
activeSubs <- newPeriodStats
|
|
pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
|
|
|
|
getNtfServerStatsData :: NtfServerStats -> STM NtfServerStatsData
|
|
getNtfServerStatsData s = do
|
|
_fromTime <- readTVar $ fromTime (s :: NtfServerStats)
|
|
_tknCreated <- readTVar $ tknCreated s
|
|
_tknVerified <- readTVar $ tknVerified s
|
|
_tknDeleted <- readTVar $ tknDeleted s
|
|
_subCreated <- readTVar $ subCreated s
|
|
_subDeleted <- readTVar $ subDeleted s
|
|
_ntfReceived <- readTVar $ ntfReceived s
|
|
_ntfDelivered <- readTVar $ ntfDelivered s
|
|
_activeTokens <- getPeriodStatsData $ activeTokens s
|
|
_activeSubs <- getPeriodStatsData $ activeSubs s
|
|
pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
|
|
|
|
setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> STM ()
|
|
setNtfServerStats s d = do
|
|
writeTVar (fromTime (s :: NtfServerStats)) $! _fromTime (d :: NtfServerStatsData)
|
|
writeTVar (tknCreated s) $! _tknCreated d
|
|
writeTVar (tknVerified s) $! _tknVerified d
|
|
writeTVar (tknDeleted s) $! _tknDeleted d
|
|
writeTVar (subCreated s) $! _subCreated d
|
|
writeTVar (subDeleted s) $! _subDeleted d
|
|
writeTVar (ntfReceived s) $! _ntfReceived d
|
|
writeTVar (ntfDelivered s) $! _ntfDelivered d
|
|
setPeriodStats (activeTokens s) (_activeTokens d)
|
|
setPeriodStats (activeSubs s) (_activeSubs d)
|
|
|
|
instance StrEncoding NtfServerStatsData where
|
|
strEncode NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs} =
|
|
B.unlines
|
|
[ "fromTime=" <> strEncode _fromTime,
|
|
"tknCreated=" <> strEncode _tknCreated,
|
|
"tknVerified=" <> strEncode _tknVerified,
|
|
"tknDeleted=" <> strEncode _tknDeleted,
|
|
"subCreated=" <> strEncode _subCreated,
|
|
"subDeleted=" <> strEncode _subDeleted,
|
|
"ntfReceived=" <> strEncode _ntfReceived,
|
|
"ntfDelivered=" <> strEncode _ntfDelivered,
|
|
"activeTokens:",
|
|
strEncode _activeTokens,
|
|
"activeSubs:",
|
|
strEncode _activeSubs
|
|
]
|
|
strP = do
|
|
_fromTime <- "fromTime=" *> strP <* A.endOfLine
|
|
_tknCreated <- "tknCreated=" *> strP <* A.endOfLine
|
|
_tknVerified <- "tknVerified=" *> strP <* A.endOfLine
|
|
_tknDeleted <- "tknDeleted=" *> strP <* A.endOfLine
|
|
_subCreated <- "subCreated=" *> strP <* A.endOfLine
|
|
_subDeleted <- "subDeleted=" *> strP <* A.endOfLine
|
|
_ntfReceived <- "ntfReceived=" *> strP <* A.endOfLine
|
|
_ntfDelivered <- "ntfDelivered=" *> strP <* A.endOfLine
|
|
_ <- "activeTokens:" <* A.endOfLine
|
|
_activeTokens <- strP <* A.endOfLine
|
|
_ <- "activeSubs:" <* A.endOfLine
|
|
_activeSubs <- strP <* optional A.endOfLine
|
|
pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
|