From d28f02c383f13c38967d5c2f9f20d00bcf96aaec Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Mon, 25 Dec 2023 18:55:53 +0200 Subject: [PATCH] replace FTLocal with createLocalFile --- src/Simplex/Chat.hs | 30 ++++++++++------------- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Store/Files.hs | 42 +++++++++++++++++++++------------ src/Simplex/Chat/Types.hs | 2 -- src/Simplex/Chat/View.hs | 5 +++- tests/ChatTests/Local.hs | 2 +- 6 files changed, 45 insertions(+), 38 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index bb9b106789..361c098b9a 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -794,22 +794,15 @@ processChatCommand' vr = \case forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported" nf <- withStore $ \db -> getNoteFolder db user folderId -- TODO: assertLocalAllowed user MDSnd nf XMsgNew_ - ci'@ChatItem {meta = CIMeta{itemId, itemTs}} <- createInternalChatItem_ user (CDLocalSnd nf) (CISndMsgContent mc) Nothing - ciFile_ <- forM file_ $ localFile user nf itemId itemTs + ci'@ChatItem {meta = CIMeta {itemId, itemTs}} <- createInternalChatItem_ user (CDLocalSnd nf) (CISndMsgContent mc) Nothing + ciFile_ <- forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do + fsFilePath <- toFSFilePath filePath -- XXX: only used for size?.. + fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs + withStore' $ \db -> do + fileId <- createLocalFile CIFSSndComplete db user nf itemId itemTs cf fileSize + pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndComplete, fileProtocol = FPLocal} let ci = (ci' :: ChatItem 'CTLocal 'MDSnd) {file = ciFile_} pure . CRNewChatItem user $ AChatItem SCTLocal SMDSnd (LocalChat nf) ci - where - localFile user nf chatItemId createdAt (CryptoFile file cfArgs) = do - fsFilePath <- toFSFilePath file - fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs - let fileName = takeFileName file - fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing} - chSize <- asks $ fileChunkSize . config - withStore $ \db -> do - FileTransferMeta {fileId} <- liftIO $ createSndLocalFileTransfer db user nf file fileInvitation chSize - liftIO $ updateFileTransferChatItemId db fileId chatItemId createdAt - let fileSource = Just $ CF.plain file - pure CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndComplete, fileProtocol = FPLocal} APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of CTDirect -> do ct@Contact {contactId} <- withStore $ \db -> getContact db user chatId @@ -1959,14 +1952,15 @@ processChatCommand' vr = \case updateRcvFileAgentId db fileId Nothing getChatItemByFileId db vr user fileId pure $ CRRcvFileCancelled user ci ftr - FTLocal _ -> throwChatError $ CEFileCancel fileId "cannot cancel local files" - FileStatus fileId -> withUser $ \user -> do + FileStatus fileId -> withUser $ \user@User {userId} -> do ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db vr user fileId case file of + Just CIFile {fileProtocol = FPLocal} -> do + -- XXX: not stricly a file transfer but the file *has* some status + fileMeta <- withStore $ \db -> getLocalFileMeta db userId fileId + pure $ CRLocalFileStatus user fileMeta Just CIFile {fileProtocol = FPXFTP} -> pure $ CRFileTransferStatusXFTP user ci - -- Just CIFile {fileProtocol = FPLocal, fileId,} -> - -- pure $ CRLocalFileStatus user fileId ??? _ -> do fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId pure $ CRFileTransferStatus user fileStatus diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 2cd758264b..e43a2d0ba9 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -563,7 +563,7 @@ data ChatResponse | CRNoteFolderDeleted {user :: User, noteFolder :: NoteFolder} | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus | CRFileTransferStatusXFTP User AChatItem - -- | CRLocalFileStatus User CIFileInfo + | CRLocalFileStatus User LocalFileMeta | CRUserProfile {user :: User, profile :: Profile} | CRUserProfileNoChange {user :: User} | CRUserPrivacy {user :: User, updatedUser :: User} diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 6977fca74b..dce1f612a7 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -18,7 +19,6 @@ module Simplex.Chat.Store.Files createSndDirectFTConnection, createSndGroupFileTransfer, createSndGroupFileTransferConnection, - createSndLocalFileTransfer, createSndDirectInlineFT, createSndGroupInlineFT, updateSndDirectFTDelivery, @@ -75,7 +75,9 @@ module Simplex.Chat.Store.Files getSndFileTransfers, getContactFileInfo, getNoteFolderFileInfo, + createLocalFile, getLocalCryptoFile, + getLocalFileMeta, updateDirectCIFileStatus, ) where @@ -93,6 +95,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay) import Data.Type.Equality import Database.SQLite.Simple (Only (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) +import Database.SQLite.Simple.ToField (ToField) import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol @@ -110,6 +113,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Version (VersionRange) +import System.FilePath (takeFileName) getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer] getLiveSndFileTransfers db User {userId} = do @@ -213,16 +217,6 @@ createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) "INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" (fileId, FSAccepted, connId, groupMemberId, currentTs, currentTs) -createSndLocalFileTransfer :: DB.Connection -> User -> NoteFolder -> FilePath -> FileInvitation -> Integer -> IO FileTransferMeta -createSndLocalFileTransfer db User {userId} NoteFolder {noteFolderId} filePath FileInvitation {fileName, fileSize, fileInline} chunkSize = do - currentTs <- getCurrentTime - DB.execute - db - "INSERT INTO files (user_id, note_folder_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)" - ((userId, noteFolderId, fileName, filePath, fileSize, chunkSize) :. (fileInline, CIFSSndComplete, FPLocal, currentTs, currentTs)) - fileId <- insertedRowId db - pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False} - createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> ExceptT StoreError IO SndFileTransfer createSndDirectInlineFT _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Just Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = liftIO $ do @@ -847,19 +841,17 @@ getFileTransferProgress db user fileId = do FTSnd _ [] -> pure [Only 0] FTSnd _ _ -> DB.query db "SELECT COUNT(*) FROM snd_file_chunks WHERE file_id = ? and chunk_sent = 1 GROUP BY connection_id" (Only fileId) FTRcv _ -> DB.query db "SELECT COUNT(*) FROM rcv_file_chunks WHERE file_id = ? AND chunk_stored = 1" (Only fileId) - FTLocal _ -> pure [Only 0] getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer getFileTransfer db user@User {userId} fileId = fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId) where fileTransfer :: [(Maybe Int64, Maybe Int64, FileProtocol)] -> ExceptT StoreError IO FileTransfer + fileTransfer [(_, _, FPLocal)] = throwError $ SEBadFileTransfer fileId fileTransfer [(Nothing, Just _, _)] = FTRcv <$> getRcvFileTransfer db user fileId - fileTransfer [(Just _, Nothing, _)] = do + fileTransfer _ = do (ftm, fts) <- getSndFileTransfer db user fileId pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts} - fileTransfer [(Nothing, Nothing, FPLocal)] = FTLocal <$> getLocalFileMeta db userId fileId - fileTransfer _ = throwError $ SEBadFileTransfer fileId getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64, FileProtocol)] getFileTransferRow_ db userId fileId = @@ -927,6 +919,26 @@ getFileTransferMeta_ db userId fileId = xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_ in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_} +createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> ChatItemId -> UTCTime -> CryptoFile -> Integer -> IO Int64 +createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId itemTs CryptoFile {filePath, cryptoArgs} fileSize = do + DB.execute + db + [sql| + INSERT INTO files + ( user_id, note_folder_id, chat_item_id, + file_name, file_path, file_size, + file_crypto_key, file_crypto_nonce, + chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at + ) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + |] + ( (userId, noteFolderId, chatItemId) + :. (takeFileName filePath, filePath, fileSize) + :. maybe (Nothing, Nothing) (\(CFArgs key nonce) -> (Just key, Just nonce)) cryptoArgs + :. (65536 :: Int, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs) + ) + insertedRowId db + getLocalFileMeta :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalFileMeta getLocalFileMeta db userId fileId = ExceptT . firstRow localFileMeta (SEFileNotFound fileId) $ diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 2c70526e3a..0bdb22ba8f 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1147,7 +1147,6 @@ data FileTransfer sndFileTransfers :: [SndFileTransfer] } | FTRcv {rcvFileTransfer :: RcvFileTransfer} - | FTLocal {localFileMeta :: LocalFileMeta} deriving (Show) data FileTransferMeta = FileTransferMeta @@ -1182,7 +1181,6 @@ data XFTPSndFile = XFTPSndFile fileTransferCancelled :: FileTransfer -> Bool fileTransferCancelled (FTSnd FileTransferMeta {cancelled} _) = cancelled fileTransferCancelled (FTRcv RcvFileTransfer {cancelled}) = cancelled -fileTransferCancelled FTLocal {} = False -- For XFTP file transfers FSConnected means "uploaded to XFTP relays" -- Local files are always FSComplete diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 055d7047b4..1865cbcddb 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -155,6 +155,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe | viaGroupLink -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"] | otherwise -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] Nothing -> [] + CRLocalFileStatus u lfm -> ttyUser u $ viewLocalFileStatus lfm CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci CRUserProfile u p -> ttyUser u $ viewUserProfile p @@ -1598,6 +1599,9 @@ viewLocalFile to CIFile {fileId, fileSource} ts tz = case fileSource of Just (CryptoFile fPath _) -> sentWithTime_ ts tz [to <> fileTransferStr fileId fPath] _ -> const [] +viewLocalFileStatus :: LocalFileMeta -> [StyledString] +viewLocalFileStatus LocalFileMeta {fileId, filePath} = ["local " <> fileTransferStr fileId filePath] + cryptoFileArgsStr :: Bool -> CryptoFileArgs -> ByteString cryptoFileArgsStr testView cfArgs@(CFArgs key nonce) | testView = LB.toStrict $ J.encode cfArgs @@ -1650,7 +1654,6 @@ viewFileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileI RFSComplete RcvFileInfo {filePath} -> "complete, path: " <> plain filePath RFSCancelled (Just RcvFileInfo {filePath}) -> "cancelled, received part path: " <> plain filePath RFSCancelled Nothing -> "cancelled" -viewFileTransferStatus (FTLocal LocalFileMeta {fileId, fileName}, _) = [fileTransferStr fileId fileName] viewFileTransferStatusXFTP :: AChatItem -> [StyledString] viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName, fileSize, fileStatus, fileSource}}) = diff --git a/tests/ChatTests/Local.hs b/tests/ChatTests/Local.hs index 52298960c5..4fd177d437 100644 --- a/tests/ChatTests/Local.hs +++ b/tests/ChatTests/Local.hs @@ -60,7 +60,7 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do alice ##> "/tail" alice <# "$self file 1 (test.jpg)" alice ##> "/fs 1" - alice <## "file 1 (test.jpg)" + alice <## "local file 1 (test.jpg)" createFolder :: TestCC -> String -> IO () createFolder cc label = do