From 061d2c25edbfafdb2deb886b9a33b51e7e425ec2 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Thu, 20 Apr 2023 17:05:02 +0400
Subject: [PATCH] core: clean up file descriptions older than server expiration

---
 src/Simplex/Chat.hs       | 5 ++++-
 src/Simplex/Chat/Store.hs | 8 ++++++++
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 9c7db2e5b9..40950122c6 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -2238,13 +2238,16 @@ cleanupManager = do
       forM_ us' cleanupUser
     liftIO $ threadDelay' $ cleanupManagerInterval * 1000000
   where
-    cleanupUser user =
+    cleanupUser user = do
       cleanupTimedItems user `catchError` (toView . CRChatError (Just user))
+      cleanupFileDescriptions user `catchError` (toView . CRChatError (Just user))
     cleanupTimedItems user = do
       ts <- liftIO getCurrentTime
       let startTimedThreadCutoff = addUTCTime (realToFrac cleanupManagerInterval) ts
       timedItems <- withStore' $ \db -> getTimedItems db user startTimedThreadCutoff
       forM_ timedItems $ uncurry (startTimedItemThread user)
+    cleanupFileDescriptions user =
+      withStore' (`cleanupXFTPFileDescrs` user)
 
 startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
 startProximateTimedItemThread user itemRef deleteAt = do
diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs
index 051a04450f..9f8f4b821a 100644
--- a/src/Simplex/Chat/Store.hs
+++ b/src/Simplex/Chat/Store.hs
@@ -182,6 +182,7 @@ module Simplex.Chat.Store
     createRcvGroupFileTransfer,
     appendRcvFD,
     getRcvFileDescrByFileId,
+    cleanupXFTPFileDescrs,
     updateRcvFileAgentId,
     getRcvFileTransferById,
     getRcvFileTransfer,
@@ -3118,6 +3119,13 @@ getRcvFileDescrByFileId_ db fileId =
     toRcvFileDescr (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 fileId aFileId = do
   currentTs <- getCurrentTime