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

xftp: agent command entities (#676)

Browse Source 
* xftp: agent command entities

* progress event

* parameterize agent command by entity

* refactor

* Eq instance for APartyCmdTag
This commit is contained in:
Evgeny Poberezkin
2023-03-10 09:10:52 +00:00
committed by GitHub
parent deec963de8
commit 8fde8e1344
11 changed files with 385 additions and 271 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/FileTransfer/Agent.hs
+5 -4
View File
@@ -7,6 +7,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Simplex.FileTransfer.Agent
( -- Receiving files
@@ -134,7 +135,7 @@ workerInternalError c rcvFileId internalErrStr = do
notifyInternalError c rcvFileId internalErrStr
notifyInternalError :: (MonadUnliftIO m) => AgentClient -> RcvFileId -> String -> m ()
notifyInternalError AgentClient {subQ} rcvFileId internalErrStr = atomically $ writeTBQueue subQ ("", "", FRCVERR rcvFileId $ INTERNAL internalErrStr)
notifyInternalError AgentClient {subQ} rcvFileId internalErrStr = atomically $ writeTBQueue subQ ("", "", APC SAERcvFile $ RFERR rcvFileId $ INTERNAL internalErrStr)
runXFTPLocalWorker :: forall m. AgentMonad m => AgentClient -> TMVar () -> m ()
runXFTPLocalWorker c@AgentClient {subQ} doWork = do
@@ -159,10 +160,10 @@ runXFTPLocalWorker c@AgentClient {subQ} doWork = do
path <- decrypt encSize chunkPaths
whenM (doesPathExist tmpPath) $ removeDirectoryRecursive tmpPath
withStore' c $ \db -> updateRcvFileComplete db rcvFileId path
notify $ FRCVD rcvFileId path
notify $ RFDONE rcvFileId path
where
notify :: ACommand 'Agent -> m ()
notify cmd = atomically $ writeTBQueue subQ ("", "", cmd)
notify :: forall e. AEntityI e => ACommand 'Agent e -> m ()
notify cmd = atomically $ writeTBQueue subQ ("", "", APC (sAEntity @e) cmd)
getChunkPaths :: [RcvFileChunk] -> m [FilePath]
getChunkPaths [] = pure []
getChunkPaths (RcvFileChunk {chunkTmpPath = Just path} : cs) = do