perf: batch expired file deletions with deleteFiles

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

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))

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)