mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-04-18 02:25:45 +00:00
f3408d9bb6
* explicit exports * more empty exports * add exports * reorder * use correct ControlProtocol type for xftp router --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
692 lines
23 KiB
Haskell
692 lines
23 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Simplex.Messaging.Agent.Stats
|
|
( AgentSMPServerStats (..),
|
|
AgentSMPServerStatsData (..),
|
|
OptionalInt (..),
|
|
AgentXFTPServerStats (..),
|
|
AgentXFTPServerStatsData (..),
|
|
AgentNtfServerStats (..),
|
|
AgentNtfServerStatsData (..),
|
|
AgentPersistedServerStats (..),
|
|
OptionalMap (..),
|
|
newAgentSMPServerStats,
|
|
newAgentSMPServerStatsData,
|
|
newAgentSMPServerStats',
|
|
getAgentSMPServerStats,
|
|
addSMPStatsData,
|
|
newAgentXFTPServerStats,
|
|
newAgentXFTPServerStatsData,
|
|
newAgentXFTPServerStats',
|
|
getAgentXFTPServerStats,
|
|
addXFTPStatsData,
|
|
newAgentNtfServerStats,
|
|
newAgentNtfServerStatsData,
|
|
newAgentNtfServerStats',
|
|
getAgentNtfServerStats,
|
|
addNtfStatsData,
|
|
) where
|
|
|
|
import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..))
|
|
import qualified Data.Aeson.TH as J
|
|
import Data.Int (Int64)
|
|
import Data.Map.Strict (Map)
|
|
import qualified Data.Map.Strict as M
|
|
import Simplex.Messaging.Agent.Protocol (UserId)
|
|
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
|
|
import Simplex.Messaging.Parsers (defaultJSON)
|
|
import Simplex.Messaging.Protocol (NtfServer, SMPServer, XFTPServer)
|
|
import Simplex.Messaging.Util (decodeJSON, encodeJSON)
|
|
import UnliftIO.STM
|
|
|
|
data AgentSMPServerStats = AgentSMPServerStats
|
|
{ sentDirect :: TVar Int, -- successfully sent messages
|
|
sentViaProxy :: TVar Int, -- successfully sent messages via proxy
|
|
sentProxied :: TVar Int, -- successfully sent messages to other destination server via this as proxy
|
|
sentDirectAttempts :: TVar Int, -- direct sending attempts (min 1 for each sent message)
|
|
sentViaProxyAttempts :: TVar Int, -- proxy sending attempts
|
|
sentProxiedAttempts :: TVar Int, -- attempts sending to other destination server via this as proxy
|
|
sentAuthErrs :: TVar Int, -- send AUTH errors
|
|
sentQuotaErrs :: TVar Int, -- send QUOTA permanent errors (message expired)
|
|
sentExpiredErrs :: TVar Int, -- send expired errors
|
|
sentOtherErrs :: TVar Int, -- other send permanent errors (excluding above)
|
|
recvMsgs :: TVar Int, -- total messages received
|
|
recvDuplicates :: TVar Int, -- duplicate messages received
|
|
recvCryptoErrs :: TVar Int, -- message decryption errors
|
|
recvErrs :: TVar Int, -- receive errors
|
|
ackMsgs :: TVar Int, -- total messages acknowledged
|
|
ackAttempts :: TVar Int, -- acknowledgement attempts
|
|
ackNoMsgErrs :: TVar Int, -- NO_MSG ack errors
|
|
ackOtherErrs :: TVar Int, -- other permanent ack errors (temporary accounted for in attempts)
|
|
-- conn stats are accounted for rcv queue server
|
|
connCreated :: TVar Int, -- total connections created
|
|
connSecured :: TVar Int, -- connections secured
|
|
connCompleted :: TVar Int, -- connections completed
|
|
connDeleted :: TVar Int, -- total connections deleted
|
|
connDelAttempts :: TVar Int, -- total connection deletion attempts
|
|
connDelErrs :: TVar Int, -- permanent connection deletion errors (temporary accounted for in attempts)
|
|
connSubscribed :: TVar Int, -- total successful subscription
|
|
connSubAttempts :: TVar Int, -- subscription attempts
|
|
connSubIgnored :: TVar Int, -- subscription results ignored (client switched to different session or it was not pending)
|
|
connSubErrs :: TVar Int, -- permanent subscription errors (temporary accounted for in attempts)
|
|
-- notifications stats
|
|
ntfKey :: TVar Int,
|
|
ntfKeyAttempts :: TVar Int,
|
|
ntfKeyDeleted :: TVar Int,
|
|
ntfKeyDeleteAttempts :: TVar Int
|
|
}
|
|
|
|
data AgentSMPServerStatsData = AgentSMPServerStatsData
|
|
{ _sentDirect :: Int,
|
|
_sentViaProxy :: Int,
|
|
_sentProxied :: Int,
|
|
_sentDirectAttempts :: Int,
|
|
_sentViaProxyAttempts :: Int,
|
|
_sentProxiedAttempts :: Int,
|
|
_sentAuthErrs :: Int,
|
|
_sentQuotaErrs :: Int,
|
|
_sentExpiredErrs :: Int,
|
|
_sentOtherErrs :: Int,
|
|
_recvMsgs :: Int,
|
|
_recvDuplicates :: Int,
|
|
_recvCryptoErrs :: Int,
|
|
_recvErrs :: Int,
|
|
_ackMsgs :: Int,
|
|
_ackAttempts :: Int,
|
|
_ackNoMsgErrs :: Int,
|
|
_ackOtherErrs :: Int,
|
|
_connCreated :: Int,
|
|
_connSecured :: Int,
|
|
_connCompleted :: Int,
|
|
_connDeleted :: Int,
|
|
_connDelAttempts :: Int,
|
|
_connDelErrs :: Int,
|
|
_connSubscribed :: Int,
|
|
_connSubAttempts :: Int,
|
|
_connSubIgnored :: Int,
|
|
_connSubErrs :: Int,
|
|
_ntfKey :: OptionalInt,
|
|
_ntfKeyAttempts :: OptionalInt,
|
|
_ntfKeyDeleted :: OptionalInt,
|
|
_ntfKeyDeleteAttempts :: OptionalInt
|
|
}
|
|
deriving (Show)
|
|
|
|
newtype OptionalInt = OInt {toInt :: Int}
|
|
deriving (Num, Show, ToJSON)
|
|
|
|
newAgentSMPServerStats :: STM AgentSMPServerStats
|
|
newAgentSMPServerStats = do
|
|
sentDirect <- newTVar 0
|
|
sentViaProxy <- newTVar 0
|
|
sentProxied <- newTVar 0
|
|
sentDirectAttempts <- newTVar 0
|
|
sentViaProxyAttempts <- newTVar 0
|
|
sentProxiedAttempts <- newTVar 0
|
|
sentAuthErrs <- newTVar 0
|
|
sentQuotaErrs <- newTVar 0
|
|
sentExpiredErrs <- newTVar 0
|
|
sentOtherErrs <- newTVar 0
|
|
recvMsgs <- newTVar 0
|
|
recvDuplicates <- newTVar 0
|
|
recvCryptoErrs <- newTVar 0
|
|
recvErrs <- newTVar 0
|
|
ackMsgs <- newTVar 0
|
|
ackAttempts <- newTVar 0
|
|
ackNoMsgErrs <- newTVar 0
|
|
ackOtherErrs <- newTVar 0
|
|
connCreated <- newTVar 0
|
|
connSecured <- newTVar 0
|
|
connCompleted <- newTVar 0
|
|
connDeleted <- newTVar 0
|
|
connDelAttempts <- newTVar 0
|
|
connDelErrs <- newTVar 0
|
|
connSubscribed <- newTVar 0
|
|
connSubAttempts <- newTVar 0
|
|
connSubIgnored <- newTVar 0
|
|
connSubErrs <- newTVar 0
|
|
ntfKey <- newTVar 0
|
|
ntfKeyAttempts <- newTVar 0
|
|
ntfKeyDeleted <- newTVar 0
|
|
ntfKeyDeleteAttempts <- newTVar 0
|
|
pure
|
|
AgentSMPServerStats
|
|
{ sentDirect,
|
|
sentViaProxy,
|
|
sentProxied,
|
|
sentDirectAttempts,
|
|
sentViaProxyAttempts,
|
|
sentProxiedAttempts,
|
|
sentAuthErrs,
|
|
sentQuotaErrs,
|
|
sentExpiredErrs,
|
|
sentOtherErrs,
|
|
recvMsgs,
|
|
recvDuplicates,
|
|
recvCryptoErrs,
|
|
recvErrs,
|
|
ackMsgs,
|
|
ackAttempts,
|
|
ackNoMsgErrs,
|
|
ackOtherErrs,
|
|
connCreated,
|
|
connSecured,
|
|
connCompleted,
|
|
connDeleted,
|
|
connDelAttempts,
|
|
connDelErrs,
|
|
connSubscribed,
|
|
connSubAttempts,
|
|
connSubIgnored,
|
|
connSubErrs,
|
|
ntfKey,
|
|
ntfKeyAttempts,
|
|
ntfKeyDeleted,
|
|
ntfKeyDeleteAttempts
|
|
}
|
|
|
|
newAgentSMPServerStatsData :: AgentSMPServerStatsData
|
|
newAgentSMPServerStatsData =
|
|
AgentSMPServerStatsData
|
|
{ _sentDirect = 0,
|
|
_sentViaProxy = 0,
|
|
_sentProxied = 0,
|
|
_sentDirectAttempts = 0,
|
|
_sentViaProxyAttempts = 0,
|
|
_sentProxiedAttempts = 0,
|
|
_sentAuthErrs = 0,
|
|
_sentQuotaErrs = 0,
|
|
_sentExpiredErrs = 0,
|
|
_sentOtherErrs = 0,
|
|
_recvMsgs = 0,
|
|
_recvDuplicates = 0,
|
|
_recvCryptoErrs = 0,
|
|
_recvErrs = 0,
|
|
_ackMsgs = 0,
|
|
_ackAttempts = 0,
|
|
_ackNoMsgErrs = 0,
|
|
_ackOtherErrs = 0,
|
|
_connCreated = 0,
|
|
_connSecured = 0,
|
|
_connCompleted = 0,
|
|
_connDeleted = 0,
|
|
_connDelAttempts = 0,
|
|
_connDelErrs = 0,
|
|
_connSubscribed = 0,
|
|
_connSubAttempts = 0,
|
|
_connSubIgnored = 0,
|
|
_connSubErrs = 0,
|
|
_ntfKey = 0,
|
|
_ntfKeyAttempts = 0,
|
|
_ntfKeyDeleted = 0,
|
|
_ntfKeyDeleteAttempts = 0
|
|
}
|
|
|
|
newAgentSMPServerStats' :: AgentSMPServerStatsData -> STM AgentSMPServerStats
|
|
newAgentSMPServerStats' s = do
|
|
sentDirect <- newTVar $ _sentDirect s
|
|
sentViaProxy <- newTVar $ _sentViaProxy s
|
|
sentProxied <- newTVar $ _sentProxied s
|
|
sentDirectAttempts <- newTVar $ _sentDirectAttempts s
|
|
sentViaProxyAttempts <- newTVar $ _sentViaProxyAttempts s
|
|
sentProxiedAttempts <- newTVar $ _sentProxiedAttempts s
|
|
sentAuthErrs <- newTVar $ _sentAuthErrs s
|
|
sentQuotaErrs <- newTVar $ _sentQuotaErrs s
|
|
sentExpiredErrs <- newTVar $ _sentExpiredErrs s
|
|
sentOtherErrs <- newTVar $ _sentOtherErrs s
|
|
recvMsgs <- newTVar $ _recvMsgs s
|
|
recvDuplicates <- newTVar $ _recvDuplicates s
|
|
recvCryptoErrs <- newTVar $ _recvCryptoErrs s
|
|
recvErrs <- newTVar $ _recvErrs s
|
|
ackMsgs <- newTVar $ _ackMsgs s
|
|
ackAttempts <- newTVar $ _ackAttempts s
|
|
ackNoMsgErrs <- newTVar $ _ackNoMsgErrs s
|
|
ackOtherErrs <- newTVar $ _ackOtherErrs s
|
|
connCreated <- newTVar $ _connCreated s
|
|
connSecured <- newTVar $ _connSecured s
|
|
connCompleted <- newTVar $ _connCompleted s
|
|
connDeleted <- newTVar $ _connDeleted s
|
|
connDelAttempts <- newTVar $ _connDelAttempts s
|
|
connDelErrs <- newTVar $ _connDelErrs s
|
|
connSubscribed <- newTVar $ _connSubscribed s
|
|
connSubAttempts <- newTVar $ _connSubAttempts s
|
|
connSubIgnored <- newTVar $ _connSubIgnored s
|
|
connSubErrs <- newTVar $ _connSubErrs s
|
|
ntfKey <- newTVar $ toInt $ _ntfKey s
|
|
ntfKeyAttempts <- newTVar $ toInt $ _ntfKeyAttempts s
|
|
ntfKeyDeleted <- newTVar $ toInt $ _ntfKeyDeleted s
|
|
ntfKeyDeleteAttempts <- newTVar $ toInt $ _ntfKeyDeleteAttempts s
|
|
pure
|
|
AgentSMPServerStats
|
|
{ sentDirect,
|
|
sentViaProxy,
|
|
sentProxied,
|
|
sentDirectAttempts,
|
|
sentViaProxyAttempts,
|
|
sentProxiedAttempts,
|
|
sentAuthErrs,
|
|
sentQuotaErrs,
|
|
sentExpiredErrs,
|
|
sentOtherErrs,
|
|
recvMsgs,
|
|
recvDuplicates,
|
|
recvCryptoErrs,
|
|
recvErrs,
|
|
ackMsgs,
|
|
ackAttempts,
|
|
ackNoMsgErrs,
|
|
ackOtherErrs,
|
|
connCreated,
|
|
connSecured,
|
|
connCompleted,
|
|
connDeleted,
|
|
connDelAttempts,
|
|
connDelErrs,
|
|
connSubscribed,
|
|
connSubAttempts,
|
|
connSubIgnored,
|
|
connSubErrs,
|
|
ntfKey,
|
|
ntfKeyAttempts,
|
|
ntfKeyDeleted,
|
|
ntfKeyDeleteAttempts
|
|
}
|
|
|
|
-- as this is used to periodically update stats in db,
|
|
-- this is not STM to decrease contention with stats updates
|
|
getAgentSMPServerStats :: AgentSMPServerStats -> IO AgentSMPServerStatsData
|
|
getAgentSMPServerStats s = do
|
|
_sentDirect <- readTVarIO $ sentDirect s
|
|
_sentViaProxy <- readTVarIO $ sentViaProxy s
|
|
_sentProxied <- readTVarIO $ sentProxied s
|
|
_sentDirectAttempts <- readTVarIO $ sentDirectAttempts s
|
|
_sentViaProxyAttempts <- readTVarIO $ sentViaProxyAttempts s
|
|
_sentProxiedAttempts <- readTVarIO $ sentProxiedAttempts s
|
|
_sentAuthErrs <- readTVarIO $ sentAuthErrs s
|
|
_sentQuotaErrs <- readTVarIO $ sentQuotaErrs s
|
|
_sentExpiredErrs <- readTVarIO $ sentExpiredErrs s
|
|
_sentOtherErrs <- readTVarIO $ sentOtherErrs s
|
|
_recvMsgs <- readTVarIO $ recvMsgs s
|
|
_recvDuplicates <- readTVarIO $ recvDuplicates s
|
|
_recvCryptoErrs <- readTVarIO $ recvCryptoErrs s
|
|
_recvErrs <- readTVarIO $ recvErrs s
|
|
_ackMsgs <- readTVarIO $ ackMsgs s
|
|
_ackAttempts <- readTVarIO $ ackAttempts s
|
|
_ackNoMsgErrs <- readTVarIO $ ackNoMsgErrs s
|
|
_ackOtherErrs <- readTVarIO $ ackOtherErrs s
|
|
_connCreated <- readTVarIO $ connCreated s
|
|
_connSecured <- readTVarIO $ connSecured s
|
|
_connCompleted <- readTVarIO $ connCompleted s
|
|
_connDeleted <- readTVarIO $ connDeleted s
|
|
_connDelAttempts <- readTVarIO $ connDelAttempts s
|
|
_connDelErrs <- readTVarIO $ connDelErrs s
|
|
_connSubscribed <- readTVarIO $ connSubscribed s
|
|
_connSubAttempts <- readTVarIO $ connSubAttempts s
|
|
_connSubIgnored <- readTVarIO $ connSubIgnored s
|
|
_connSubErrs <- readTVarIO $ connSubErrs s
|
|
_ntfKey <- OInt <$> readTVarIO (ntfKey s)
|
|
_ntfKeyAttempts <- OInt <$> readTVarIO (ntfKeyAttempts s)
|
|
_ntfKeyDeleted <- OInt <$> readTVarIO (ntfKeyDeleted s)
|
|
_ntfKeyDeleteAttempts <- OInt <$> readTVarIO (ntfKeyDeleteAttempts s)
|
|
pure
|
|
AgentSMPServerStatsData
|
|
{ _sentDirect,
|
|
_sentViaProxy,
|
|
_sentProxied,
|
|
_sentDirectAttempts,
|
|
_sentViaProxyAttempts,
|
|
_sentProxiedAttempts,
|
|
_sentAuthErrs,
|
|
_sentQuotaErrs,
|
|
_sentExpiredErrs,
|
|
_sentOtherErrs,
|
|
_recvMsgs,
|
|
_recvDuplicates,
|
|
_recvCryptoErrs,
|
|
_recvErrs,
|
|
_ackMsgs,
|
|
_ackAttempts,
|
|
_ackNoMsgErrs,
|
|
_ackOtherErrs,
|
|
_connCreated,
|
|
_connSecured,
|
|
_connCompleted,
|
|
_connDeleted,
|
|
_connDelAttempts,
|
|
_connDelErrs,
|
|
_connSubscribed,
|
|
_connSubAttempts,
|
|
_connSubIgnored,
|
|
_connSubErrs,
|
|
_ntfKey,
|
|
_ntfKeyAttempts,
|
|
_ntfKeyDeleted,
|
|
_ntfKeyDeleteAttempts
|
|
}
|
|
|
|
addSMPStatsData :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData
|
|
addSMPStatsData sd1 sd2 =
|
|
AgentSMPServerStatsData
|
|
{ _sentDirect = _sentDirect sd1 + _sentDirect sd2,
|
|
_sentViaProxy = _sentViaProxy sd1 + _sentViaProxy sd2,
|
|
_sentProxied = _sentProxied sd1 + _sentProxied sd2,
|
|
_sentDirectAttempts = _sentDirectAttempts sd1 + _sentDirectAttempts sd2,
|
|
_sentViaProxyAttempts = _sentViaProxyAttempts sd1 + _sentViaProxyAttempts sd2,
|
|
_sentProxiedAttempts = _sentProxiedAttempts sd1 + _sentProxiedAttempts sd2,
|
|
_sentAuthErrs = _sentAuthErrs sd1 + _sentAuthErrs sd2,
|
|
_sentQuotaErrs = _sentQuotaErrs sd1 + _sentQuotaErrs sd2,
|
|
_sentExpiredErrs = _sentExpiredErrs sd1 + _sentExpiredErrs sd2,
|
|
_sentOtherErrs = _sentOtherErrs sd1 + _sentOtherErrs sd2,
|
|
_recvMsgs = _recvMsgs sd1 + _recvMsgs sd2,
|
|
_recvDuplicates = _recvDuplicates sd1 + _recvDuplicates sd2,
|
|
_recvCryptoErrs = _recvCryptoErrs sd1 + _recvCryptoErrs sd2,
|
|
_recvErrs = _recvErrs sd1 + _recvErrs sd2,
|
|
_ackMsgs = _ackMsgs sd1 + _ackMsgs sd2,
|
|
_ackAttempts = _ackAttempts sd1 + _ackAttempts sd2,
|
|
_ackNoMsgErrs = _ackNoMsgErrs sd1 + _ackNoMsgErrs sd2,
|
|
_ackOtherErrs = _ackOtherErrs sd1 + _ackOtherErrs sd2,
|
|
_connCreated = _connCreated sd1 + _connCreated sd2,
|
|
_connSecured = _connSecured sd1 + _connSecured sd2,
|
|
_connCompleted = _connCompleted sd1 + _connCompleted sd2,
|
|
_connDeleted = _connDeleted sd1 + _connDeleted sd2,
|
|
_connDelAttempts = _connDelAttempts sd1 + _connDelAttempts sd2,
|
|
_connDelErrs = _connDelErrs sd1 + _connDelErrs sd2,
|
|
_connSubscribed = _connSubscribed sd1 + _connSubscribed sd2,
|
|
_connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2,
|
|
_connSubIgnored = _connSubIgnored sd1 + _connSubIgnored sd2,
|
|
_connSubErrs = _connSubErrs sd1 + _connSubErrs sd2,
|
|
_ntfKey = _ntfKey sd1 + _ntfKey sd2,
|
|
_ntfKeyAttempts = _ntfKeyAttempts sd1 + _ntfKeyAttempts sd2,
|
|
_ntfKeyDeleted = _ntfKeyDeleted sd1 + _ntfKeyDeleted sd2,
|
|
_ntfKeyDeleteAttempts = _ntfKeyDeleteAttempts sd1 + _ntfKeyDeleteAttempts sd2
|
|
}
|
|
|
|
data AgentXFTPServerStats = AgentXFTPServerStats
|
|
{ uploads :: TVar Int, -- total replicas uploaded to server
|
|
uploadsSize :: TVar Int64, -- total size of uploaded replicas in KB
|
|
uploadAttempts :: TVar Int, -- upload attempts
|
|
uploadErrs :: TVar Int, -- upload errors
|
|
downloads :: TVar Int, -- total replicas downloaded from server
|
|
downloadsSize :: TVar Int64, -- total size of downloaded replicas in KB
|
|
downloadAttempts :: TVar Int, -- download attempts
|
|
downloadAuthErrs :: TVar Int, -- download AUTH errors
|
|
downloadErrs :: TVar Int, -- other download errors (excluding above)
|
|
deletions :: TVar Int, -- total replicas deleted from server
|
|
deleteAttempts :: TVar Int, -- delete attempts
|
|
deleteErrs :: TVar Int -- delete errors
|
|
}
|
|
|
|
data AgentXFTPServerStatsData = AgentXFTPServerStatsData
|
|
{ _uploads :: Int,
|
|
_uploadsSize :: Int64,
|
|
_uploadAttempts :: Int,
|
|
_uploadErrs :: Int,
|
|
_downloads :: Int,
|
|
_downloadsSize :: Int64,
|
|
_downloadAttempts :: Int,
|
|
_downloadAuthErrs :: Int,
|
|
_downloadErrs :: Int,
|
|
_deletions :: Int,
|
|
_deleteAttempts :: Int,
|
|
_deleteErrs :: Int
|
|
}
|
|
deriving (Show)
|
|
|
|
newAgentXFTPServerStats :: STM AgentXFTPServerStats
|
|
newAgentXFTPServerStats = do
|
|
uploads <- newTVar 0
|
|
uploadsSize <- newTVar 0
|
|
uploadAttempts <- newTVar 0
|
|
uploadErrs <- newTVar 0
|
|
downloads <- newTVar 0
|
|
downloadsSize <- newTVar 0
|
|
downloadAttempts <- newTVar 0
|
|
downloadAuthErrs <- newTVar 0
|
|
downloadErrs <- newTVar 0
|
|
deletions <- newTVar 0
|
|
deleteAttempts <- newTVar 0
|
|
deleteErrs <- newTVar 0
|
|
pure
|
|
AgentXFTPServerStats
|
|
{ uploads,
|
|
uploadsSize,
|
|
uploadAttempts,
|
|
uploadErrs,
|
|
downloads,
|
|
downloadsSize,
|
|
downloadAttempts,
|
|
downloadAuthErrs,
|
|
downloadErrs,
|
|
deletions,
|
|
deleteAttempts,
|
|
deleteErrs
|
|
}
|
|
|
|
newAgentXFTPServerStatsData :: AgentXFTPServerStatsData
|
|
newAgentXFTPServerStatsData =
|
|
AgentXFTPServerStatsData
|
|
{ _uploads = 0,
|
|
_uploadsSize = 0,
|
|
_uploadAttempts = 0,
|
|
_uploadErrs = 0,
|
|
_downloads = 0,
|
|
_downloadsSize = 0,
|
|
_downloadAttempts = 0,
|
|
_downloadAuthErrs = 0,
|
|
_downloadErrs = 0,
|
|
_deletions = 0,
|
|
_deleteAttempts = 0,
|
|
_deleteErrs = 0
|
|
}
|
|
|
|
newAgentXFTPServerStats' :: AgentXFTPServerStatsData -> STM AgentXFTPServerStats
|
|
newAgentXFTPServerStats' s = do
|
|
uploads <- newTVar $ _uploads s
|
|
uploadsSize <- newTVar $ _uploadsSize s
|
|
uploadAttempts <- newTVar $ _uploadAttempts s
|
|
uploadErrs <- newTVar $ _uploadErrs s
|
|
downloads <- newTVar $ _downloads s
|
|
downloadsSize <- newTVar $ _downloadsSize s
|
|
downloadAttempts <- newTVar $ _downloadAttempts s
|
|
downloadAuthErrs <- newTVar $ _downloadAuthErrs s
|
|
downloadErrs <- newTVar $ _downloadErrs s
|
|
deletions <- newTVar $ _deletions s
|
|
deleteAttempts <- newTVar $ _deleteAttempts s
|
|
deleteErrs <- newTVar $ _deleteErrs s
|
|
pure
|
|
AgentXFTPServerStats
|
|
{ uploads,
|
|
uploadsSize,
|
|
uploadAttempts,
|
|
uploadErrs,
|
|
downloads,
|
|
downloadsSize,
|
|
downloadAttempts,
|
|
downloadAuthErrs,
|
|
downloadErrs,
|
|
deletions,
|
|
deleteAttempts,
|
|
deleteErrs
|
|
}
|
|
|
|
-- as this is used to periodically update stats in db,
|
|
-- this is not STM to decrease contention with stats updates
|
|
getAgentXFTPServerStats :: AgentXFTPServerStats -> IO AgentXFTPServerStatsData
|
|
getAgentXFTPServerStats s = do
|
|
_uploads <- readTVarIO $ uploads s
|
|
_uploadsSize <- readTVarIO $ uploadsSize s
|
|
_uploadAttempts <- readTVarIO $ uploadAttempts s
|
|
_uploadErrs <- readTVarIO $ uploadErrs s
|
|
_downloads <- readTVarIO $ downloads s
|
|
_downloadsSize <- readTVarIO $ downloadsSize s
|
|
_downloadAttempts <- readTVarIO $ downloadAttempts s
|
|
_downloadAuthErrs <- readTVarIO $ downloadAuthErrs s
|
|
_downloadErrs <- readTVarIO $ downloadErrs s
|
|
_deletions <- readTVarIO $ deletions s
|
|
_deleteAttempts <- readTVarIO $ deleteAttempts s
|
|
_deleteErrs <- readTVarIO $ deleteErrs s
|
|
pure
|
|
AgentXFTPServerStatsData
|
|
{ _uploads,
|
|
_uploadsSize,
|
|
_uploadAttempts,
|
|
_uploadErrs,
|
|
_downloads,
|
|
_downloadsSize,
|
|
_downloadAttempts,
|
|
_downloadAuthErrs,
|
|
_downloadErrs,
|
|
_deletions,
|
|
_deleteAttempts,
|
|
_deleteErrs
|
|
}
|
|
|
|
addXFTPStatsData :: AgentXFTPServerStatsData -> AgentXFTPServerStatsData -> AgentXFTPServerStatsData
|
|
addXFTPStatsData sd1 sd2 =
|
|
AgentXFTPServerStatsData
|
|
{ _uploads = _uploads sd1 + _uploads sd2,
|
|
_uploadsSize = _uploadsSize sd1 + _uploadsSize sd2,
|
|
_uploadAttempts = _uploadAttempts sd1 + _uploadAttempts sd2,
|
|
_uploadErrs = _uploadErrs sd1 + _uploadErrs sd2,
|
|
_downloads = _downloads sd1 + _downloads sd2,
|
|
_downloadsSize = _downloadsSize sd1 + _downloadsSize sd2,
|
|
_downloadAttempts = _downloadAttempts sd1 + _downloadAttempts sd2,
|
|
_downloadAuthErrs = _downloadAuthErrs sd1 + _downloadAuthErrs sd2,
|
|
_downloadErrs = _downloadErrs sd1 + _downloadErrs sd2,
|
|
_deletions = _deletions sd1 + _deletions sd2,
|
|
_deleteAttempts = _deleteAttempts sd1 + _deleteAttempts sd2,
|
|
_deleteErrs = _deleteErrs sd1 + _deleteErrs sd2
|
|
}
|
|
|
|
data AgentNtfServerStats = AgentNtfServerStats
|
|
{ ntfCreated :: TVar Int,
|
|
ntfCreateAttempts :: TVar Int,
|
|
ntfChecked :: TVar Int,
|
|
ntfCheckAttempts :: TVar Int,
|
|
ntfDeleted :: TVar Int,
|
|
ntfDelAttempts :: TVar Int
|
|
}
|
|
|
|
data AgentNtfServerStatsData = AgentNtfServerStatsData
|
|
{ _ntfCreated :: Int,
|
|
_ntfCreateAttempts :: Int,
|
|
_ntfChecked :: Int,
|
|
_ntfCheckAttempts :: Int,
|
|
_ntfDeleted :: Int,
|
|
_ntfDelAttempts :: Int
|
|
}
|
|
deriving (Show)
|
|
|
|
newAgentNtfServerStats :: STM AgentNtfServerStats
|
|
newAgentNtfServerStats = do
|
|
ntfCreated <- newTVar 0
|
|
ntfCreateAttempts <- newTVar 0
|
|
ntfChecked <- newTVar 0
|
|
ntfCheckAttempts <- newTVar 0
|
|
ntfDeleted <- newTVar 0
|
|
ntfDelAttempts <- newTVar 0
|
|
pure
|
|
AgentNtfServerStats
|
|
{ ntfCreated,
|
|
ntfCreateAttempts,
|
|
ntfChecked,
|
|
ntfCheckAttempts,
|
|
ntfDeleted,
|
|
ntfDelAttempts
|
|
}
|
|
|
|
newAgentNtfServerStatsData :: AgentNtfServerStatsData
|
|
newAgentNtfServerStatsData =
|
|
AgentNtfServerStatsData
|
|
{ _ntfCreated = 0,
|
|
_ntfCreateAttempts = 0,
|
|
_ntfChecked = 0,
|
|
_ntfCheckAttempts = 0,
|
|
_ntfDeleted = 0,
|
|
_ntfDelAttempts = 0
|
|
}
|
|
|
|
newAgentNtfServerStats' :: AgentNtfServerStatsData -> STM AgentNtfServerStats
|
|
newAgentNtfServerStats' s = do
|
|
ntfCreated <- newTVar $ _ntfCreated s
|
|
ntfCreateAttempts <- newTVar $ _ntfCreateAttempts s
|
|
ntfChecked <- newTVar $ _ntfChecked s
|
|
ntfCheckAttempts <- newTVar $ _ntfCheckAttempts s
|
|
ntfDeleted <- newTVar $ _ntfDeleted s
|
|
ntfDelAttempts <- newTVar $ _ntfDelAttempts s
|
|
pure
|
|
AgentNtfServerStats
|
|
{ ntfCreated,
|
|
ntfCreateAttempts,
|
|
ntfChecked,
|
|
ntfCheckAttempts,
|
|
ntfDeleted,
|
|
ntfDelAttempts
|
|
}
|
|
|
|
getAgentNtfServerStats :: AgentNtfServerStats -> IO AgentNtfServerStatsData
|
|
getAgentNtfServerStats s = do
|
|
_ntfCreated <- readTVarIO $ ntfCreated s
|
|
_ntfCreateAttempts <- readTVarIO $ ntfCreateAttempts s
|
|
_ntfChecked <- readTVarIO $ ntfChecked s
|
|
_ntfCheckAttempts <- readTVarIO $ ntfCheckAttempts s
|
|
_ntfDeleted <- readTVarIO $ ntfDeleted s
|
|
_ntfDelAttempts <- readTVarIO $ ntfDelAttempts s
|
|
pure
|
|
AgentNtfServerStatsData
|
|
{ _ntfCreated,
|
|
_ntfCreateAttempts,
|
|
_ntfChecked,
|
|
_ntfCheckAttempts,
|
|
_ntfDeleted,
|
|
_ntfDelAttempts
|
|
}
|
|
|
|
addNtfStatsData :: AgentNtfServerStatsData -> AgentNtfServerStatsData -> AgentNtfServerStatsData
|
|
addNtfStatsData sd1 sd2 =
|
|
AgentNtfServerStatsData
|
|
{ _ntfCreated = _ntfCreated sd1 + _ntfCreated sd2,
|
|
_ntfCreateAttempts = _ntfCreateAttempts sd1 + _ntfCreateAttempts sd2,
|
|
_ntfChecked = _ntfChecked sd1 + _ntfChecked sd2,
|
|
_ntfCheckAttempts = _ntfCheckAttempts sd1 + _ntfCheckAttempts sd2,
|
|
_ntfDeleted = _ntfDeleted sd1 + _ntfDeleted sd2,
|
|
_ntfDelAttempts = _ntfDelAttempts sd1 + _ntfDelAttempts sd2
|
|
}
|
|
|
|
-- Type for gathering both smp and xftp stats across all users and servers,
|
|
-- to then be persisted to db as a single json.
|
|
data AgentPersistedServerStats = AgentPersistedServerStats
|
|
{ smpServersStats :: Map (UserId, SMPServer) AgentSMPServerStatsData,
|
|
xftpServersStats :: Map (UserId, XFTPServer) AgentXFTPServerStatsData,
|
|
ntfServersStats :: OptionalMap (UserId, NtfServer) AgentNtfServerStatsData
|
|
}
|
|
deriving (Show)
|
|
|
|
instance FromJSON OptionalInt where
|
|
parseJSON v = OInt <$> parseJSON v
|
|
omittedField = Just (OInt 0)
|
|
|
|
newtype OptionalMap k v = OptionalMap (Map k v)
|
|
deriving (Show, ToJSON)
|
|
|
|
instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (OptionalMap k v) where
|
|
parseJSON v = OptionalMap <$> parseJSON v
|
|
omittedField = Just (OptionalMap M.empty)
|
|
|
|
$(J.deriveJSON defaultJSON ''AgentSMPServerStatsData)
|
|
|
|
$(J.deriveJSON defaultJSON ''AgentXFTPServerStatsData)
|
|
|
|
$(J.deriveJSON defaultJSON ''AgentNtfServerStatsData)
|
|
|
|
$(J.deriveJSON defaultJSON ''AgentPersistedServerStats)
|
|
|
|
instance ToField AgentPersistedServerStats where
|
|
toField = toField . encodeJSON
|
|
|
|
instance FromField AgentPersistedServerStats where
|
|
fromField = fromTextField_ decodeJSON
|