From a70bd02c678e85c5b3559cdf1bf486d4f3550bee Mon Sep 17 00:00:00 2001 From: Evgeny Date: Tue, 10 Sep 2024 08:14:05 +0100 Subject: [PATCH] xftp server: round down file creation time to 1 hour (#1310) --- src/Simplex/FileTransfer/Server.hs | 9 ++++++--- src/Simplex/FileTransfer/Server/Store.hs | 16 ++++++++++------ src/Simplex/FileTransfer/Server/StoreLog.hs | 6 +++--- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index a5bdd7877..434fcde4d 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -33,7 +33,6 @@ import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime) -import Data.Time.Clock.System (SystemTime (..), getSystemTime) import Data.Time.Format.ISO8601 (iso8601Show) import Data.Word (Word32) import qualified Data.X509 as X @@ -57,6 +56,7 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity) import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization) import Simplex.Messaging.Server.Expiration +import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemTime) import Simplex.Messaging.Server.Stats import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM @@ -399,7 +399,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case r <- runExceptT $ do sizes <- asks $ allowedChunkSizes . config unless (size file `elem` sizes) $ throwE SIZE - ts <- liftIO getSystemTime + ts <- liftIO getFileTime -- TODO validate body empty sId <- ExceptT $ addFileRetry st file 3 ts rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks @@ -412,7 +412,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case let rIds = L.map (\(FileRecipient rId _) -> rId) rcps pure $ FRSndIds sId rIds pure $ either FRErr id r - addFileRetry :: FileStore -> FileInfo -> Int -> SystemTime -> M (Either XFTPErrorType XFTPFileId) + addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId) addFileRetry st file n ts = retryAdd n $ \sId -> runExceptT $ do ExceptT $ addFile st sId file ts @@ -531,6 +531,9 @@ deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1) liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo) +getFileTime :: IO RoundedSystemTime +getFileTime = getRoundedSystemTime fileTimePrecision + expireServerFiles :: Maybe Int -> ExpirationConfig -> M () expireServerFiles itemDelay expCfg = do st <- asks store diff --git a/src/Simplex/FileTransfer/Server/Store.hs b/src/Simplex/FileTransfer/Server/Store.hs index b56b516aa..10c34819f 100644 --- a/src/Simplex/FileTransfer/Server/Store.hs +++ b/src/Simplex/FileTransfer/Server/Store.hs @@ -17,6 +17,7 @@ module Simplex.FileTransfer.Server.Store expiredFilePath, getFile, ackFile, + fileTimePrecision, ) where @@ -25,12 +26,12 @@ import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Int (Int64) import Data.Set (Set) import qualified Data.Set as S -import Data.Time.Clock.System (SystemTime (..)) import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId) import Simplex.FileTransfer.Transport (XFTPErrorType (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId) +import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..)) import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Util (ifM, ($>>=)) @@ -46,9 +47,12 @@ data FileRec = FileRec fileInfo :: FileInfo, filePath :: TVar (Maybe FilePath), recipientIds :: TVar (Set RecipientId), - createdAt :: SystemTime + createdAt :: RoundedSystemTime } +fileTimePrecision :: Int64 +fileTimePrecision = 3600 -- truncate creation time to 1 hour + data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey instance StrEncoding FileRecipient where @@ -62,14 +66,14 @@ newFileStore = do usedStorage <- newTVarIO 0 pure FileStore {files, recipients, usedStorage} -addFile :: FileStore -> SenderId -> FileInfo -> SystemTime -> STM (Either XFTPErrorType ()) +addFile :: FileStore -> SenderId -> FileInfo -> RoundedSystemTime -> STM (Either XFTPErrorType ()) addFile FileStore {files} sId fileInfo createdAt = ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do f <- newFileRec sId fileInfo createdAt TM.insert sId f files pure $ Right () -newFileRec :: SenderId -> FileInfo -> SystemTime -> STM FileRec +newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> STM FileRec newFileRec senderId fileInfo createdAt = do recipientIds <- newTVar S.empty filePath <- newTVar Nothing @@ -120,8 +124,8 @@ getFile st party fId = case party of expiredFilePath :: FileStore -> XFTPFileId -> Int64 -> STM (Maybe (Maybe FilePath)) expiredFilePath FileStore {files} sId old = TM.lookup sId files - $>>= \FileRec {filePath, createdAt} -> - if systemSeconds createdAt < old + $>>= \FileRec {filePath, createdAt = RoundedSystemTime createdAt} -> + if createdAt + fileTimePrecision < old then Just <$> readTVar filePath else pure Nothing diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs index 8e8add3d6..9d3919c2c 100644 --- a/src/Simplex/FileTransfer/Server/StoreLog.hs +++ b/src/Simplex/FileTransfer/Server/StoreLog.hs @@ -28,18 +28,18 @@ 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 import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId) +import Simplex.Messaging.Server.QueueStore (RoundedSystemTime) import Simplex.Messaging.Server.StoreLog import Simplex.Messaging.Util (bshow, whenM) import System.Directory (doesFileExist, renameFile) import System.IO data FileStoreLogRecord - = AddFile SenderId FileInfo SystemTime + = AddFile SenderId FileInfo RoundedSystemTime | PutFile SenderId FilePath | AddRecipients SenderId (NonEmpty FileRecipient) | DeleteFile SenderId @@ -64,7 +64,7 @@ instance StrEncoding FileStoreLogRecord where logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO () logFileStoreRecord = writeStoreLogRecord -logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> SystemTime -> IO () +logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> RoundedSystemTime -> IO () logAddFile s = logFileStoreRecord s .:. AddFile logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()