xftp: agent receive file (#637)

* xftp: agent receive file draft

* receiveFile more stubs, changes to types, schema

* cabal file

* comments

* xftp_server_id

* schema changes, get client, local worker/action

* agent env, save file description, adjust schema

* client stubs

* download chunk wip, store, schema, types

* remove commented code

* read file description, schema, types

* check received, decrypt

* remove pure

* todo

* add XFTP to agent client

* add user id

* agent test

* tests

* rename supervisor into agent

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/FileTransfer/Client/Agent.hs

@@ -68,8 +68,8 @@ getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
         first (XFTPClientAgentError srv)
           <$> getXFTPClient (1, srv, Nothing) (xftpConfig config) clientDisconnected
 
-    clientDisconnected :: IO ()
-    clientDisconnected = do
+    clientDisconnected :: XFTPClient -> IO ()
+    clientDisconnected _ = do
       atomically $ TM.delete srv xftpClients
       logInfo $ "disconnected from " <> showServer srv
 
@@ -84,7 +84,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, config} srv = do
 
     waitForXFTPClient :: XFTPClientVar -> ME XFTPClient
     waitForXFTPClient clientVar = do
-      let XFTPClientConfig {networkConfig = NetworkConfig {tcpConnectTimeout}} = xftpConfig config
+      let XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} = xftpConfig config
       client_ <- tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
       liftEither $ case client_ of
         Just (Right c) -> Right c
@@ -121,7 +121,7 @@ closeXFTPServerClient XFTPClientAgent {xftpClients, config} srv =
   atomically (TM.lookupDelete srv xftpClients) >>= mapM_ closeClient
   where
     closeClient cVar = do
-      let NetworkConfig {tcpConnectTimeout} = networkConfig $ xftpConfig config
+      let NetworkConfig {tcpConnectTimeout} = xftpNetworkConfig $ xftpConfig config
       tcpConnectTimeout `timeout` atomically (readTMVar cVar) >>= \case
         Just (Right client) -> closeXFTPClient client `catchAll_` pure ()
         _ -> pure ()

src/Simplex/FileTransfer/Client/Main.hs

@@ -43,6 +43,8 @@ import Simplex.FileTransfer.Client.Agent
 import Simplex.FileTransfer.Description
 import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
+import Simplex.FileTransfer.Types
+import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
@@ -52,7 +54,7 @@ import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SenderId, SndPrivat
 import Simplex.Messaging.Server.CLI (getCliCommand')
 import Simplex.Messaging.Util (ifM, tshow, whenM)
 import System.Exit (exitFailure)
-import System.FilePath (splitExtensions, splitFileName, (</>))
+import System.FilePath (splitFileName, (</>))
 import System.IO.Temp (getCanonicalTemporaryDirectory)
 import System.Random (StdGen, newStdGen, randomR)
 import UnliftIO
@@ -79,9 +81,6 @@ maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize
 fileSizeLen :: Int64
 fileSizeLen = 8
 
-authTagSize :: Int64
-authTagSize = fromIntegral C.authTagSize
-
 newtype CLIError = CLIError String
   deriving (Eq, Show, Exception)
 
@@ -257,19 +256,6 @@ runE a =
     Left (CLIError e) -> putStrLn e >> exitFailure
     _ -> pure ()
 
--- fileExtra is added to allow header extension in future versions
-data FileHeader = FileHeader
-  { fileName :: String,
-    fileExtra :: Maybe String
-  }
-  deriving (Eq, Show)
-
-instance Encoding FileHeader where
-  smpEncode FileHeader {fileName, fileExtra} = smpEncode (fileName, fileExtra)
-  smpP = do
-    (fileName, fileExtra) <- smpP
-    pure FileHeader {fileName, fileExtra}
-
 cliSendFile :: SendOptions -> ExceptT CLIError IO ()
 cliSendFile SendOptions {filePath, outputDir, numRecipients, xftpServers, retryCount, tempPath, verbose} = do
   let (_, fileName) = splitFileName filePath
@@ -578,15 +564,6 @@ prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) c
 getEncPath :: MonadIO m => Maybe FilePath -> String -> m FilePath
 getEncPath path name = (`uniqueCombine` (name <> ".encrypted")) =<< maybe (liftIO getCanonicalTemporaryDirectory) pure path
 
-uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
-uniqueCombine filePath fileName = tryCombine (0 :: Int)
-  where
-    tryCombine n =
-      let (name, ext) = splitExtensions fileName
-          suffix = if n == 0 then "" else "_" <> show n
-          f = filePath </> (name <> suffix <> ext)
-       in ifM (doesPathExist f) (tryCombine $ n + 1) (pure f)
-
 withReconnect :: Show e => XFTPClientAgent -> XFTPServer -> Int -> (XFTPClient -> ExceptT e IO a) -> ExceptT CLIError IO a
 withReconnect a srv n run = withRetry n $ do
   c <- withRetry n $ getXFTPServerClient a srv