diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs index 8727f95cc..c89e40ae5 100644 --- a/src/Simplex/FileTransfer/Agent.hs +++ b/src/Simplex/FileTransfer/Agent.hs @@ -241,17 +241,19 @@ sendFileExperimental AgentClient {subQ} _userId numRecipients xftpPath filePath verbose = False } liftCLI $ cliSendFile sendOptions - (sndDescr, rcvDescrs) <- readDescrs outputDir + (sndDescr, rcvDescrs) <- readDescrs outputDir fileName notify sndFileEntityId $ SFDONE sndDescr rcvDescrs liftCLI :: ExceptT CLIError IO () -> m () liftCLI = either (throwError . INTERNAL . show) pure <=< liftIO . runExceptT - readDescrs :: FilePath -> m (String, [String]) - readDescrs outDir = do - files <- listDirectory outDir + readDescrs :: FilePath -> FilePath -> m (String, [String]) + readDescrs outDir fileName = do + let descrDir = outDir (fileName <> ".xftp") + files <- listDirectory descrDir let (sdFiles, rdFiles) = partition ("snd.xftp.private" `isSuffixOf`) files - sdFile = maybe "" L.head (nonEmpty sdFiles) + sdFile = maybe "" (\l -> descrDir L.head l) (nonEmpty sdFiles) + rdFiles' = map (descrDir ) rdFiles -- TODO map files to contents - pure (sdFile, rdFiles) + pure (sdFile, rdFiles') notify :: forall e. AEntityI e => SndFileId -> ACommand 'Agent e -> m () notify sndFileEntityId cmd = atomically $ writeTBQueue subQ ("", sndFileEntityId, APC (sAEntity @e) cmd) diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs index 5b9f54157..a5046d47b 100644 --- a/tests/XFTPAgent.hs +++ b/tests/XFTPAgent.hs @@ -10,6 +10,8 @@ import Control.Logger.Simple import Control.Monad.Except import Data.Bifunctor (first) import qualified Data.ByteString as LB +import Data.List.NonEmpty (nonEmpty) +import qualified Data.List.NonEmpty as L import SMPAgentClient (agentCfg, initAgentServers) import Simplex.FileTransfer.Description import Simplex.FileTransfer.Protocol (FileParty (..), checkParty) @@ -156,11 +158,15 @@ testXFTPAgentSendExperimental = do -- send file using experimental agent API sndr <- getSMPAgentClient agentCfg initAgentServers - runRight_ $ do + rcvDescrs <- runRight $ do sfId <- xftpSendFile sndr 1 2 senderFiles filePath - ("", sfId', SFDONE _ _) <- sfGet sndr - liftIO $ sfId' `shouldBe` sfId - let fdRcv = senderFiles "testfile.descr/testfile.xftp/rcv1.xftp" -- TODO use from SFDONE + ("", sfId', SFDONE sndDescr rcvDescrs) <- sfGet sndr + liftIO $ do + sfId' `shouldBe` sfId + sndDescr `shouldBe` senderFiles "testfile.descr/testfile.xftp/snd.xftp.private" + rcvDescrs `shouldBe` [senderFiles "testfile.descr/testfile.xftp/rcv1.xftp", senderFiles "testfile.descr/testfile.xftp/rcv2.xftp"] + pure rcvDescrs + let fdRcv = maybe "" L.head (nonEmpty rcvDescrs) -- receive file using agent rcp <- getSMPAgentClient agentCfg initAgentServers