Compare commits

...

1 Commits

Author SHA1 Message Date
spaced4ndy
061d2c25ed core: clean up file descriptions older than server expiration 2023-04-20 17:05:02 +04:00
2 changed files with 12 additions and 1 deletions

View File

@@ -2238,13 +2238,16 @@ cleanupManager = do
forM_ us' cleanupUser forM_ us' cleanupUser
liftIO $ threadDelay' $ cleanupManagerInterval * 1000000 liftIO $ threadDelay' $ cleanupManagerInterval * 1000000
where where
cleanupUser user = cleanupUser user = do
cleanupTimedItems user `catchError` (toView . CRChatError (Just user)) cleanupTimedItems user `catchError` (toView . CRChatError (Just user))
cleanupFileDescriptions user `catchError` (toView . CRChatError (Just user))
cleanupTimedItems user = do cleanupTimedItems user = do
ts <- liftIO getCurrentTime ts <- liftIO getCurrentTime
let startTimedThreadCutoff = addUTCTime (realToFrac cleanupManagerInterval) ts let startTimedThreadCutoff = addUTCTime (realToFrac cleanupManagerInterval) ts
timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff
forM_ timedItems $ uncurry (startTimedItemThread user) forM_ timedItems $ uncurry (startTimedItemThread user)
cleanupFileDescriptions user =
withStore' (`cleanupXFTPFileDescrs` user)
startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m () startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
startProximateTimedItemThread user itemRef deleteAt = do startProximateTimedItemThread user itemRef deleteAt = do

View File

@@ -182,6 +182,7 @@ module Simplex.Chat.Store
createRcvGroupFileTransfer, createRcvGroupFileTransfer,
appendRcvFD, appendRcvFD,
getRcvFileDescrByFileId, getRcvFileDescrByFileId,
cleanupXFTPFileDescrs,
updateRcvFileAgentId, updateRcvFileAgentId,
getRcvFileTransferById, getRcvFileTransferById,
getRcvFileTransfer, getRcvFileTransfer,
@@ -3118,6 +3119,13 @@ getRcvFileDescrByFileId_ db fileId =
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) = toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete} RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
cleanupXFTPFileDescrs :: DB.Connection -> User -> IO ()
cleanupXFTPFileDescrs db User {userId} = do
cutoffTs <- addUTCTime (- (2 * nominalDay)) <$> getCurrentTime
-- TODO delete
DB.execute db "UPDATE xftp_file_descriptions SET file_descr_text = '' WHERE user_id = ? AND created_at <= ?" (userId, cutoffTs)
DB.execute db "DELETE FROM extra_xftp_file_descriptions WHERE user_id = ? AND created_at <= ?" (userId, cutoffTs)
updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO () updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO ()
updateRcvFileAgentId db fileId aFileId = do updateRcvFileAgentId db fileId aFileId = do
currentTs <- getCurrentTime currentTs <- getCurrentTime