diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index 91f917f76..d7a3c70ad 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -663,14 +663,14 @@ expireServerFiles itemDelay expCfg = do forM_ filePath_ $ \fp -> whenM (doesFileExist fp) $ removeFile fp `catch` \(e :: SomeException) -> logError $ "failed to remove expired file " <> tshow fp <> ": " <> tshow e - withFileLog (`logDeleteFile` sId) - liftIO (deleteFile st sId) >>= \case - Right () -> do - forM_ filePath_ $ \_ -> - atomically $ modifyTVar' us $ subtract (fromIntegral fileSize) - incFileStat filesExpired - Left _ -> pure () - unless (null expired) $ expireLoop st us old + forM_ filePath_ $ \_ -> + atomically $ modifyTVar' us $ subtract (fromIntegral fileSize) + incFileStat filesExpired + let sIds = map (\(sId, _, _) -> sId) expired + unless (null sIds) $ do + withFileLog $ \sl -> mapM_ (logDeleteFile sl) sIds + liftIO $ deleteFiles st sIds + expireLoop st us old randomId :: Int -> M s ByteString randomId n = atomically . C.randomBytes n =<< asks random diff --git a/src/Simplex/FileTransfer/Server/Store.hs b/src/Simplex/FileTransfer/Server/Store.hs index 4641e24f9..6b115ff20 100644 --- a/src/Simplex/FileTransfer/Server/Store.hs +++ b/src/Simplex/FileTransfer/Server/Store.hs @@ -17,7 +17,7 @@ module Simplex.FileTransfer.Server.Store where import Control.Concurrent.STM -import Control.Monad (forM) +import Control.Monad (forM, void) import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Int (Int64) import qualified Data.Map.Strict as M @@ -67,6 +67,8 @@ class FileStoreClass s where setFilePath :: s -> SenderId -> FilePath -> IO (Either XFTPErrorType ()) addRecipient :: s -> SenderId -> FileRecipient -> IO (Either XFTPErrorType ()) deleteFile :: s -> SenderId -> IO (Either XFTPErrorType ()) + deleteFiles :: s -> [SenderId] -> IO () + deleteFiles s = mapM_ (void . deleteFile s) blockFile :: s -> SenderId -> BlockingInfo -> Bool -> IO (Either XFTPErrorType ()) deleteRecipient :: s -> RecipientId -> FileRec -> IO () getFile :: s -> SFileParty p -> XFTPFileId -> IO (Either XFTPErrorType (FileRec, C.APublicAuthKey)) diff --git a/src/Simplex/FileTransfer/Server/Store/Postgres.hs b/src/Simplex/FileTransfer/Server/Store/Postgres.hs index aad3523ee..77a4bc053 100644 --- a/src/Simplex/FileTransfer/Server/Store/Postgres.hs +++ b/src/Simplex/FileTransfer/Server/Store/Postgres.hs @@ -33,7 +33,7 @@ import qualified Data.Map.Strict as M import qualified Data.Set as S import Data.Text (Text) import Data.Word (Word32) -import Database.PostgreSQL.Simple (Binary (..), Only (..), SqlError, (:.) (..)) +import Database.PostgreSQL.Simple (Binary (..), In (..), Only (..), SqlError, (:.) (..)) import qualified Database.PostgreSQL.Simple as DB import qualified Database.PostgreSQL.Simple.Copy as DB import Database.PostgreSQL.Simple.Errors (ConstraintViolation (..), constraintViolation) @@ -115,6 +115,11 @@ instance FileStoreClass PostgresFileStore where DB.execute db "DELETE FROM files WHERE sender_id = ?" (Only sId) withLog "deleteFile" st $ \s -> logDeleteFile s sId + deleteFiles st sIds = E.uninterruptibleMask_ $ do + withTransaction (dbStore st) $ \db -> + DB.execute db "DELETE FROM files WHERE sender_id IN ?" (Only (In sIds)) + withLog "deleteFiles" st $ \s -> mapM_ (logDeleteFile s) sIds + blockFile st sId info _deleted = E.uninterruptibleMask_ $ runExceptT $ do assertUpdated $ withDB' "blockFile" st $ \db -> DB.execute db "UPDATE files SET status = ? WHERE sender_id = ?" (EntityBlocked info, sId)