core, ios: mark files to receive from NSE, receive marked files on chat start (#2218)

src/Simplex/Chat.hs

@@ -225,7 +225,9 @@ startChatController subConns enableExpireCIs startXFTPWorkers = do
           then Just <$> async (subscribeUsers users)
           else pure Nothing
       atomically . writeTVar s $ Just (a1, a2)
-      when startXFTPWorkers startXFTP
+      when startXFTPWorkers $ do
+        startXFTP
+        void $ forkIO $ startFilesToReceive users
       startCleanupManager
       when enableExpireCIs $ startExpireCIs users
       pure a1
@@ -257,6 +259,22 @@ subscribeUsers users = do
     subscribe :: [User] -> m ()
     subscribe = mapM_ $ runExceptT . subscribeUserConnections Agent.subscribeConnections
 
+startFilesToReceive :: forall m. ChatMonad' m => [User] -> m ()
+startFilesToReceive users = do
+  let (us, us') = partition activeUser users
+  startReceive us
+  startReceive us'
+  where
+    startReceive :: [User] -> m ()
+    startReceive = mapM_ $ runExceptT . startReceiveUserFiles
+
+startReceiveUserFiles :: forall m. ChatMonad m => User -> m ()
+startReceiveUserFiles user = do
+  filesToReceive <- withStore' (`getRcvFilesToReceive` user)
+  forM_ filesToReceive $ \ft ->
+    flip catchError (toView . CRChatError (Just user)) $
+      toView =<< receiveFile' user ft Nothing Nothing
+
 restoreCalls :: ChatMonad' m => m ()
 restoreCalls = do
   savedCalls <- fromRight [] <$> runExceptT (withStore' $ \db -> getCalls db)
@@ -1385,13 +1403,11 @@ processChatCommand = \case
   ReceiveFile fileId rcvInline_ filePath_ -> withUser $ \_ ->
     withChatLock "receiveFile" . procCmd $ do
       (user, ft) <- withStore $ \db -> getRcvFileTransferById db fileId
-      (CRRcvFileAccepted user <$> acceptFileReceive user ft rcvInline_ filePath_) `catchError` processError user ft
-    where
-      processError user ft = \case
-        -- TODO AChatItem in Cancelled events
-        ChatErrorAgent (SMP SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
-        ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
-        e -> throwError e
+      receiveFile' user ft rcvInline_ filePath_
+  SetFileToReceive fileId -> withUser $ \_ -> do
+    withChatLock "setFileToReceive" . procCmd $ do
+      withStore' (`setRcvFileToReceive` fileId)
+      ok_
   CancelFile fileId -> withUser $ \user@User {userId} ->
     withChatLock "cancelFile" . procCmd $
       withStore (\db -> getFileTransfer db user fileId) >>= \case
@@ -1904,6 +1920,16 @@ toFSFilePath :: ChatMonad m => FilePath -> m FilePath
 toFSFilePath f =
   maybe f (</> f) <$> (readTVarIO =<< asks filesFolder)
 
+receiveFile' :: ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m ChatResponse
+receiveFile' user ft rcvInline_ filePath_ = do
+  (CRRcvFileAccepted user <$> acceptFileReceive user ft rcvInline_ filePath_) `catchError` processError
+  where
+    processError = \case
+      -- TODO AChatItem in Cancelled events
+      ChatErrorAgent (SMP SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
+      ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
+      e -> throwError e
+
 acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m AChatItem
 acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
   unless (fileStatus == RFSNew) $ case fileStatus of
@@ -4668,6 +4694,7 @@ chatCommandP =
       ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
       ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
       ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
+      "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal),
       ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
       ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
       "/simplex" $> ConnectSimplex,

src/Simplex/Chat/Controller.hs

@@ -346,6 +346,7 @@ data ChatCommand
   | ForwardImage ChatName FileTransferId
   | SendFileDescription ChatName FilePath
   | ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
+  | SetFileToReceive FileTransferId
   | CancelFile FileTransferId
   | FileStatus FileTransferId
   | ShowProfile -- UserId (not used in UI)

src/Simplex/Chat/Migrations/M20230420_rcv_files_to_receive.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230420_rcv_files_to_receive where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230420_rcv_files_to_receive :: Query
+m20230420_rcv_files_to_receive =
+  [sql|
+ALTER TABLE rcv_files ADD COLUMN to_receive INTEGER;
+|]
+
+down_m20230420_rcv_files_to_receive :: Query
+down_m20230420_rcv_files_to_receive =
+  [sql|
+ALTER TABLE rcv_files DROP COLUMN to_receive;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -229,7 +229,8 @@ CREATE TABLE rcv_files(
   file_descr_id INTEGER NULL
   REFERENCES xftp_file_descriptions ON DELETE SET NULL,
   agent_rcv_file_id BLOB NULL,
-  agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK(agent_rcv_file_deleted NOT NULL)
+  agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK(agent_rcv_file_deleted NOT NULL),
+  to_receive INTEGER
 );
 CREATE TABLE snd_file_chunks(
   file_id INTEGER NOT NULL,

src/Simplex/Chat/Store.hs

@@ -190,6 +190,8 @@ module Simplex.Chat.Store
     acceptRcvInlineFT,
     startRcvInlineFT,
     xftpAcceptRcvFT,
+    setRcvFileToReceive,
+    getRcvFilesToReceive,
     setRcvFTAgentDeleted,
     updateRcvFileStatus,
     createRcvFileChunk,
@@ -302,7 +304,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (addUTCTime)
-import Data.Time.Clock (UTCTime (..), getCurrentTime)
+import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay)
 import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
 import Data.Type.Equality
 import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError, (:.) (..))
@@ -370,6 +372,7 @@ import Simplex.Chat.Migrations.M20230321_agent_file_deleted
 import Simplex.Chat.Migrations.M20230328_files_protocol
 import Simplex.Chat.Migrations.M20230402_protocol_servers
 import Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions
+import Simplex.Chat.Migrations.M20230420_rcv_files_to_receive
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Util (week)
@@ -443,7 +446,8 @@ schemaMigrations =
     ("20230321_agent_file_deleted", m20230321_agent_file_deleted, Just down_m20230321_agent_file_deleted),
     ("20230328_files_protocol", m20230328_files_protocol, Just down_m20230328_files_protocol),
     ("20230402_protocol_servers", m20230402_protocol_servers, Just down_m20230402_protocol_servers),
-    ("20230411_extra_xftp_file_descriptions", m20230411_extra_xftp_file_descriptions, Just down_m20230411_extra_xftp_file_descriptions)
+    ("20230411_extra_xftp_file_descriptions", m20230411_extra_xftp_file_descriptions, Just down_m20230411_extra_xftp_file_descriptions),
+    ("20230420_rcv_files_to_receive", m20230420_rcv_files_to_receive, Just down_m20230420_rcv_files_to_receive)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -3216,6 +3220,31 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
     "UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
     (rcvFileInline, FSAccepted, currentTs, fileId)
 
+setRcvFileToReceive :: DB.Connection -> FileTransferId -> IO ()
+setRcvFileToReceive db fileId = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    "UPDATE rcv_files SET to_receive = 1, updated_at = ? WHERE file_id = ?"
+    (currentTs, fileId)
+
+getRcvFilesToReceive :: DB.Connection -> User -> IO [RcvFileTransfer]
+getRcvFilesToReceive db user@User {userId} = do
+  cutoffTs <- addUTCTime (- (2 * nominalDay)) <$> getCurrentTime
+  fileIds :: [Int64] <-
+    map fromOnly
+      <$> DB.query
+        db
+        [sql|
+          SELECT r.file_id
+          FROM rcv_files r
+          JOIN files f ON f.file_id = r.file_id
+          WHERE f.user_id = ? AND r.file_status = ?
+            AND r.to_receive = 1 AND r.created_at > ?
+        |]
+        (userId, FSNew, cutoffTs)
+  rights <$> mapM (runExceptT . getRcvFileTransfer db user) fileIds
+
 setRcvFTAgentDeleted :: DB.Connection -> FileTransferId -> IO ()
 setRcvFTAgentDeleted db fileId = do
   currentTs <- getCurrentTime