@@ -63,6 +63,7 @@ import Simplex.Messaging.Agent.Client
6363import Simplex.Messaging.Agent.Env.SQLite
6464import Simplex.Messaging.Agent.Protocol
6565import Simplex.Messaging.Agent.RetryInterval
66+ import Simplex.Messaging.Agent.Stats
6667import Simplex.Messaging.Agent.Store.SQLite
6768import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
6869import 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
669684delWorkerInternalError :: AgentClient -> Int64 -> AgentErrorType -> AM ()
670685delWorkerInternalError c deletedSndChunkReplicaId e = do
0 commit comments