dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-06-09 10:42:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

xftp: expire files on the server, track/limit used storage (#651)

Browse Source 
* xftp: expire files on the server

* track/limit used storage

* support storage quota and disabling queue creation in CLI parameters

* fix ini file

* correction

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2023-02-24 07:09:51 +00:00
committed by GitHub
parent 4ce4fa3423
commit 3ab5e9d110
10 changed files with 214 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/FileTransfer/Server/StoreLog.hs
+10 -9
View File
@@ -22,11 +22,12 @@ import Control.Concurrent.STM
import Control.Monad.Except
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import Data.Composition ((.:))
import Data.Composition ((.:), (.:.))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Time.Clock.System (SystemTime)
import Simplex.FileTransfer.Protocol (FileInfo (..))
import Simplex.FileTransfer.Server.Store
import Simplex.Messaging.Encoding.String
@@ -37,7 +38,7 @@ import System.Directory (doesFileExist, renameFile)
import System.IO
data FileStoreLogRecord
= AddFile SenderId FileInfo
= AddFile SenderId FileInfo SystemTime
| PutFile SenderId FilePath
| AddRecipients SenderId (NonEmpty (RecipientId, RcvPublicVerifyKey))
| DeleteFile SenderId
@@ -45,14 +46,14 @@ data FileStoreLogRecord
instance StrEncoding FileStoreLogRecord where
strEncode = \case
AddFile sId file -> strEncode (Str "FNEW", sId, file)
AddFile sId file createdAt -> strEncode (Str "FNEW", sId, file, createdAt)
PutFile sId path -> strEncode (Str "FPUT", sId, path)
AddRecipients sId rcps -> strEncode (Str "FADD", sId, rcps)
DeleteFile sId -> strEncode (Str "FDEL", sId)
AckFile rId -> strEncode (Str "FACK", rId)
strP =
A.choice
[ "FNEW " *> (AddFile <$> strP_ <*> strP),
[ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP),
"FPUT " *> (PutFile <$> strP_ <*> strP),
"FADD " *> (AddRecipients <$> strP_ <*> strP),
"FDEL " *> (DeleteFile <$> strP),
@@ -62,8 +63,8 @@ instance StrEncoding FileStoreLogRecord where
logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
logFileStoreRecord = writeStoreLogRecord
logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> IO ()
logAddFile s = logFileStoreRecord s .: AddFile
logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> SystemTime -> IO ()
logAddFile s = logFileStoreRecord s .:. AddFile
logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()
logPutFile s = logFileStoreRecord s .: PutFile
@@ -96,7 +97,7 @@ readFileStore f st = mapM_ addFileLogRecord . B.lines =<< B.readFile f
Left e -> B.putStrLn $ "Log processing error (" <> bshow e <> "): " <> B.take 100 s
_ -> pure ()
addToStore = \case
AddFile sId file -> addFile st sId file
AddFile sId file createdAt -> addFile st sId file createdAt
PutFile qId path -> setFilePath st qId path
AddRecipients sId rcps -> runExceptT $ addRecipients sId rcps
DeleteFile sId -> deleteFile st sId
@@ -109,8 +110,8 @@ writeFileStore s FileStore {files, recipients} = do
readTVarIO files >>= mapM_ (logFile allRcps)
where
logFile :: Map RecipientId (SenderId, RcvPublicVerifyKey) -> FileRec -> IO ()
logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds} = do
logAddFile s senderId fileInfo
logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt} = do
logAddFile s senderId fileInfo createdAt
(rcpErrs, rcps) <- M.mapEither getRcp . M.fromSet id <$> readTVarIO recipientIds
mapM_ (logAddRecipients s senderId) $ L.nonEmpty $ M.elems rcps
mapM_ (B.putStrLn . ("Error storing log: " <>)) rcpErrs