dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-26 18:25:49 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: faster tracking of active subscriptions; ui: only track in foreground (#4446)

Browse Source 
* core: faster tracking of active subscriptions

* combine db transaction

* optimizations of queries from UI

* ios: track when active

* ios: disable log

---------

Co-authored-by: Avently <7953703+avently@users.noreply.github.com>
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2024-07-13 08:44:51 +01:00
committed by GitHub
parent 23f24b1677
commit 3e873fcb32
8 changed files with 47 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+8 -9
View File
@@ -2260,11 +2260,14 @@ processChatCommand' vr = \case
DebugEvent event -> toView event >> ok_
GetAgentServersSummary userId -> withUserId userId $ \user -> do
agentServersSummary <- lift $ withAgent' getAgentServersSummary
users <- withStore' getUsers
smpServers <- getUserProtocolServers user SPSMP
xftpServers <- getUserProtocolServers user SPXFTP
cfg <- asks config
(users, smpServers, xftpServers) <-
withStore' $ \db -> (,,) <$> getUsers db <*> getServers db cfg user SPSMP <*> getServers db cfg user SPXFTP
let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers
pure $ CRAgentServersSummary user presentedServersSummary
where
getServers :: (ProtocolTypeI p, UserProtocol p) => DB.Connection -> ChatConfig -> User -> SProtocolType p -> IO (NonEmpty (ProtocolServer p))
getServers db cfg user p = L.map (\ServerCfg {server} -> protoServer server) . useServers cfg p <$> getProtocolServers db user
ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_
GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary
GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails
@@ -3223,7 +3226,8 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks
getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer]
getUnknownSrvs srvs = do
knownSrvs <- getUserProtocolServers user SPXFTP
cfg <- asks config
knownSrvs <- L.map (\ServerCfg {server} -> protoServer server) . useServers cfg SPXFTP <$> withStore' (`getProtocolServers` user)
pure $ filter (`notElem` knownSrvs) srvs
ipProtectedForSrvs :: [XFTPServer] -> CM Bool
ipProtectedForSrvs srvs = do
@@ -3235,11 +3239,6 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci
throwChatError $ CEFileNotApproved fileId unknownSrvs
getUserProtocolServers :: (ProtocolTypeI p, UserProtocol p) => User -> SProtocolType p -> CM (NonEmpty (ProtocolServer p))
getUserProtocolServers user p = do
cfg <- asks config
L.map (\ServerCfg {server} -> protoServer server) . useServers cfg p <$> withStore' (`getProtocolServers` user)
getNetworkConfig :: CM' NetworkConfig
getNetworkConfig = withAgent' $ liftIO . getNetworkConfig'
src/Simplex/Chat/Stats.hs
+4 -4
View File
@@ -150,7 +150,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
AgentServersSummary {statsStartedAt, smpServersSessions, smpServersSubs, smpServersStats, xftpServersSessions, xftpServersStats, xftpRcvInProgress, xftpSndInProgress, xftpDelInProgress} = agentSummary
countUserInAll auId = countUserInAllStats (AgentUserId auId) currentUser users
accSMPTotals :: Map SMPServer SMPServerSummary -> SMPTotals
accSMPTotals = M.foldr addTotals initialTotals
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} =
@@ -160,7 +160,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
stats = maybe accStats (accStats `addSMPStatsData`) stats
}
accXFTPTotals :: Map XFTPServer XFTPServerSummary -> XFTPTotals
accXFTPTotals = M.foldr addTotals initialTotals
accXFTPTotals = M.foldr' addTotals initialTotals
where
initialTotals = XFTPTotals {sessions = ServerSessions 0 0 0, stats = newAgentXFTPServerStatsData}
addTotals XFTPServerSummary {sessions, stats} XFTPTotals {sessions = accSess, stats = accStats} =
@@ -169,7 +169,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
stats = maybe accStats (accStats `addXFTPStatsData`) stats
}
smpSummsIntoCategories :: Map SMPServer SMPServerSummary -> ([SMPServerSummary], [SMPServerSummary], [SMPServerSummary])
smpSummsIntoCategories = foldr partitionSummary ([], [], [])
smpSummsIntoCategories = M.foldr' partitionSummary ([], [], [])
where
partitionSummary srvSumm (curr, prev, prox)
| isCurrentlyUsed srvSumm = (srvSumm : curr, prev, prox)
@@ -183,7 +183,7 @@ toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrv
Just AgentSMPServerStatsData {_sentDirect, _sentProxied, _sentDirectAttempts, _sentProxiedAttempts, _recvMsgs, _connCreated, _connSecured, _connSubscribed, _connSubAttempts} ->
_sentDirect > 0 || _sentProxied > 0 || _sentDirectAttempts > 0 || _sentProxiedAttempts > 0 || _recvMsgs > 0 || _connCreated > 0 || _connSecured > 0 || _connSubscribed > 0 || _connSubAttempts > 0
xftpSummsIntoCategories :: Map XFTPServer XFTPServerSummary -> ([XFTPServerSummary], [XFTPServerSummary])
xftpSummsIntoCategories = foldr partitionSummary ([], [])
xftpSummsIntoCategories = M.foldr' partitionSummary ([], [])
where
partitionSummary srvSumm (curr, prev)
| isCurrentlyUsed srvSumm = (srvSumm : curr, prev)