diff --git a/cabal.project b/cabal.project index 3f05fb8561..e5220e2156 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: f392ce0a9355cd3883400906ae6c361b77ca46ea + tag: ae8e1c5e9aa3155907f1bd075e9c69af5fce2bee source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index d046469ea8..712a0dbff4 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."f392ce0a9355cd3883400906ae6c361b77ca46ea" = "0id9mg30kmhlfcpnn2np3f0a4bb4smdzvhrbw6km8vv26si1js60"; + "https://github.com/simplex-chat/simplexmq.git"."ae8e1c5e9aa3155907f1bd075e9c69af5fce2bee" = "1k6phsn0xslqwd30g6l5bsg3ilghwjh2csav2g4bk6hb5a5ga2yk"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index cc829eaa16..131fbb7089 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -2266,6 +2266,7 @@ processChatCommand' vr = \case servers <- map (\ServerCfg {server} -> server) <$> withStore' (`getProtocolServers` users) let srvs = if null servers then L.toList defServers else servers pure $ map protoServer srvs + ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_ GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails GetAgentSubs -> lift $ summary <$> withAgent' getAgentSubscriptions @@ -7616,6 +7617,7 @@ chatCommandP = "/debug locks" $> DebugLocks, "/debug event " *> (DebugEvent <$> jsonP), "/get servers summary " *> (GetAgentServersSummary <$> A.decimal), + "/reset servers stats" $> ResetAgentServersStats, "/get subs" $> GetAgentSubs, "/get subs details" $> GetAgentSubsDetails, "/get workers" $> GetAgentWorkers, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 366e767154..14f8d6ff5c 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -507,6 +507,7 @@ data ChatCommand | DebugLocks | DebugEvent ChatResponse | GetAgentServersSummary UserId + | ResetAgentServersStats | GetAgentSubs | GetAgentSubsDetails | GetAgentWorkers diff --git a/src/Simplex/Chat/Stats.hs b/src/Simplex/Chat/Stats.hs index f6ea195e1c..f14353f0e0 100644 --- a/src/Simplex/Chat/Stats.hs +++ b/src/Simplex/Chat/Stats.hs @@ -5,7 +5,6 @@ module Simplex.Chat.Stats where -import Control.Applicative ((<|>)) import qualified Data.Aeson.TH as J import Data.Map.Strict (Map) import qualified Data.Map.Strict as M @@ -20,8 +19,10 @@ import Simplex.Messaging.Protocol data PresentedServersSummary = PresentedServersSummary { statsStartedAt :: UTCTime, - currentUserServers :: ServersSummary, - allUsersServers :: ServersSummary + allUsersSMP :: SMPServersSummary, + allUsersXFTP :: XFTPServersSummary, + currentUserSMP :: SMPServersSummary, + currentUserXFTP :: XFTPServersSummary } deriving (Show) @@ -29,8 +30,10 @@ data PresentedServersSummary = PresentedServersSummary -- so users can differentiate currently used (connected) servers, -- previously connected servers that were in use in previous sessions, -- and servers that are only proxied (not connected directly). -data ServersSummary = ServersSummary - { -- currently used SMP servers are those with Just in sessions and/or subs in SMPServerSummary; +data SMPServersSummary = SMPServersSummary + { -- SMP totals are calculated from all accounted SMP server summaries + smpTotals :: SMPTotals, + -- currently used SMP servers are those with Just in sessions and/or subs in SMPServerSummary; -- all other servers would fall either into previously used or only proxied servers category currentlyUsedSMPServers :: [SMPServerSummary], -- previously used SMP servers are those with Nothing in sessions and subs, @@ -40,13 +43,14 @@ data ServersSummary = ServersSummary -- only proxied SMP servers are those that aren't (according to current state - sessions and subs) -- and weren't (according to stats) connected directly; they would have Nothing in sessions and subs, -- and have all of sentDirect, sentProxied, recvMsgs, etc. = 0 in server stats - onlyProxiedSMPServers :: [SMPServerSummary], - -- currently used XFTP servers are those with Just in sessions in XFTPServerSummary, - -- and/or have upload/download/deletion in progress; - -- all other servers would fall into previously used servers category - currentlyUsedXFTPServers :: [XFTPServerSummary], - -- previously used XFTP servers are those with Nothing in sessions and don't have any process in progress - previouslyUsedXFTPServers :: [XFTPServerSummary] + onlyProxiedSMPServers :: [SMPServerSummary] + } + deriving (Show) + +data SMPTotals = SMPTotals + { sessions :: ServerSessions, + subs :: SMPServerSubs, + stats :: AgentSMPServerStatsData } deriving (Show) @@ -68,6 +72,24 @@ data SMPServerSummary = SMPServerSummary } deriving (Show) +data XFTPServersSummary = XFTPServersSummary + { -- XFTP totals are calculated from all accounted XFTP server summaries + xftpTotals :: XFTPTotals, + -- currently used XFTP servers are those with Just in sessions in XFTPServerSummary, + -- and/or have upload/download/deletion in progress; + -- all other servers would fall into previously used servers category + currentlyUsedXFTPServers :: [XFTPServerSummary], + -- previously used XFTP servers are those with Nothing in sessions and don't have any process in progress + previouslyUsedXFTPServers :: [XFTPServerSummary] + } + deriving (Show) + +data XFTPTotals = XFTPTotals + { sessions :: ServerSessions, + stats :: AgentXFTPServerStatsData + } + deriving (Show) + data XFTPServerSummary = XFTPServerSummary { xftpServer :: XFTPServer, known :: Maybe Bool, -- same as for SMPServerSummary @@ -87,34 +109,64 @@ data XFTPServerSummary = XFTPServerSummary toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> [SMPServer] -> [XFTPServer] -> PresentedServersSummary toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs = do let (userSMPSrvsSumms, allSMPSrvsSumms) = accSMPSrvsSummaries + (userSMPTotals, allSMPTotals) = (accSMPTotals userSMPSrvsSumms, accSMPTotals allSMPSrvsSumms) (userSMPCurr, userSMPPrev, userSMPProx) = smpSummsIntoCategories userSMPSrvsSumms (allSMPCurr, allSMPPrev, allSMPProx) = smpSummsIntoCategories allSMPSrvsSumms (userXFTPSrvsSumms, allXFTPSrvsSumms) = accXFTPSrvsSummaries + (userXFTPTotals, allXFTPTotals) = (accXFTPTotals userXFTPSrvsSumms, accXFTPTotals allXFTPSrvsSumms) (userXFTPCurr, userXFTPPrev) = xftpSummsIntoCategories userXFTPSrvsSumms (allXFTPCurr, allXFTPPrev) = xftpSummsIntoCategories allXFTPSrvsSumms PresentedServersSummary { statsStartedAt, - currentUserServers = - ServersSummary - { currentlyUsedSMPServers = userSMPCurr, - previouslyUsedSMPServers = userSMPPrev, - onlyProxiedSMPServers = userSMPProx, - currentlyUsedXFTPServers = userXFTPCurr, - previouslyUsedXFTPServers = userXFTPPrev - }, - allUsersServers = - ServersSummary - { currentlyUsedSMPServers = allSMPCurr, + allUsersSMP = + SMPServersSummary + { smpTotals = allSMPTotals, + currentlyUsedSMPServers = allSMPCurr, previouslyUsedSMPServers = allSMPPrev, - onlyProxiedSMPServers = allSMPProx, + onlyProxiedSMPServers = allSMPProx + }, + allUsersXFTP = + XFTPServersSummary + { xftpTotals = allXFTPTotals, currentlyUsedXFTPServers = allXFTPCurr, previouslyUsedXFTPServers = allXFTPPrev + }, + currentUserSMP = + SMPServersSummary + { smpTotals = userSMPTotals, + currentlyUsedSMPServers = userSMPCurr, + previouslyUsedSMPServers = userSMPPrev, + onlyProxiedSMPServers = userSMPProx + }, + currentUserXFTP = + XFTPServersSummary + { xftpTotals = userXFTPTotals, + currentlyUsedXFTPServers = userXFTPCurr, + previouslyUsedXFTPServers = userXFTPPrev } } where AgentServersSummary {statsStartedAt, smpServersSessions, smpServersSubs, smpServersStats, xftpServersSessions, xftpServersStats, xftpRcvInProgress, xftpSndInProgress, xftpDelInProgress} = agentSummary - countUserInAll auId = auId == aUserId currentUser || auId `notElem` hiddenUserIds - hiddenUserIds = map aUserId $ filter (isJust . viewPwdHash) users + countUserInAll auId = countUserInAllStats (AgentUserId auId) currentUser users + accSMPTotals :: Map SMPServer SMPServerSummary -> SMPTotals + accSMPTotals = M.foldr addTotals initialTotals + where + initialTotals = SMPTotals {sessions = ServerSessions 0 0 0, subs = SMPServerSubs 0 0, stats = newAgentSMPServerStatsData} + addTotals SMPServerSummary {sessions, subs, stats} SMPTotals {sessions = accSess, subs = accSubs, stats = accStats} = + SMPTotals + { sessions = maybe accSess (accSess `addServerSessions`) sessions, + subs = maybe accSubs (accSubs `addSMPSubs`) subs, + stats = maybe accStats (accStats `addSMPStatsData`) stats + } + accXFTPTotals :: Map XFTPServer XFTPServerSummary -> XFTPTotals + accXFTPTotals = M.foldr addTotals initialTotals + where + initialTotals = XFTPTotals {sessions = ServerSessions 0 0 0, stats = newAgentXFTPServerStatsData} + addTotals XFTPServerSummary {sessions, stats} XFTPTotals {sessions = accSess, stats = accStats} = + XFTPTotals + { sessions = maybe accSess (accSess `addServerSessions`) sessions, + stats = maybe accStats (accStats `addXFTPStatsData`) stats + } smpSummsIntoCategories :: Map SMPServer SMPServerSummary -> ([SMPServerSummary], [SMPServerSummary], [SMPServerSummary]) smpSummsIntoCategories = foldr partitionSummary ([], [], []) where @@ -171,7 +223,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv addSubs :: SMPServerSubs -> SMPServerSummary -> SMPServerSummary addSubs s summ@SMPServerSummary {subs} = summ {subs = Just $ maybe s (s `addSMPSubs`) subs} addStats :: AgentSMPServerStatsData -> SMPServerSummary -> SMPServerSummary - addStats s summ@SMPServerSummary {stats} = summ {stats = Just $ maybe s (s `addSMPStats`) stats} + addStats s summ@SMPServerSummary {stats} = summ {stats = Just $ maybe s (s `addSMPStatsData`) stats} accXFTPSrvsSummaries :: (Map XFTPServer XFTPServerSummary, Map XFTPServer XFTPServerSummary) accXFTPSrvsSummaries = M.foldrWithKey' (addServerData addStats) summs1 xftpServersStats where @@ -205,7 +257,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv addSessions :: ServerSessions -> XFTPServerSummary -> XFTPServerSummary addSessions s summ@XFTPServerSummary {sessions} = summ {sessions = Just $ maybe s (s `addServerSessions`) sessions} addStats :: AgentXFTPServerStatsData -> XFTPServerSummary -> XFTPServerSummary - addStats s summ@XFTPServerSummary {stats} = summ {stats = Just $ maybe s (s `addXFTPStats`) stats} + addStats s summ@XFTPServerSummary {stats} = summ {stats = Just $ maybe s (s `addXFTPStatsData`) stats} addServerSessions :: ServerSessions -> ServerSessions -> ServerSessions addServerSessions ss1 ss2 = ServerSessions @@ -213,56 +265,30 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv ssErrors = ssErrors ss1 + ssErrors ss2, ssConnecting = ssConnecting ss1 + ssConnecting ss2 } - addSMPSubs :: SMPServerSubs -> SMPServerSubs -> SMPServerSubs - addSMPSubs ss1 ss2 = - SMPServerSubs - { ssActive = ssActive ss1 + ssActive ss2, - ssPending = ssPending ss1 + ssPending ss2 - } - addSMPStats :: AgentSMPServerStatsData -> AgentSMPServerStatsData -> AgentSMPServerStatsData - addSMPStats 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, - _connCreated = _connCreated sd1 + _connCreated sd2, - _connSecured = _connSecured sd1 + _connSecured sd2, - _connCompleted = _connCompleted sd1 + _connCompleted sd2, - _connDeleted = _connDeleted sd1 + _connDeleted sd2, - _connSubscribed = _connSubscribed sd1 + _connSubscribed sd2, - _connSubAttempts = _connSubAttempts sd1 + _connSubAttempts sd2, - _connSubErrs = _connSubErrs sd1 + _connSubErrs sd2 - } - addXFTPStats :: AgentXFTPServerStatsData -> AgentXFTPServerStatsData -> AgentXFTPServerStatsData - addXFTPStats sd1 sd2 = - AgentXFTPServerStatsData - { _uploads = _uploads sd1 + _uploads sd2, - _uploadAttempts = _uploadAttempts sd1 + _uploadAttempts sd2, - _uploadErrs = _uploadErrs sd1 + _uploadErrs sd2, - _downloads = _downloads sd1 + _downloads 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 - } + +countUserInAllStats :: AgentUserId -> User -> [User] -> Bool +countUserInAllStats (AgentUserId auId) currentUser users = + auId == aUserId currentUser || auId `notElem` hiddenUserIds + where + hiddenUserIds = map aUserId $ filter (isJust . viewPwdHash) users + +addSMPSubs :: SMPServerSubs -> SMPServerSubs -> SMPServerSubs +addSMPSubs ss1 ss2 = + SMPServerSubs + { ssActive = ssActive ss1 + ssActive ss2, + ssPending = ssPending ss1 + ssPending ss2 + } + +$(J.deriveJSON defaultJSON ''SMPTotals) $(J.deriveJSON defaultJSON ''SMPServerSummary) +$(J.deriveJSON defaultJSON ''SMPServersSummary) + +$(J.deriveJSON defaultJSON ''XFTPTotals) + $(J.deriveJSON defaultJSON ''XFTPServerSummary) -$(J.deriveJSON defaultJSON ''ServersSummary) +$(J.deriveJSON defaultJSON ''XFTPServersSummary) $(J.deriveJSON defaultJSON ''PresentedServersSummary)