core: optionally encrypt SMP files (#3082)

* core: optionally encrypt SMP files

* encrypt to temp file and rename or remove encryption args if it fails

* fix file encryption error handling
This commit is contained in:
Evgeny Poberezkin
2023-09-20 13:05:09 +01:00
committed by GitHub
parent f19fae615d
commit 52966e7e3d
7 changed files with 124 additions and 56 deletions
+12 -6
View File
@@ -57,6 +57,7 @@ module Simplex.Chat.Store.Files
xftpAcceptRcvFT,
setRcvFileToReceive,
setFileCryptoArgs,
removeFileCryptoArgs,
getRcvFilesToReceive,
setRcvFTAgentDeleted,
updateRcvFileStatus,
@@ -487,7 +488,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
fileId <- liftIO $ do
DB.execute
@@ -500,7 +501,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
db
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing}
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
@@ -508,7 +509,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
-- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
fileId <- liftIO $ do
DB.execute
@@ -521,7 +522,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
db
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId, cryptoArgs = Nothing}
createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
@@ -639,8 +640,8 @@ getRcvFileTransfer db User {userId} fileId = do
ft senderDisplayName fileStatus =
let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
cryptoArgs = CFArgs <$> fileKey <*> fileNonce
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, cryptoArgs}) <$> rfd_
in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_
in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs}
rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_
rfi_ = case (filePath_, connId_, agentConnId_) of
(Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
@@ -709,6 +710,11 @@ setFileCryptoArgs_ db fileId (CFArgs key nonce) currentTs =
"UPDATE files SET file_crypto_key = ?, file_crypto_nonce = ?, updated_at = ? WHERE file_id = ?"
(key, nonce, currentTs, fileId)
removeFileCryptoArgs :: DB.Connection -> FileTransferId -> IO ()
removeFileCryptoArgs db fileId = do
currentTs <- getCurrentTime
DB.execute db "UPDATE files SET file_crypto_key = NULL, file_crypto_nonce = NULL, updated_at = ? WHERE file_id = ?" (currentTs, fileId)
getRcvFilesToReceive :: DB.Connection -> User -> IO [RcvFileTransfer]
getRcvFilesToReceive db user@User {userId} = do
cutoffTs <- addUTCTime (- (2 * nominalDay)) <$> getCurrentTime