From 90dffc975a8f62f0cfe40d97eca0385de9c719ff Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 12 Apr 2023 14:47:54 +0400 Subject: [PATCH] core: request and save extra recipient file descriptions (#2170) --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 17 ++++++--- .../M20230411_extra_xftp_file_descriptions.hs | 35 +++++++++++++++++++ src/Simplex/Chat/Migrations/chat_schema.sql | 17 +++++++++ src/Simplex/Chat/Store.hs | 19 ++++++++-- tests/ChatTests/Files.hs | 12 +++++++ 6 files changed, 94 insertions(+), 7 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20230411_extra_xftp_file_descriptions.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index a9ddadfe5..ba9f3af5f 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -90,6 +90,7 @@ library Simplex.Chat.Migrations.M20230321_agent_file_deleted Simplex.Chat.Migrations.M20230328_files_protocol Simplex.Chat.Migrations.M20230402_protocol_servers + Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions Simplex.Chat.Mobile Simplex.Chat.Mobile.WebRTC Simplex.Chat.Options diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 727926dcf..7b549c2a8 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -589,7 +589,7 @@ processChatCommand = \case fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} fInv = xftpFileInvitation fileName fileSize fileDescr fsFilePath <- toFSFilePath file - aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) fsFilePath n + aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) fsFilePath (roundedFDCount n) -- TODO CRSndFileStart event for XFTP chSize <- asks $ fileChunkSize . config ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv (AgentSndFileId aFileId) chSize @@ -1773,6 +1773,9 @@ assertDirectAllowed user dir ct event = XCallInv_ -> False _ -> True +roundedFDCount :: Int -> Int +roundedFDCount n = max 4 $ fromIntegral $ (2 :: Integer) ^ (ceiling (logBase 2 (fromIntegral n) :: Double) :: Integer) + startExpireCIThread :: forall m. ChatMonad' m => User -> m () startExpireCIThread user@User {userId} = do expireThreads <- asks expireCIThreads @@ -2334,6 +2337,7 @@ processAgentMsgSndFile _corrId aFileId msg = toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal SFDONE _sndDescr rfds -> unless cancelled $ do + -- TODO save sender file description ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <- withStore $ \db -> getChatItemByFileId db user fileId case (msgId_, itemDeleted) of @@ -2342,12 +2346,16 @@ processAgentMsgSndFile _corrId aFileId msg = -- TODO either update database status or move to SFPROG toView $ CRSndFileProgressXFTP user ci ft 1 1 case (rfds, sfts, d, cInfo) of - (rfd : _, sft : _, SMDSnd, DirectChat ct) -> do + (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do + withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do ms <- withStore' $ \db -> getGroupMembers db user g - forM_ (zip rfds $ memberFTs ms) $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user)) + let rfdsMemberFTs = zip rfds $ memberFTs ms + extraRFDs = drop (length rfdsMemberFTs) rfds + withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) + forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user)) ci' <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId CIFSSndComplete getChatItemByFileId db user fileId @@ -2373,9 +2381,10 @@ processAgentMsgSndFile _corrId aFileId msg = -- agentXFTPDeleteSndFile throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e where + fileDescrText = safeDecodeUtf8 . strEncode sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64 sendFileDescription sft rfd msgId sendMsg = do - let rfdText = safeDecodeUtf8 $ strEncode rfd + let rfdText = fileDescrText rfd withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText partSize <- asks $ xftpDescrPartSize . config sendParts 1 partSize rfdText diff --git a/src/Simplex/Chat/Migrations/M20230411_extra_xftp_file_descriptions.hs b/src/Simplex/Chat/Migrations/M20230411_extra_xftp_file_descriptions.hs new file mode 100644 index 000000000..9bfd773c4 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230411_extra_xftp_file_descriptions.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230411_extra_xftp_file_descriptions where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230411_extra_xftp_file_descriptions :: Query +m20230411_extra_xftp_file_descriptions = + [sql| +CREATE TABLE extra_xftp_file_descriptions ( + extra_file_descr_id INTEGER PRIMARY KEY, + file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + file_descr_text TEXT NOT NULL, + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')) +); + +CREATE INDEX idx_extra_xftp_file_descriptions_file_id ON extra_xftp_file_descriptions(file_id); +CREATE INDEX idx_extra_xftp_file_descriptions_user_id ON extra_xftp_file_descriptions(user_id); + +CREATE INDEX idx_xftp_file_descriptions_user_id ON xftp_file_descriptions(user_id); +|] + +down_m20230411_extra_xftp_file_descriptions :: Query +down_m20230411_extra_xftp_file_descriptions = + [sql| +DROP INDEX idx_xftp_file_descriptions_user_id; + +DROP INDEX idx_extra_xftp_file_descriptions_user_id; +DROP INDEX idx_extra_xftp_file_descriptions_file_id; + +DROP TABLE extra_xftp_file_descriptions; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 08e07bed2..fa4211fff 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -577,3 +577,20 @@ CREATE TABLE xftp_file_descriptions( ); CREATE INDEX idx_snd_files_file_descr_id ON snd_files(file_descr_id); CREATE INDEX idx_rcv_files_file_descr_id ON rcv_files(file_descr_id); +CREATE TABLE extra_xftp_file_descriptions( + extra_file_descr_id INTEGER PRIMARY KEY, + file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + file_descr_text TEXT NOT NULL, + created_at TEXT NOT NULL DEFAULT(datetime('now')), + updated_at TEXT NOT NULL DEFAULT(datetime('now')) +); +CREATE INDEX idx_extra_xftp_file_descriptions_file_id ON extra_xftp_file_descriptions( + file_id +); +CREATE INDEX idx_extra_xftp_file_descriptions_user_id ON extra_xftp_file_descriptions( + user_id +); +CREATE INDEX idx_xftp_file_descriptions_user_id ON xftp_file_descriptions( + user_id +); diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index b2f277811..877f8644b 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -160,6 +160,7 @@ module Simplex.Chat.Store createSndFileTransferXFTP, createSndFTDescrXFTP, updateSndFTDescrXFTP, + createExtraSndFTDescrs, updateSndFTDeliveryXFTP, getXFTPSndFileDBId, getXFTPRcvFileDBId, @@ -364,6 +365,7 @@ import Simplex.Chat.Migrations.M20230318_file_description 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.Protocol import Simplex.Chat.Types import Simplex.Chat.Util (week) @@ -436,7 +438,8 @@ schemaMigrations = ("20230318_file_description", m20230318_file_description, Just down_m20230318_file_description), ("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) + ("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) ] -- | The list of migrations in ascending order by date @@ -2810,17 +2813,27 @@ createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fi updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO () updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do + currentTs <- getCurrentTime DB.execute db [sql| UPDATE xftp_file_descriptions - SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ? + SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?, updated_at = ? WHERE user_id = ? AND file_descr_id = ? |] - (rfdText, 1 :: Int, True, userId, fileDescrId) + (rfdText, 1 :: Int, True, currentTs, userId, fileDescrId) updateCIFileStatus db user fileId $ CIFSSndTransfer 1 1 updateSndFileStatus db sft FSConnected +createExtraSndFTDescrs :: DB.Connection -> User -> FileTransferId -> [Text] -> IO () +createExtraSndFTDescrs db User {userId} fileId rfdTexts = do + currentTs <- getCurrentTime + forM_ rfdTexts $ \rfdText -> + DB.execute + db + "INSERT INTO extra_xftp_file_descriptions (file_id, user_id, file_descr_text, created_at, updated_at) VALUES (?,?,?,?,?)" + (fileId, userId, rfdText, currentTs, currentTs) + updateSndFTDeliveryXFTP :: DB.Connection -> SndFileTransfer -> Int64 -> IO () updateSndFTDeliveryXFTP db SndFileTransfer {connId, fileId, fileDescrId} msgDeliveryId = DB.execute diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 53bc0c0c8..167c577f4 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -8,6 +8,7 @@ import ChatTests.Utils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) import qualified Data.ByteString.Char8 as B +import Simplex.Chat (roundedFDCount) import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Options (ChatOpts (..)) import Simplex.FileTransfer.Client.Main (xftpClientCLI) @@ -54,6 +55,7 @@ chatFileTests = do it "v1" testAsyncFileTransferV1 xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer describe "file transfer over XFTP" $ do + it "round file description count" $ const testXFTPRoundFDCount it "send and receive file" testXFTPFileTransfer it "send and receive file, accepting after upload" testXFTPAcceptAfterUpload it "send and receive file in group" testXFTPGroupFileTransfer @@ -960,6 +962,16 @@ testAsyncGroupFileTransfer tmp = do dest2 <- B.readFile "./tests/tmp/test_1.jpg" dest2 `shouldBe` src +testXFTPRoundFDCount :: Expectation +testXFTPRoundFDCount = do + roundedFDCount 1 `shouldBe` 4 + roundedFDCount 2 `shouldBe` 4 + roundedFDCount 4 `shouldBe` 4 + roundedFDCount 5 `shouldBe` 8 + roundedFDCount 20 `shouldBe` 32 + roundedFDCount 128 `shouldBe` 128 + roundedFDCount 500 `shouldBe` 512 + testXFTPFileTransfer :: HasCallStack => FilePath -> IO () testXFTPFileTransfer = testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do