From e21b4d42368a64842eb5d92eb1f917a10710e59c Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Tue, 14 Mar 2023 09:28:54 +0000 Subject: [PATCH] xftp: send file descriptions when ready (#1999) * xftp: send file descriptions when ready * remove comments, update progress on completion * update simplexmq * fix error condition Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * fix conflict * saveMemberFD * more efficient list merging --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --- src/Simplex/Chat.hs | 92 ++++++++++++++++++++++----------------- src/Simplex/Chat/Store.hs | 87 +++++++++++++++++++++++------------- src/Simplex/Chat/Types.hs | 11 ++--- 3 files changed, 115 insertions(+), 75 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 4c94150fb4..96aaf9a8a1 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -442,12 +442,12 @@ processChatCommand = \case quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) quoteData _ = throwChatError CEInvalidQuote CTGroup -> do - Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId + g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms) <- withStore $ \db -> getGroup db user chatId assertUserGroupRole gInfo GRAuthor if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice)) else do - (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms) + (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms) timed_ <- sndGroupCITimed live gInfo (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer) @@ -458,12 +458,12 @@ processChatCommand = \case setActive $ ActiveG gName pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) where - setupSndFileTransfer :: GroupInfo -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) - setupSndFileTransfer gInfo n = forM file_ $ \file -> do + setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) + setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do (fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n case fileMode of SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline - SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup gInfo + SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup g where smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta) smpSndFileTransfer file fileSize fileInline = do @@ -531,11 +531,21 @@ processChatCommand = \case xftpSndFileTransfer :: User -> FilePath -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta) xftpSndFileTransfer user file fileSize n contactOrGroup = do let fileName = takeFileName file - fInv = xftpFileInvitation fileName fileSize + fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} + fInv = xftpFileInvitation fileName fileSize fileDescr tmp <- readTVarIO =<< asks tempDirectory aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tmp ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored} + case contactOrGroup of + CGContact Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr + CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchError` (toView . CRChatError (Just user)) + where + -- we are not sending files to pending members, same as with inline files + saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} = + when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $ + withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr + saveMemberFD _ = pure () pure (fInv, ciFile, ft) unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c) unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c) @@ -2147,51 +2157,53 @@ processAgentMsgSndFile _corrId aFileId msg = where process :: User -> m () process user = do - ft@FileTransferMeta {fileId} <- withStore $ \db -> getAgentSndFileXFTP db user $ AgentSndFileId aFileId + fileId <- withStore $ \db -> getAgentSndFileIdXFTP db user $ AgentSndFileId aFileId case msg of SFPROG _sent _total -> do -- update chat item status -- send status to view pure () SFDONE _sndDescr rfds -> do - AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}} <- + ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <- withStore $ \db -> getChatItemByFileId db user fileId case (msgId_, itemDeleted) of - (Just sharedMsgId, Nothing) -> case (rfds, d, cInfo) of - (rfd : _, SMDSnd, DirectChat ct) -> do - let rfdText = safeDecodeUtf8 $ strEncode rfd - withStore' $ \db -> createSndDirectFTDescrXFTP db user ct ft rfdText - -- TODO update chat item status to show 100% progress - sendDirectFileDescription ct rfdText ft sharedMsgId - (_, SMDSnd, GroupChat _g) -> do - -- store file descriptions and files to snd_files - -- send messages with descriptions to the recipients - -- update chat item file status (CIFileStatus) - -- update sent file status - -- ??? possibly another event as we need one event per group, not per member - -- toView $ CRSndFileComplete user ci ft - pure () - _ -> pure () -- TODO error - _ -> pure () -- TODO error - pure () + (Just sharedMsgId, Nothing) -> do + (ft, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId + when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send" + toView $ CRSndFileProgressXFTP user ci ft 1 1 + case (rfds, sfts, d, cInfo) of + (rfd : _, sft : _, SMDSnd, DirectChat ct) -> + sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct + (_, _, 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)) + where + memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)] + memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts') + where + mConns' = mapMaybe useMember ms + sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts + useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}} + | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn) + | otherwise = Nothing + useMember _ = Nothing + sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m () + sendToMember (rfd, (conn, sft)) = + sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId + _ -> pure () + _ -> pure () -- TODO error? where - sendDirectFileDescription :: Contact -> Text -> FileTransferMeta -> SharedMsgId -> m () - sendDirectFileDescription ct rfd ft sharedMsgId = do - msgDeliveryId <- sendFileDescription_ rfd sharedMsgId $ sendDirectContactMessage ct - withStore' $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId - - _sendMemberFileDescription :: GroupMember -> Connection -> Text -> FileTransferMeta -> SharedMsgId -> m () - _sendMemberFileDescription m@GroupMember {groupId} conn rfd ft sharedMsgId = do - msgDeliveryId <- sendFileDescription_ rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId - withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId - - sendFileDescription_ :: Text -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64 - sendFileDescription_ rfdText msgId sendMsg = do + sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m () + sendFileDescription sft rfd msgId sendMsg = do + let rfdText = safeDecodeUtf8 $ strEncode rfd + withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText partSize <- asks $ xftpDescrPartSize . config - sendParts 1 partSize rfdText + msgDeliveryId <- sendParts 1 partSize rfdText + -- msgDeliveryId <- sendFileDescription_ rfd sharedMsgId sendMsg + withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId where - sendParts partNo partSize rfd = do - let (part, rest) = T.splitAt partSize rfd + sendParts partNo partSize rfdText = do + let (part, rest) = T.splitAt partSize rfdText complete = T.null rest fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete} (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr} diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 1e60ead212..1eea4df69d 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -156,8 +156,10 @@ module Simplex.Chat.Store updateSndGroupFTDelivery, getSndFTViaMsgDelivery, createSndFileTransferXFTP, - createSndDirectFTDescrXFTP, - getAgentSndFileXFTP, + createSndFTDescrXFTP, + updateSndFTDescrXFTP, + updateSndFTDeliveryXFTP, + getAgentSndFileIdXFTP, getAgentRcvFileXFTP, updateFileCancelled, updateCIFileStatus, @@ -190,6 +192,7 @@ module Simplex.Chat.Store getFileTransferProgress, getFileTransferMeta, getSndFileTransfer, + getSndFileTransfers, getContactFileInfo, deleteContactCIs, getGroupFileInfo, @@ -1742,7 +1745,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do DB.query db [sql| - SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, cs.local_display_name, m.local_display_name + SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.group_member_id, cs.local_display_name, m.local_display_name FROM snd_files s JOIN files f USING (file_id) LEFT JOIN contacts cs USING (contact_id) @@ -1750,10 +1753,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ? |] (userId, fileId, connId) - sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer - sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, contactName_, memberName_) = + sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer + sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, contactName_, memberName_) = case contactName_ <|> memberName_ of - Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId} + Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId, groupMemberId} Nothing -> Left $ SESndFileInvalid fileId getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact getUserContact_ userContactLinkId = ExceptT $ do @@ -2681,7 +2684,7 @@ createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Connectio db "INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" (fileId, fileStatus, fileInline', connId, currentTs, currentTs) - pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'} + pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Nothing, fileStatus, fileDescrId = Nothing, fileInline = fileInline'} createSndGroupInlineFT :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> IO SndFileTransfer createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Connection {connId, agentConnId} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do @@ -2692,7 +2695,7 @@ createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Conn db "INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" (fileId, fileStatus, fileInline', connId, groupMemberId, currentTs, currentTs) - pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'} + pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Just groupMemberId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'} updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO () updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId = @@ -2714,7 +2717,7 @@ getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMs <$> DB.query db [sql| - SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, c.local_display_name, m.local_display_name + SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.group_member_id, c.local_display_name, m.local_display_name FROM msg_deliveries d JOIN snd_files s ON s.connection_id = d.connection_id AND s.last_inline_msg_delivery_id = d.msg_delivery_id JOIN files f ON f.file_id = s.file_id @@ -2725,9 +2728,9 @@ getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMs |] (connId, agentMsgId, userId) where - sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer - sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, contactName_, memberName_) = - (\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName = n, connId, agentConnId}) + sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer + sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, contactName_, memberName_) = + (\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, recipientDisplayName = n, connId, agentConnId}) <$> (contactName_ <|> memberName_) createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> FilePath -> FileInvitation -> AgentSndFileId -> IO FileTransferMeta @@ -2742,22 +2745,43 @@ createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitatio fileId <- insertedRowId db pure FileTransferMeta {fileId, xftpSndFile, fileName, filePath, fileSize, fileInline = Nothing, chunkSize, cancelled = False} -createSndDirectFTDescrXFTP :: DB.Connection -> User -> Contact -> FileTransferMeta -> Text -> IO () -createSndDirectFTDescrXFTP db User {userId} Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} rfdText = do - let fileStatus = FSConnected - DB.execute db "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_complete) VALUES (?,?,?)" (userId, rfdText, True) +createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO () +createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fileId} FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do + let fileStatus = FSNew + DB.execute + db + "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)" + (userId, fileDescrText, fileDescrPartNo, fileDescrComplete) fileDescrId <- insertedRowId db DB.execute db - "INSERT INTO snd_files (file_id, file_status, file_descr_id, connection_id) VALUES (?,?,?,?)" - (fileId, fileStatus, fileDescrId, connId) + "INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id) VALUES (?,?,?,?,?)" + (fileId, fileStatus, fileDescrId, groupMemberId' <$> m, connId) -getAgentSndFileXFTP :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO FileTransferMeta -getAgentSndFileXFTP db user aSndFileId = do - fileId <- - ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $ - DB.query db "SELECT file_id FROM files WHERE agent_snd_file_id = ?" (Only aSndFileId) - getFileTransferMeta db user fileId +updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO () +updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do + DB.execute + db + [sql| + UPDATE xftp_file_descriptions + SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ? + WHERE user_id = ? AND file_descr_id = ? + |] + (rfdText, 1 :: Int, True, userId, fileDescrId) + updateCIFileStatus db user fileId $ CIFSSndTransfer 1 1 + updateSndFileStatus db sft FSConnected + +updateSndFTDeliveryXFTP :: DB.Connection -> SndFileTransfer -> Int64 -> IO () +updateSndFTDeliveryXFTP db SndFileTransfer {connId, fileId, fileDescrId} msgDeliveryId = + DB.execute + db + "UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_descr_id = ?" + (msgDeliveryId, connId, fileId, fileDescrId) + +getAgentSndFileIdXFTP :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO Int64 +getAgentSndFileIdXFTP db User {userId} aSndFileId = + ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $ + DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId) getAgentRcvFileXFTP :: DB.Connection -> User -> AgentRcvFileId -> ExceptT StoreError IO FileTransferMeta getAgentRcvFileXFTP _db _user _aFileId = undefined @@ -3179,18 +3203,21 @@ getFileTransfer db user@User {userId} fileId = (userId, fileId) getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer]) -getSndFileTransfer db user@User {userId} fileId = do +getSndFileTransfer db user fileId = do fileTransferMeta <- getFileTransferMeta db user fileId - sndFileTransfers <- ExceptT $ getSndFileTransfers_ db userId fileId + sndFileTransfers <- getSndFileTransfers db user fileId pure (fileTransferMeta, sndFileTransfers) +getSndFileTransfers :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO [SndFileTransfer] +getSndFileTransfers db User {userId} fileId = ExceptT $ getSndFileTransfers_ db userId fileId + getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer]) getSndFileTransfers_ db userId fileId = mapM sndFileTransfer <$> DB.query db [sql| - SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.connection_id, c.agent_conn_id, + SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.connection_id, c.agent_conn_id, s.group_member_id, cs.local_display_name, m.local_display_name FROM snd_files s JOIN files f USING (file_id) @@ -3201,10 +3228,10 @@ getSndFileTransfers_ db userId fileId = |] (userId, fileId) where - sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath) :. (Maybe Int64, Maybe InlineFileMode, Int64, AgentConnId, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer - sndFileTransfer ((fileStatus, fileName, fileSize, chunkSize, filePath) :. (fileDescrId, fileInline, connId, agentConnId, contactName_, memberName_)) = + sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath) :. (Maybe Int64, Maybe InlineFileMode, Int64, AgentConnId, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer + sndFileTransfer ((fileStatus, fileName, fileSize, chunkSize, filePath) :. (fileDescrId, fileInline, connId, agentConnId, groupMemberId, contactName_, memberName_)) = case contactName_ <|> memberName_ of - Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId} + Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId, groupMemberId} Nothing -> Left $ SESndFileInvalid fileId getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 937ea81179..10f3851c34 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -287,12 +287,12 @@ instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOption groupName' :: GroupInfo -> GroupName groupName' GroupInfo {localDisplayName = g} = g -data ContactOrGroup = CGContact Contact | CGGroup GroupInfo +data ContactOrGroup = CGContact Contact | CGGroup Group contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId) contactAndGroupIds = \case CGContact Contact {contactId} -> (Just contactId, Nothing) - CGGroup GroupInfo {groupId} -> (Nothing, Just groupId) + CGGroup (Group GroupInfo {groupId} _) -> (Nothing, Just groupId) -- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties) data ChatSettings = ChatSettings @@ -1461,6 +1461,7 @@ data SndFileTransfer = SndFileTransfer recipientDisplayName :: ContactName, connId :: Int64, agentConnId :: AgentConnId, + groupMemberId :: Maybe Int64, fileStatus :: FileStatus, fileDescrId :: Maybe Int64, fileInline :: Maybe InlineFileMode @@ -1501,15 +1502,15 @@ instance ToJSON FileDescr where instance FromJSON FileDescr where parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD" -xftpFileInvitation :: FilePath -> Integer -> FileInvitation -xftpFileInvitation fileName fileSize = +xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation +xftpFileInvitation fileName fileSize fileDescr = FileInvitation { fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, - fileDescr = Just FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False} + fileDescr = Just fileDescr } data InlineFileMode