IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: request and save extra recipient file descriptions (#2170)

Browse Source
This commit is contained in:
spaced4ndy 2023-04-12 14:47:54 +04:00 committed by GitHub
parent e5ba7caddc
commit 90dffc975a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 94 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
simplex-chat.cabal
View File

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

17
src/Simplex/Chat.hs
View File

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

35
src/Simplex/Chat/Migrations/M20230411_extra_xftp_file_descriptions.hs Normal file
View File

@ -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;
|]

17
src/Simplex/Chat/Migrations/chat_schema.sql
View File

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

19
src/Simplex/Chat/Store.hs
View File

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

12
tests/ChatTests/Files.hs
View File

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