mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
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>
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
bfc178faf3
commit
e21b4d4236
+52
-40
@@ -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}
|
||||
|
||||
+57
-30
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user