Skip to content

Commit c788692

Browse files
agent: servers summary types, api (#1202)
* agent: servers summary types, api [wip] * encoding * export * Revert "export" This reverts commit cd9f315. * comment * rename * simplify types * uncomment * comment * rework * comment, exports * save, restore stats wip * remove * rename * save stats periodically * sigint, sigterm experiments * corrections * remove some proxy stats * increase stat * proposed stats * fields * Revert "sigint, sigterm experiments" This reverts commit f876fbd. * wip * retries -> attempts * errs * fix * other errs * more stat tracking * sub stats * remove xftp successes stats * xftp stats tracking * revert * revert * refactor * remove imports * comment * Revert "refactor" This reverts commit 26c368d. * Revert "revert" This reverts commit 4c9e375. * Revert "revert" This reverts commit 6f65644. * todos * persistence * rename, fix * config * comment * add started at to summary * delete stats on user deletion * reset api * move * getAgentServersSummary collect state logic * corrections * corrections * remove * rework * decrease contention * update * more stats * count sentProxied * count subs * remove unused * comment * remove comment * comment * export * refactor * cleanup * intervals * refactor * refactor2 * refactor3 * refactor4 --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
1 parent 9e7e0d1 commit c788692

File tree

12 files changed

+698
-59
lines changed

12 files changed

+698
-59
lines changed

simplexmq.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,7 @@ library
9595
Simplex.Messaging.Agent.Protocol
9696
Simplex.Messaging.Agent.QueryString
9797
Simplex.Messaging.Agent.RetryInterval
98+
Simplex.Messaging.Agent.Stats
9899
Simplex.Messaging.Agent.Store
99100
Simplex.Messaging.Agent.Store.SQLite
100101
Simplex.Messaging.Agent.Store.SQLite.Common
@@ -132,6 +133,7 @@ library
132133
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
133134
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
134135
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
136+
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240518_servers_stats
135137
Simplex.Messaging.Agent.TRcvQueues
136138
Simplex.Messaging.Client
137139
Simplex.Messaging.Client.Agent

src/Simplex/FileTransfer/Agent.hs

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ import Simplex.Messaging.Agent.Client
6363
import Simplex.Messaging.Agent.Env.SQLite
6464
import Simplex.Messaging.Agent.Protocol
6565
import Simplex.Messaging.Agent.RetryInterval
66+
import Simplex.Messaging.Agent.Stats
6667
import Simplex.Messaging.Agent.Store.SQLite
6768
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
6869
import qualified Simplex.Messaging.Crypto as C
@@ -184,6 +185,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
184185
let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
185186
withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
186187
liftIO $ waitForUserNetwork c
188+
atomically $ incXFTPServerStat c userId srv downloadAttempts
187189
downloadFileChunk fc replica approvedRelays
188190
`catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
189191
where
@@ -194,7 +196,11 @@ runXFTPRcvWorker c srv Worker {doWork} = do
194196
withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
195197
atomically $ assertAgentForeground c
196198
loop
197-
retryDone = rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath)
199+
retryDone e = do
200+
atomically . incXFTPServerStat c userId srv $ case e of
201+
XFTP _ XFTP.AUTH -> downloadAuthErrs
202+
_ -> downloadErrs
203+
rcvWorkerInternalError c rcvFileId rcvFileEntityId (Just fileTmpPath) e
198204
downloadFileChunk :: RcvFileChunk -> RcvFileChunkReplica -> Bool -> AM ()
199205
downloadFileChunk RcvFileChunk {userId, rcvFileId, rcvFileEntityId, rcvChunkId, chunkNo, chunkSize, digest, fileTmpPath} replica approvedRelays = do
200206
unlessM ((approvedRelays ||) <$> ipAddressProtected') $ throwE $ FILE NOT_APPROVED
@@ -214,6 +220,7 @@ runXFTPRcvWorker c srv Worker {doWork} = do
214220
Just RcvFileRedirect {redirectFileInfo = RedirectFileInfo {size = FileSize finalSize}, redirectEntityId} -> (redirectEntityId, finalSize)
215221
liftIO . when complete $ updateRcvFileStatus db rcvFileId RFSReceived
216222
pure (entityId, complete, RFPROG rcvd total)
223+
atomically $ incXFTPServerStat c userId srv downloads
217224
notify c entityId progress
218225
when complete . lift . void $
219226
getXFTPRcvWorker True c Nothing
@@ -484,6 +491,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
484491
let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
485492
withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
486493
liftIO $ waitForUserNetwork c
494+
atomically $ incXFTPServerStat c userId srv uploadAttempts
487495
uploadFileChunk cfg fc replica
488496
`catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
489497
where
@@ -494,7 +502,9 @@ runXFTPSndWorker c srv Worker {doWork} = do
494502
withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
495503
atomically $ assertAgentForeground c
496504
loop
497-
retryDone = sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath)
505+
retryDone e = do
506+
atomically $ incXFTPServerStat c userId srv uploadErrs
507+
sndWorkerInternalError c sndFileId sndFileEntityId (Just filePrefixPath) e
498508
uploadFileChunk :: AgentConfig -> SndFileChunk -> SndFileChunkReplica -> AM ()
499509
uploadFileChunk AgentConfig {xftpMaxRecipientsPerRequest = maxRecipients} sndFileChunk@SndFileChunk {sndFileId, userId, chunkSpec = chunkSpec@XFTPChunkSpec {filePath}, digest = chunkDigest} replica = do
500510
replica'@SndFileChunkReplica {sndChunkReplicaId} <- addRecipients sndFileChunk replica
@@ -510,6 +520,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
510520
let uploaded = uploadedSize chunks
511521
total = totalSize chunks
512522
complete = all chunkUploaded chunks
523+
atomically $ incXFTPServerStat c userId srv uploads
513524
notify c sndFileEntityId $ SFPROG uploaded total
514525
when complete $ do
515526
(sndDescr, rcvDescrs) <- sndFileToDescrs sf
@@ -651,6 +662,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
651662
let ri' = maybe ri (\d -> ri {initialInterval = d, increaseAfter = 0}) delay
652663
withRetryIntervalLimit xftpConsecutiveRetries ri' $ \delay' loop -> do
653664
liftIO $ waitForUserNetwork c
665+
atomically $ incXFTPServerStat c userId srv deleteAttempts
654666
deleteChunkReplica
655667
`catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
656668
where
@@ -661,10 +673,13 @@ runXFTPDelWorker c srv Worker {doWork} = do
661673
withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
662674
atomically $ assertAgentForeground c
663675
loop
664-
retryDone = delWorkerInternalError c deletedSndChunkReplicaId
676+
retryDone e = do
677+
atomically $ incXFTPServerStat c userId srv deleteErrs
678+
delWorkerInternalError c deletedSndChunkReplicaId e
665679
deleteChunkReplica = do
666680
agentXFTPDeleteChunk c userId replica
667681
withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
682+
atomically $ incXFTPServerStat c userId srv deletions
668683

669684
delWorkerInternalError :: AgentClient -> Int64 -> AgentErrorType -> AM ()
670685
delWorkerInternalError c deletedSndChunkReplicaId e = do

0 commit comments

Comments
 (0)