dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-06-08 00:03:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: store/get remote files (#3289)

Browse Source 
* core: store remote files (wip)

* fix/test store remote file

* get remote file

* get file

* validate remote file metadata before sending to controller

* CLI commands, test

* update store method
This commit is contained in:
Evgeny Poberezkin
2023-10-29 19:06:32 +00:00
committed by GitHub
parent 9fb2b7fe73
commit d90da57f12
14 changed files with 543 additions and 227 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Files.hs
+38 -15
View File
@@ -2,6 +2,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -71,6 +72,7 @@ module Simplex.Chat.Store.Files
getSndFileTransfer,
getSndFileTransfers,
getContactFileInfo,
getLocalCryptoFile,
updateDirectCIFileStatus,
)
where
@@ -602,7 +604,10 @@ getRcvFileTransferById db fileId = do
(user,) <$> getRcvFileTransfer db user fileId
getRcvFileTransfer :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer db User {userId} fileId = do
getRcvFileTransfer db User {userId} = getRcvFileTransfer_ db userId
getRcvFileTransfer_ :: DB.Connection -> UserId -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer_ db userId fileId = do
rftRow <-
ExceptT . firstRow id (SERcvFileNotFound fileId) $
DB.query
@@ -808,25 +813,26 @@ getFileTransferProgress db user fileId = do
getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
getFileTransfer db user@User {userId} fileId =
fileTransfer =<< liftIO getFileTransferRow
fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId)
where
fileTransfer :: [(Maybe Int64, Maybe Int64)] -> ExceptT StoreError IO FileTransfer
fileTransfer [(Nothing, Just _)] = FTRcv <$> getRcvFileTransfer db user fileId
fileTransfer _ = do
(ftm, fts) <- getSndFileTransfer db user fileId
pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts}
getFileTransferRow :: IO [(Maybe Int64, Maybe Int64)]
getFileTransferRow =
DB.query
db
[sql|
SELECT s.file_id, r.file_id
FROM files f
LEFT JOIN snd_files s ON s.file_id = f.file_id
LEFT JOIN rcv_files r ON r.file_id = f.file_id
WHERE user_id = ? AND f.file_id = ?
|]
(userId, fileId)
getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64)]
getFileTransferRow_ db userId fileId =
DB.query
db
[sql|
SELECT s.file_id, r.file_id
FROM files f
LEFT JOIN snd_files s ON s.file_id = f.file_id
LEFT JOIN rcv_files r ON r.file_id = f.file_id
WHERE user_id = ? AND f.file_id = ?
|]
(userId, fileId)
getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
getSndFileTransfer db user fileId = do
@@ -861,7 +867,10 @@ getSndFileTransfers_ db userId fileId =
Nothing -> Left $ SESndFileInvalid fileId
getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta db User {userId} fileId =
getFileTransferMeta db User {userId} = getFileTransferMeta_ db userId
getFileTransferMeta_ :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ db userId fileId =
ExceptT . firstRow fileTransferMeta (SEFileNotFound fileId) $
DB.query
db
@@ -883,6 +892,20 @@ getContactFileInfo db User {userId} Contact {contactId} =
map toFileInfo
<$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.contact_id = ?") (userId, contactId)
getLocalCryptoFile :: DB.Connection -> UserId -> Int64 -> Bool -> ExceptT StoreError IO CryptoFile
getLocalCryptoFile db userId fileId sent =
liftIO (getFileTransferRow_ db userId fileId) >>= \case
[(Nothing, Just _)] -> do
when sent $ throwError $ SEFileNotFound fileId
RcvFileTransfer {fileStatus, cryptoArgs} <- getRcvFileTransfer_ db userId fileId
case fileStatus of
RFSComplete RcvFileInfo {filePath} -> pure $ CryptoFile filePath cryptoArgs
_ -> throwError $ SEFileNotFound fileId
_ -> do
unless sent $ throwError $ SEFileNotFound fileId
FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus db user fileId fileStatus = do
aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId