mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-31 14:06:07 +00:00
bccef0ba47
* Files: main, env, stats, storeLog * Better + transport * Executable * Env * Update Client.hs, Server.hs, and 4 more files... * Answer on request * Delay * Temp file * Bypass cert check * update package.yml, rename * update store log * extend HTTP2 transport * refactor caStore * HTTP2 body * update server stats * file server/client framework * verify server commands * process FNEW command, CLI test works * simple XFTP server test (fails) * fix test, refactor * upload chunk works * receive file chunk in the client * remove transport handshake * typo Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * fix names --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
94 lines
4.0 KiB
Haskell
94 lines
4.0 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Simplex.FileTransfer.Server.Stats where
|
|
|
|
import qualified Data.Attoparsec.ByteString.Char8 as A
|
|
import qualified Data.ByteString.Char8 as B
|
|
import Data.Time.Clock (UTCTime)
|
|
import Simplex.Messaging.Encoding.String
|
|
import Simplex.Messaging.Protocol (SenderId)
|
|
import Simplex.Messaging.Server.Stats (PeriodStats, PeriodStatsData, getPeriodStatsData, newPeriodStats, setPeriodStats)
|
|
import UnliftIO.STM
|
|
|
|
data FileServerStats = FileServerStats
|
|
{ fromTime :: TVar UTCTime,
|
|
filesCreated :: TVar Int,
|
|
fileRecipients :: TVar Int,
|
|
filesUploaded :: TVar Int,
|
|
filesDeleted :: TVar Int,
|
|
filesDownloaded :: PeriodStats SenderId,
|
|
fileDownloads :: TVar Int,
|
|
fileDownloadAcks :: TVar Int
|
|
}
|
|
|
|
data FileServerStatsData = FileServerStatsData
|
|
{ _fromTime :: UTCTime,
|
|
_filesCreated :: Int,
|
|
_fileRecipients :: Int,
|
|
_filesUploaded :: Int,
|
|
_filesDeleted :: Int,
|
|
_filesDownloaded :: PeriodStatsData SenderId,
|
|
_fileDownloads :: Int,
|
|
_fileDownloadAcks :: Int
|
|
}
|
|
|
|
newFileServerStats :: UTCTime -> STM FileServerStats
|
|
newFileServerStats ts = do
|
|
fromTime <- newTVar ts
|
|
filesCreated <- newTVar 0
|
|
fileRecipients <- newTVar 0
|
|
filesUploaded <- newTVar 0
|
|
filesDeleted <- newTVar 0
|
|
filesDownloaded <- newPeriodStats
|
|
fileDownloads <- newTVar 0
|
|
fileDownloadAcks <- newTVar 0
|
|
pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks}
|
|
|
|
getFileServerStatsData :: FileServerStats -> STM FileServerStatsData
|
|
getFileServerStatsData s = do
|
|
_fromTime <- readTVar $ fromTime (s :: FileServerStats)
|
|
_filesCreated <- readTVar $ filesCreated s
|
|
_fileRecipients <- readTVar $ fileRecipients s
|
|
_filesUploaded <- readTVar $ filesUploaded s
|
|
_filesDeleted <- readTVar $ filesDeleted s
|
|
_filesDownloaded <- getPeriodStatsData $ filesDownloaded s
|
|
_fileDownloads <- readTVar $ fileDownloads s
|
|
_fileDownloadAcks <- readTVar $ fileDownloadAcks s
|
|
pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks}
|
|
|
|
setFileServerStats :: FileServerStats -> FileServerStatsData -> STM ()
|
|
setFileServerStats s d = do
|
|
writeTVar (fromTime (s :: FileServerStats)) $! _fromTime (d :: FileServerStatsData)
|
|
writeTVar (filesCreated s) $! _filesCreated d
|
|
writeTVar (fileRecipients s) $! _fileRecipients d
|
|
writeTVar (filesUploaded s) $! _filesUploaded d
|
|
writeTVar (filesDeleted s) $! _filesDeleted d
|
|
setPeriodStats (filesDownloaded s) $! _filesDownloaded d
|
|
writeTVar (fileDownloads s) $! _fileDownloads d
|
|
writeTVar (fileDownloadAcks s) $! _fileDownloadAcks d
|
|
|
|
instance StrEncoding FileServerStatsData where
|
|
strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks} =
|
|
B.unlines
|
|
[ "fromTime=" <> strEncode _fromTime,
|
|
"filesCreated=" <> strEncode _filesCreated,
|
|
"fileRecipients=" <> strEncode _fileRecipients,
|
|
"filesUploaded=" <> strEncode _filesUploaded,
|
|
"filesDeleted=" <> strEncode _filesDeleted,
|
|
"filesDownloaded=" <> strEncode _filesDownloaded,
|
|
"fileDownloads=" <> strEncode _fileDownloads,
|
|
"fileDownloadAcks=" <> strEncode _fileDownloadAcks
|
|
]
|
|
strP = do
|
|
_fromTime <- "fromTime=" *> strP <* A.endOfLine
|
|
_filesCreated <- "filesCreated=" *> strP <* A.endOfLine
|
|
_fileRecipients <- "fileRecipients=" *> strP <* A.endOfLine
|
|
_filesUploaded <- "filesUploaded=" *> strP <* A.endOfLine
|
|
_filesDeleted <- "filesDeleted=" *> strP <* A.endOfLine
|
|
_filesDownloaded <- "filesDownloaded=" *> strP <* A.endOfLine
|
|
_fileDownloads <- "fileDownloads=" *> strP <* A.endOfLine
|
|
_fileDownloadAcks <- "fileDownloadAcks=" *> strP <* A.endOfLine
|
|
pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks}
|