diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs index 94be483c7..36940fce4 100644 --- a/src/Simplex/FileTransfer/Agent.hs +++ b/src/Simplex/FileTransfer/Agent.hs @@ -273,9 +273,9 @@ runXFTPRcvLocalWorker c doWork = do getChunkPaths (RcvFileChunk {chunkTmpPath = Nothing} : _cs) = throwError $ INTERNAL "no chunk path" -deleteRcvFile :: AgentMonad m => AgentClient -> UserId -> RcvFileId -> m () -deleteRcvFile c userId rcvFileEntityId = do - RcvFile {rcvFileId, prefixPath, status} <- withStore c $ \db -> getRcvFileByEntityId db userId rcvFileEntityId +deleteRcvFile :: AgentMonad m => AgentClient -> RcvFileId -> m () +deleteRcvFile c rcvFileEntityId = do + RcvFile {rcvFileId, prefixPath, status} <- withStore c $ \db -> getRcvFileByEntityId db rcvFileEntityId if status == RFSComplete || status == RFSError then do removePath prefixPath @@ -568,9 +568,9 @@ runXFTPSndWorker c srv doWork = do chunkUploaded SndFileChunk {replicas} = any (\SndFileChunkReplica {replicaStatus} -> replicaStatus == SFRSUploaded) replicas -deleteSndFileInternal :: AgentMonad m => AgentClient -> UserId -> SndFileId -> m () -deleteSndFileInternal c userId sndFileEntityId = do - SndFile {sndFileId, prefixPath, status} <- withStore c $ \db -> getSndFileByEntityId db userId sndFileEntityId +deleteSndFileInternal :: AgentMonad m => AgentClient -> SndFileId -> m () +deleteSndFileInternal c sndFileEntityId = do + SndFile {sndFileId, prefixPath, status} <- withStore c $ \db -> getSndFileByEntityId db sndFileEntityId if status == SFSComplete || status == SFSError then do forM_ prefixPath $ removePath <=< toFSFilePath @@ -579,7 +579,7 @@ deleteSndFileInternal c userId sndFileEntityId = do deleteSndFileRemote :: forall m. AgentMonad m => AgentClient -> UserId -> SndFileId -> ValidFileDescription 'FSender -> m () deleteSndFileRemote c userId sndFileEntityId (ValidFileDescription FileDescription {chunks}) = do - deleteSndFileInternal c userId sndFileEntityId `catchError` (notify c sndFileEntityId . SFERR) + deleteSndFileInternal c sndFileEntityId `catchError` (notify c sndFileEntityId . SFERR) forM_ chunks $ \ch -> deleteFileChunk ch `catchError` (notify c sndFileEntityId . SFERR) where deleteFileChunk :: FileChunk -> m () diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 2c6a14913..2b8a6d09f 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -345,16 +345,16 @@ xftpReceiveFile :: AgentErrorMonad m => AgentClient -> UserId -> ValidFileDescri xftpReceiveFile c = withAgentEnv c .: receiveFile c -- | Delete XFTP rcv file (deletes work files from file system and db records) -xftpDeleteRcvFile :: AgentErrorMonad m => AgentClient -> UserId -> RcvFileId -> m () -xftpDeleteRcvFile c = withAgentEnv c .: deleteRcvFile c +xftpDeleteRcvFile :: AgentErrorMonad m => AgentClient -> RcvFileId -> m () +xftpDeleteRcvFile c = withAgentEnv c . deleteRcvFile c -- | Send XFTP file xftpSendFile :: AgentErrorMonad m => AgentClient -> UserId -> FilePath -> Int -> m SndFileId xftpSendFile c = withAgentEnv c .:. sendFile c -- | Delete XFTP snd file internally (deletes work files from file system and db records) -xftpDeleteSndFileInternal :: AgentErrorMonad m => AgentClient -> UserId -> SndFileId -> m () -xftpDeleteSndFileInternal c = withAgentEnv c .: deleteSndFileInternal c +xftpDeleteSndFileInternal :: AgentErrorMonad m => AgentClient -> SndFileId -> m () +xftpDeleteSndFileInternal c = withAgentEnv c . deleteSndFileInternal c -- | Delete XFTP snd file chunks on servers xftpDeleteSndFileRemote :: AgentErrorMonad m => AgentClient -> UserId -> SndFileId -> ValidFileDescription 'FSender -> m () diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 1a8c00149..e16a8d024 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -1888,15 +1888,15 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath save "INSERT INTO rcv_file_chunk_replicas (replica_number, rcv_file_chunk_id, xftp_server_id, replica_id, replica_key) VALUES (?,?,?,?,?)" (replicaNo, chunkId, srvId, replicaId, replicaKey) -getRcvFileByEntityId :: DB.Connection -> UserId -> RcvFileId -> IO (Either StoreError RcvFile) -getRcvFileByEntityId db userId rcvFileEntityId = runExceptT $ do - rcvFileId <- ExceptT $ getRcvFileIdByEntityId_ db userId rcvFileEntityId +getRcvFileByEntityId :: DB.Connection -> RcvFileId -> IO (Either StoreError RcvFile) +getRcvFileByEntityId db rcvFileEntityId = runExceptT $ do + rcvFileId <- ExceptT $ getRcvFileIdByEntityId_ db rcvFileEntityId ExceptT $ getRcvFile db rcvFileId -getRcvFileIdByEntityId_ :: DB.Connection -> UserId -> RcvFileId -> IO (Either StoreError DBRcvFileId) -getRcvFileIdByEntityId_ db userId rcvFileEntityId = +getRcvFileIdByEntityId_ :: DB.Connection -> RcvFileId -> IO (Either StoreError DBRcvFileId) +getRcvFileIdByEntityId_ db rcvFileEntityId = firstRow fromOnly SEFileNotFound $ - DB.query db "SELECT rcv_file_id FROM rcv_files WHERE user_id = ? AND rcv_file_entity_id = ?" (userId, rcvFileEntityId) + DB.query db "SELECT rcv_file_id FROM rcv_files WHERE rcv_file_entity_id = ?" (Only rcvFileEntityId) getRcvFile :: DB.Connection -> DBRcvFileId -> IO (Either StoreError RcvFile) getRcvFile db rcvFileId = runExceptT $ do @@ -2115,15 +2115,15 @@ createSndFile db gVar userId numRecipients path prefixPath key nonce = "INSERT INTO snd_files (snd_file_entity_id, user_id, num_recipients, key, nonce, path, prefix_path, status) VALUES (?,?,?,?,?,?,?,?)" (sndFileEntityId, userId, numRecipients, key, nonce, path, prefixPath, SFSNew) -getSndFileByEntityId :: DB.Connection -> UserId -> SndFileId -> IO (Either StoreError SndFile) -getSndFileByEntityId db userId sndFileEntityId = runExceptT $ do - sndFileId <- ExceptT $ getSndFileIdByEntityId_ db userId sndFileEntityId +getSndFileByEntityId :: DB.Connection -> SndFileId -> IO (Either StoreError SndFile) +getSndFileByEntityId db sndFileEntityId = runExceptT $ do + sndFileId <- ExceptT $ getSndFileIdByEntityId_ db sndFileEntityId ExceptT $ getSndFile db sndFileId -getSndFileIdByEntityId_ :: DB.Connection -> UserId -> SndFileId -> IO (Either StoreError DBSndFileId) -getSndFileIdByEntityId_ db userId sndFileEntityId = +getSndFileIdByEntityId_ :: DB.Connection -> SndFileId -> IO (Either StoreError DBSndFileId) +getSndFileIdByEntityId_ db sndFileEntityId = firstRow fromOnly SEFileNotFound $ - DB.query db "SELECT snd_file_id FROM snd_files WHERE user_id = ? AND snd_file_entity_id = ?" (userId, sndFileEntityId) + DB.query db "SELECT snd_file_id FROM snd_files WHERE snd_file_entity_id = ?" (Only sndFileEntityId) getSndFile :: DB.Connection -> DBSndFileId -> IO (Either StoreError SndFile) getSndFile db sndFileId = runExceptT $ do diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs index 44e7b0860..9eaa0f23e 100644 --- a/tests/XFTPAgent.hs +++ b/tests/XFTPAgent.hs @@ -86,7 +86,7 @@ testXFTPAgentSendReceive = withXFTPServer $ do sndr <- getSMPAgentClient' agentCfg initAgentServers testDB (rfd1, rfd2) <- runRight $ do (sfId, _, rfd1, rfd2) <- testSend sndr filePath - xftpDeleteSndFileInternal sndr 1 sfId + xftpDeleteSndFileInternal sndr sfId pure (rfd1, rfd2) -- receive file, delete rcv file @@ -97,7 +97,7 @@ testXFTPAgentSendReceive = withXFTPServer $ do rcp <- getSMPAgentClient' agentCfg initAgentServers testDB runRight_ $ do rfId <- testReceive rcp rfd originalFilePath - xftpDeleteRcvFile rcp 1 rfId + xftpDeleteRcvFile rcp rfId createRandomFile :: IO FilePath createRandomFile = do