core: store/get remote files (#3289)

* core: store remote files (wip)

* fix/test store remote file

* get remote file

* get file

* validate remote file metadata before sending to controller

* CLI commands, test

* update store method

simplex-chat.cabal

@@ -32,6 +32,7 @@ library
       Simplex.Chat.Call
       Simplex.Chat.Controller
       Simplex.Chat.Core
+      Simplex.Chat.Files
       Simplex.Chat.Help
       Simplex.Chat.Markdown
       Simplex.Chat.Messages
@@ -131,6 +132,7 @@ library
       Simplex.Chat.Remote.Discovery
       Simplex.Chat.Remote.Multicast
       Simplex.Chat.Remote.Protocol
+      Simplex.Chat.Remote.Transport
       Simplex.Chat.Remote.Types
       Simplex.Chat.Store
       Simplex.Chat.Store.Connections

src/Simplex/Chat.hs

@@ -55,6 +55,7 @@ import qualified Database.SQLite.Simple as SQL
 import Simplex.Chat.Archive
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
+import Simplex.Chat.Files
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
@@ -104,7 +105,7 @@ import Simplex.Messaging.Transport.Client (defaultSocksProxy)
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
 import System.Exit (exitFailure, exitSuccess)
-import System.FilePath (combine, splitExtensions, takeFileName, (</>))
+import System.FilePath (takeFileName, (</>))
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, stdout)
 import System.Random (randomRIO)
 import Text.Read (readMaybe)
@@ -213,6 +214,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   currentCalls <- atomically TM.empty
   localDeviceName <- newTVarIO "" -- TODO set in config
   remoteHostSessions <- atomically TM.empty
+  remoteHostsFolder <- newTVarIO Nothing
   remoteCtrlSession <- newTVarIO Nothing
   filesFolder <- newTVarIO optFilesFolder
   chatStoreChanged <- newTVarIO False
@@ -246,6 +248,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
         currentCalls,
         localDeviceName,
         remoteHostSessions,
+        remoteHostsFolder,
         remoteCtrlSession,
         config,
         filesFolder,
@@ -394,7 +397,7 @@ execChatCommand rh s = do
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
     Right cmd -> case rh of
-      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId s
+      Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId cmd s
       _ -> execChatCommand_ u cmd
 
 execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
@@ -403,8 +406,8 @@ execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` c
 execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
 execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd
 
-execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ByteString -> m ChatResponse
+execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ChatCommand -> ByteString -> m ChatResponse
-execRemoteCommand u rhId s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh s
+execRemoteCommand u rhId cmd s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh cmd s
 
 handleCommandError :: ChatMonad' m => Maybe User -> ExceptT ChatError m ChatResponse -> m ChatResponse
 handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catch` (pure . Left . mkChatError))
@@ -542,6 +545,10 @@ processChatCommand = \case
     createDirectoryIfMissing True ff
     asks filesFolder >>= atomically . (`writeTVar` Just ff)
     ok_
+  SetRemoteHostsFolder rf -> do
+    createDirectoryIfMissing True rf
+    chatWriteVar remoteHostsFolder $ Just rf
+    ok_
   APISetXFTPConfig cfg -> do
     asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
     ok_
@@ -1795,15 +1802,15 @@ processChatCommand = \case
     asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_
   SendFile chatName f -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCFile "")
+    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "")
-  SendImage chatName f -> withUser $ \user -> do
+  SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    filePath <- toFSFilePath f
+    filePath <- toFSFilePath fPath
-    unless (any (`isSuffixOf` map toLower f) imageExtensions) $ throwChatError CEFileImageType {filePath}
+    unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath}
     fileSize <- getFileSize filePath
     unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
     -- TODO include file description for preview
-    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just $ CF.plain f) Nothing (MCImage "" fixedImagePreview)
+    processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
   ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
   ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
   SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
@@ -1905,19 +1912,21 @@ processChatCommand = \case
     let pref = uncurry TimedMessagesGroupPreference $ maybe (FEOff, Just 86400) (\ttl -> (FEOn, Just ttl)) ttl_
     updateGroupProfileByName gName $ \p ->
       p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
-  SetLocalDeviceName name -> withUser $ \_ -> chatWriteVar localDeviceName name >> ok_
+  SetLocalDeviceName name -> withUser_ $ chatWriteVar localDeviceName name >> ok_
   CreateRemoteHost -> CRRemoteHostCreated <$> createRemoteHost
   ListRemoteHosts -> CRRemoteHostList <$> listRemoteHosts
   StartRemoteHost rh -> startRemoteHost rh >> ok_
   StopRemoteHost rh -> closeRemoteHostSession rh >> ok_
   DeleteRemoteHost rh -> deleteRemoteHost rh >> ok_
-  StartRemoteCtrl -> startRemoteCtrl (execChatCommand Nothing) >> ok_
+  StoreRemoteFile rh encrypted_ localPath -> CRRemoteFileStored rh <$> storeRemoteFile rh encrypted_ localPath
-  RegisterRemoteCtrl oob -> CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
+  GetRemoteFile rh rf -> getRemoteFile rh rf >> ok_
-  AcceptRemoteCtrl rc -> acceptRemoteCtrl rc >> ok_
+  StartRemoteCtrl -> withUser_ $ startRemoteCtrl (execChatCommand Nothing) >> ok_
-  RejectRemoteCtrl rc -> rejectRemoteCtrl rc >> ok_
+  RegisterRemoteCtrl oob -> withUser_ $ CRRemoteCtrlRegistered <$> withStore' (`insertRemoteCtrl` oob)
-  StopRemoteCtrl -> stopRemoteCtrl >> ok_
+  AcceptRemoteCtrl rc -> withUser_ $ acceptRemoteCtrl rc >> ok_
-  ListRemoteCtrls -> CRRemoteCtrlList <$> listRemoteCtrls
+  RejectRemoteCtrl rc -> withUser_ $ rejectRemoteCtrl rc >> ok_
-  DeleteRemoteCtrl rc -> deleteRemoteCtrl rc >> ok_
+  StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_
+  ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls
+  DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_
   QuitChat -> liftIO exitSuccess
   ShowVersion -> do
     let versionInfo = coreVersionInfo $(simplexmqCommitQ)
@@ -2173,14 +2182,14 @@ processChatCommand = \case
     withServerProtocol p action = case userProtocol p of
       Just Dict -> action
       _ -> throwChatError $ CEServerProtocol $ AProtocolType p
-    forwardFile :: ChatName -> FileTransferId -> (ChatName -> FilePath -> ChatCommand) -> m ChatResponse
+    forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> m ChatResponse
     forwardFile chatName fileId sendCommand = withUser $ \user -> do
       withStore (\db -> getFileTransfer db user fileId) >>= \case
-        FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}} -> forward filePath
+        FTRcv RcvFileTransfer {fileStatus = RFSComplete RcvFileInfo {filePath}, cryptoArgs} -> forward filePath cryptoArgs
-        FTSnd {fileTransferMeta = FileTransferMeta {filePath}} -> forward filePath
+        FTSnd {fileTransferMeta = FileTransferMeta {filePath, xftpSndFile}} -> forward filePath $ xftpSndFile >>= \f -> f.cryptoArgs
         _ -> throwChatError CEFileNotReceived {fileId}
       where
-        forward = processChatCommand . sendCommand chatName
+        forward path cfArgs = processChatCommand . sendCommand chatName $ CryptoFile path cfArgs
     getGroupAndMemberId :: User -> GroupName -> ContactName -> m (GroupId, GroupMemberId)
     getGroupAndMemberId user gName groupMemberName =
       withStore $ \db -> do
@@ -2575,10 +2584,9 @@ startReceivingFile user fileId = do
 getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> Bool -> m FilePath
 getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
   Nothing ->
-    asks filesFolder >>= readTVarIO >>= \case
+    chatReadVar filesFolder >>= \case
-      Nothing -> do
+      Nothing ->
-        dir <- (`combine` "Downloads") <$> getHomeDirectory
+        getDefaultFilesFolder
-        ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory
           >>= (`uniqueCombine` fn)
           >>= createEmptyFile
       Just filesFolder ->
@@ -2607,18 +2615,6 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
     getTmpHandle :: FilePath -> m Handle
     getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show)
 
-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 `combine` (name <> suffix <> ext)
-       in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
-
-getChatTempDirectory :: ChatMonad m => m FilePath
-getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
-
 acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
 acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do
   subMode <- chatReadVar subscriptionMode
@@ -5575,6 +5571,9 @@ withUser :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse
 withUser action = withUser' $ \user ->
   ifM chatStarted (action user) (throwChatError CEChatNotStarted)
 
+withUser_ :: ChatMonad m => m ChatResponse -> m ChatResponse
+withUser_ = withUser . const
+
 withUserId :: ChatMonad m => UserId -> (User -> m ChatResponse) -> m ChatResponse
 withUserId userId action = withUser $ \user -> do
   checkSameUser userId user
@@ -5635,6 +5634,7 @@ chatCommandP =
       "/_resubscribe all" $> ResubscribeAllConnections,
       "/_temp_folder " *> (SetTempFolder <$> filePath),
       ("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
+      "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath),
       "/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
       "/xftp " *> (APISetXFTPConfig <$> ("on" *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
       "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP),
@@ -5809,8 +5809,8 @@ chatCommandP =
       "/show" *> (ShowLiveItems <$> (A.space *> onOffP <|> pure True)),
       "/show " *> (ShowChatItem . Just <$> A.decimal),
       "/item info " *> (ShowChatItemInfo <$> chatNameP <* A.space <*> msgTextP),
-      ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath),
+      ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> cryptoFileP),
-      ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
+      ("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> cryptoFileP),
       ("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
       ("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
       ("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
@@ -5858,6 +5858,8 @@ chatCommandP =
       "/start remote host " *> (StartRemoteHost <$> A.decimal),
       "/stop remote host " *> (StopRemoteHost <$> A.decimal),
       "/delete remote host " *> (DeleteRemoteHost <$> A.decimal),
+      "/store remote file " *> (StoreRemoteFile <$> A.decimal <*> optional (" encrypt=" *> onOffP) <* A.space <*> filePath),
+      "/get remote file " *> (GetRemoteFile <$> A.decimal <* A.space <*> jsonP),
       "/start remote ctrl" $> StartRemoteCtrl,
       "/register remote ctrl " *> (RegisterRemoteCtrl <$> (RemoteCtrlOOB <$> strP <* A.space <*> textP)),
       "/_register remote ctrl " *> (RegisterRemoteCtrl <$> jsonP),
@@ -5932,6 +5934,10 @@ chatCommandP =
     msgTextP = jsonP <|> textP
     stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString
     filePath = stringP
+    cryptoFileP = do
+      cfArgs <- optional $ CFArgs <$> (" key=" *> strP <* A.space) <*> (" nonce=" *> strP)
+      path <- filePath
+      pure $ CryptoFile path cfArgs
     memberRole =
       A.choice
         [ " owner" $> GROwner,

src/Simplex/Chat/Archive.hs

@@ -9,6 +9,7 @@ module Simplex.Chat.Archive
     importArchive,
     deleteStorage,
     sqlCipherExport,
+    archiveFilesFolder,
   )
 where
 

src/Simplex/Chat/Controller.hs

@@ -178,6 +178,7 @@ data ChatController = ChatController
     currentCalls :: TMap ContactId Call,
     localDeviceName :: TVar Text,
     remoteHostSessions :: TMap RemoteHostId RemoteHostSession, -- All the active remote hosts
+    remoteHostsFolder :: TVar (Maybe FilePath), -- folder for remote hosts data
     remoteCtrlSession :: TVar (Maybe RemoteCtrlSession), -- Supervisor process for hosted controllers
     config :: ChatConfig,
     filesFolder :: TVar (Maybe FilePath), -- path to files folder for mobile apps,
@@ -224,6 +225,7 @@ data ChatCommand
   | ResubscribeAllConnections
   | SetTempFolder FilePath
   | SetFilesFolder FilePath
+  | SetRemoteHostsFolder FilePath
   | APISetXFTPConfig (Maybe XFTPFileConfig)
   | APISetEncryptLocalFiles Bool
   | SetContactMergeEnabled Bool
@@ -393,8 +395,8 @@ data ChatCommand
   | ShowChatItem (Maybe ChatItemId) -- UserId (not used in UI)
   | ShowChatItemInfo ChatName Text
   | ShowLiveItems Bool
-  | SendFile ChatName FilePath
+  | SendFile ChatName CryptoFile
-  | SendImage ChatName FilePath
+  | SendImage ChatName CryptoFile
   | ForwardFile ChatName FileTransferId
   | ForwardImage ChatName FileTransferId
   | SendFileDescription ChatName FilePath
@@ -419,6 +421,8 @@ data ChatCommand
   -- | SwitchRemoteHost (Maybe RemoteHostId) -- ^ Switch current remote host
   | StopRemoteHost RemoteHostId -- ^ Shut down a running session
   | DeleteRemoteHost RemoteHostId -- ^ Unregister remote host and remove its data
+  | StoreRemoteFile {remoteHostId :: RemoteHostId, storeEncrypted :: Maybe Bool, localPath :: FilePath}
+  | GetRemoteFile {remoteHostId :: RemoteHostId, file :: RemoteFile}
   | StartRemoteCtrl -- ^ Start listening for announcements from all registered controllers
   | RegisterRemoteCtrl RemoteCtrlOOB -- ^ Register OOB data for satellite discovery and handshake
   | ListRemoteCtrls
@@ -440,22 +444,27 @@ allowRemoteCommand = \case
   StartChat {} -> False
   APIStopChat -> False
   APIActivateChat -> False
-  APISuspendChat {} -> False
+  APISuspendChat _ -> False
-  SetTempFolder {} -> False
+  SetTempFolder _ -> False
   QuitChat -> False
   CreateRemoteHost -> False
   ListRemoteHosts -> False
-  StartRemoteHost {} -> False
+  StartRemoteHost _ -> False
   -- SwitchRemoteHost {} -> False
-  StopRemoteHost {} -> False
+  StoreRemoteFile {} -> False
-  DeleteRemoteHost {} -> False
+  GetRemoteFile {} -> False
+  StopRemoteHost _ -> False
+  DeleteRemoteHost _ -> False
   RegisterRemoteCtrl {} -> False
   StartRemoteCtrl -> False
   ListRemoteCtrls -> False
-  AcceptRemoteCtrl {} -> False
+  AcceptRemoteCtrl _ -> False
-  RejectRemoteCtrl {} -> False
+  RejectRemoteCtrl _ -> False
   StopRemoteCtrl -> False
-  DeleteRemoteCtrl {} -> False
+  DeleteRemoteCtrl _ -> False
+  ExecChatStoreSQL _ -> False
+  ExecAgentStoreSQL _ -> False
+  SlowSQLQueries -> False
   _ -> True
 
 data ChatResponse
@@ -627,6 +636,7 @@ data ChatResponse
   | CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
   | CRRemoteHostConnected {remoteHost :: RemoteHostInfo}
   | CRRemoteHostStopped {remoteHostId :: RemoteHostId}
+  | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrl :: RemoteCtrlInfo}
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation

src/Simplex/Chat/Files.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Simplex.Chat.Files where
+
+import Control.Monad.IO.Class
+import Simplex.Chat.Controller
+import Simplex.Messaging.Util (ifM)
+import System.FilePath (splitExtensions, combine)
+import UnliftIO.Directory (doesFileExist, getTemporaryDirectory, getHomeDirectory, doesDirectoryExist)
+
+uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
+uniqueCombine fPath fName = tryCombine (0 :: Int)
+  where
+    tryCombine n =
+      let (name, ext) = splitExtensions fName
+          suffix = if n == 0 then "" else "_" <> show n
+          f = fPath `combine` (name <> suffix <> ext)
+       in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
+
+getChatTempDirectory :: ChatMonad m => m FilePath
+getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
+
+getDefaultFilesFolder :: ChatMonad m => m FilePath
+getDefaultFilesFolder = do
+  dir <- (`combine` "Downloads") <$> getHomeDirectory
+  ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory

src/Simplex/Chat/Messages.hs

@@ -24,6 +24,7 @@ import qualified Data.Aeson.TH as JQ
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Char (isSpace)
 import Data.Int (Int64)
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
@@ -53,7 +54,7 @@ data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection
 data ChatName = ChatName {chatType :: ChatType, chatName :: Text}
   deriving (Show)
 
-chatTypeStr :: ChatType -> String
+chatTypeStr :: ChatType -> Text
 chatTypeStr = \case
   CTDirect -> "@"
   CTGroup -> "#"
@@ -61,7 +62,7 @@ chatTypeStr = \case
   CTContactConnection -> ":"
 
 chatNameStr :: ChatName -> String
-chatNameStr (ChatName cType name) = chatTypeStr cType <> T.unpack name
+chatNameStr (ChatName cType name) = T.unpack $ chatTypeStr cType <> if T.any isSpace name then "'" <> name <> "'" else name
 
 data ChatRef = ChatRef ChatType Int64
   deriving (Eq, Show, Ord)

src/Simplex/Chat/Mobile/File.hs

@@ -99,7 +99,7 @@ chatEncryptFile fromPath toPath =
   either WFError WFResult <$> runCatchExceptT encrypt
   where
     encrypt = do
-      cfArgs <- liftIO $ CF.randomArgs
+      cfArgs <- liftIO CF.randomArgs
       encryptFile fromPath toPath cfArgs
       pure cfArgs
 

src/Simplex/Chat/Remote.hs

@@ -16,7 +16,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Control.Monad.Reader (asks)
+import Control.Monad.Reader
 import Control.Monad.STM (retry)
 import Crypto.Random (getRandomBytes)
 import qualified Data.Aeson as J
@@ -34,21 +34,35 @@ import Data.Word (Word32)
 import Network.HTTP2.Server (responseStreaming)
 import qualified Network.HTTP.Types as N
 import Network.Socket (SockAddr (..), hostAddressToTuple)
+import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller
+import Simplex.Chat.Files
+import Simplex.Chat.Messages (chatNameStr)
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import Simplex.Chat.Remote.Protocol
+import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Remote
+import Simplex.Chat.Store.Shared
+import Simplex.Chat.Types (User (..))
+import Simplex.Chat.Util (encryptFile)
+import Simplex.FileTransfer.Description (FileDigest (..))
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
+import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
-import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
-import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=))
+import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
-import System.FilePath ((</>))
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (ifM, liftEitherError, liftEitherWith, liftError, liftIOEither, tryAllErrors, tshow, ($>>=), (<$$>))
+import System.FilePath ((</>), takeFileName)
 import UnliftIO
+import UnliftIO.Directory (copyFile, createDirectoryIfMissing, renameFile)
+import Data.Functor (($>))
+import Control.Applicative ((<|>))
 
 -- * Desktop side
 
@@ -110,7 +124,7 @@ startRemoteHost rhId = do
       toView $ CRRemoteHostConnected RemoteHostInfo
         { remoteHostId = rhId,
           storePath = storePath,
-          displayName = remoteDeviceName remoteHostClient,
+          displayName = hostDeviceName remoteHostClient,
           remoteCtrlOOB = RemoteCtrlOOB {fingerprint, displayName=rcName},
           sessionActive = True
         }
@@ -178,9 +192,57 @@ deleteRemoteHost rhId = do
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' (`deleteRemoteHostRecord` rhId)
 
-processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ByteString -> m ChatResponse
+storeRemoteFile :: forall m. ChatMonad m => RemoteHostId -> Maybe Bool -> FilePath -> m CryptoFile
-processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} s = liftRH remoteHostId $ remoteSend rhc s
+storeRemoteFile rhId encrypted_ localPath = do
-processRemoteCommand _ _ _ = pure $ chatCmdError Nothing "remote command sent before session started"
+  RemoteHostSession {remoteHostClient, storePath} <- getRemoteHostSession rhId
+  case remoteHostClient of
+    Nothing -> throwError $ ChatErrorRemoteHost rhId RHMissing
+    Just c@RemoteHostClient {encryptHostFiles} -> do
+      let encrypt = fromMaybe encryptHostFiles encrypted_
+      cf@CryptoFile {filePath} <- if encrypt then encryptLocalFile else pure $ CF.plain localPath
+      filePath' <- liftRH rhId $ remoteStoreFile c filePath (takeFileName localPath)
+      hf_ <- chatReadVar remoteHostsFolder
+      forM_ hf_ $ \hf -> do
+        let rhf = hf </> storePath </> archiveFilesFolder
+            hPath = rhf </> takeFileName filePath'
+        createDirectoryIfMissing True rhf
+        (if encrypt then renameFile else copyFile) filePath hPath
+      pure (cf :: CryptoFile) {filePath = filePath'}
+  where
+    encryptLocalFile :: m CryptoFile
+    encryptLocalFile = do
+      tmpDir <- getChatTempDirectory
+      createDirectoryIfMissing True tmpDir
+      tmpFile <- tmpDir `uniqueCombine` takeFileName localPath
+      cfArgs <- liftIO CF.randomArgs
+      liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs
+      pure $ CryptoFile tmpFile $ Just cfArgs
+
+getRemoteFile :: ChatMonad m => RemoteHostId -> RemoteFile -> m ()
+getRemoteFile rhId rf = do
+  RemoteHostSession {remoteHostClient, storePath} <- getRemoteHostSession rhId
+  case remoteHostClient of
+    Nothing -> throwError $ ChatErrorRemoteHost rhId RHMissing
+    Just c -> do
+      dir <- (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar remoteHostsFolder)
+      createDirectoryIfMissing True dir
+      liftRH rhId $ remoteGetFile c dir rf
+
+processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostSession -> ChatCommand -> ByteString -> m ChatResponse
+processRemoteCommand remoteHostId RemoteHostSession {remoteHostClient = Just rhc} cmd s = case cmd of
+  SendFile chatName f -> sendFile "/f" chatName f
+  SendImage chatName f -> sendFile "/img" chatName f    
+  _ -> liftRH remoteHostId $ remoteSend rhc s
+  where
+    sendFile cmdName chatName (CryptoFile path cfArgs) = do
+      -- don't encrypt in host if already encrypted locally
+      CryptoFile path' cfArgs' <- storeRemoteFile remoteHostId (cfArgs $> False) path
+      let f = CryptoFile path' (cfArgs <|> cfArgs') -- use local or host encryption
+      liftRH remoteHostId $ remoteSend rhc $ B.unwords [cmdName, B.pack (chatNameStr chatName), cryptoFileStr f]
+    cryptoFileStr CryptoFile {filePath, cryptoArgs} =
+      maybe "" (\(CFArgs key nonce) -> "key=" <> strEncode key <> " nonce=" <> strEncode nonce <> " ") cryptoArgs
+        <> encodeUtf8 (T.pack filePath)
+processRemoteCommand _ _ _ _ = pure $ chatCmdError Nothing "remote command sent before session started"
 
 liftRH :: ChatMonad m => RemoteHostId -> ExceptT RemoteProtocolError IO a -> m a
 liftRH rhId = liftError (ChatErrorRemoteHost rhId . RHProtocolError)
@@ -218,20 +280,24 @@ handleRemoteCommand :: forall m . ChatMonad m => (ByteString -> m ChatResponse)
 handleRemoteCommand execChatCommand remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
   liftRC (tryRemoteError parseRequest) >>= \case
-    Right (getNext, rc) -> processCommand getNext rc `catchAny` (reply . RRProtocolError . RPEException . tshow)
+    Right (getNext, rc) -> do
+      chatReadVar currentUser >>= \case
+        Nothing -> replyError $ ChatError CENoActiveUser
+        Just user -> processCommand user getNext rc `catchChatError` replyError
     Left e -> reply $ RRProtocolError e
   where
     parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand)
     parseRequest = do
       (header, getNext) <- parseHTTP2Body request reqBody
       (getNext,) <$> liftEitherWith (RPEInvalidJSON . T.pack) (J.eitherDecodeStrict' header)
-    processCommand :: GetChunk -> RemoteCommand -> m ()
+    replyError = reply . RRChatResponse . CRChatCmdError Nothing
-    processCommand getNext = \case
+    processCommand :: User -> GetChunk -> RemoteCommand -> m ()
+    processCommand user getNext = \case
       RCHello {deviceName = desktopName} -> handleHello desktopName >>= reply
       RCSend {command} -> handleSend execChatCommand command >>= reply
       RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
-      RCStoreFile {fileSize, encrypt} -> handleStoreFile fileSize encrypt getNext >>= reply
+      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile fileName fileSize fileDigest getNext >>= reply
-      RCGetFile {filePath} -> handleGetFile filePath replyWith
+      RCGetFile {file} -> handleGetFile user file replyWith
     reply :: RemoteResponse -> m ()
     reply = (`replyWith` \_ -> pure ())
     replyWith :: Respond m
@@ -258,7 +324,8 @@ handleHello :: ChatMonad m => Text -> m RemoteResponse
 handleHello desktopName = do
   logInfo $ "Hello from " <> tshow desktopName
   mobileName <- chatReadVar localDeviceName
-  pure RRHello {encoding = localEncoding, deviceName = mobileName}
+  encryptFiles <- chatReadVar encryptLocalFiles
+  pure RRHello {encoding = localEncoding, deviceName = mobileName, encryptFiles}
 
 handleSend :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteResponse
 handleSend execChatCommand command = do
@@ -272,20 +339,36 @@ handleRecv time events = do
   logDebug $ "Recv: " <> tshow time
   RRChatEvent <$> (timeout time . atomically $ readTBQueue events)
 
-handleStoreFile :: ChatMonad m => Word32 -> Maybe Bool -> GetChunk -> m RemoteResponse
+-- TODO this command could remember stored files and return IDs to allow removing files that are not needed.
-handleStoreFile _fileSize _encrypt _getNext = error "TODO" <$ logError "TODO: handleStoreFile"
+-- Also, there should be some process removing unused files uploaded to remote host (possibly, all unused files).
+handleStoreFile :: forall m. ChatMonad m => FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
+handleStoreFile fileName fileSize fileDigest getChunk =
+  either RRProtocolError RRFileStored <$> (chatReadVar filesFolder >>= storeFile)
+  where
+    storeFile :: Maybe FilePath -> m (Either RemoteProtocolError FilePath)
+    storeFile = \case
+      Just ff -> takeFileName <$$> storeFileTo ff
+      Nothing -> storeFileTo =<< getDefaultFilesFolder
+    storeFileTo :: FilePath -> m (Either RemoteProtocolError FilePath)
+    storeFileTo dir = liftRC . tryRemoteError $ do
+      filePath <- dir `uniqueCombine` fileName
+      receiveRemoteFile getChunk fileSize fileDigest filePath
+      pure filePath
 
-handleGetFile :: ChatMonad m => FilePath -> Respond m -> m ()
+handleGetFile :: ChatMonad m => User -> RemoteFile -> Respond m -> m ()
-handleGetFile path reply = do
+handleGetFile User {userId} RemoteFile{userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
-  logDebug $ "GetFile: " <> tshow path
+  logDebug $ "GetFile: " <> tshow filePath
-  withFile path ReadMode $ \h -> do
+  unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId}
-    fileSize' <- hFileSize h
+  path <- maybe filePath (</> filePath) <$> chatReadVar filesFolder
-    when (fileSize' > toInteger (maxBound :: Word32)) $ throwIO RPEFileTooLarge
+  withStore $ \db -> do
-    let fileSize = fromInteger fileSize'
+    cf <- getLocalCryptoFile db commandUserId fileId sent
-    reply RRFile {fileSize} $ \send -> hSendFile h send fileSize
+    unless (cf == cf') $ throwError $ SEFileNotFound fileId
+  liftRC (tryRemoteError $ getFileInfo path) >>= \case
+    Left e -> reply (RRProtocolError e) $ \_ -> pure ()
+    Right (fileSize, fileDigest) ->
+      withFile path ReadMode $ \h ->
+        reply RRFile {fileSize, fileDigest} $ \send -> hSendFile h send fileSize
 
--- TODO the problem with this code was that it wasn't clear where the recursion can happen,
--- by splitting receiving and processing to two functions it becomes clear
 discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash TransportHost -> m ()
 discoverRemoteCtrls discovered = Discovery.withListener $ receive >=> process
   where

src/Simplex/Chat/Remote/Protocol.hs

@@ -20,7 +20,7 @@ import Data.Aeson.TH (deriveJSON)
 import qualified Data.Aeson.Types as JT
 import Data.ByteString (ByteString)
 import Data.ByteString.Builder (Builder, word32BE, lazyByteString)
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy as LB
 import Data.String (fromString)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
@@ -28,34 +28,35 @@ import Data.Word (Word32)
 import qualified Network.HTTP.Types as N
 import qualified Network.HTTP2.Client as H
 import Network.Transport.Internal (decodeWord32)
-import Simplex.Chat.Controller (ChatResponse)
+import Simplex.Chat.Controller
+import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
-import Simplex.Messaging.Crypto.File (CryptoFile)
+import Simplex.FileTransfer.Description (FileDigest (..))
+import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag)
 import Simplex.Messaging.Transport.Buffer (getBuffered)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
-import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile, hSendFile)
+import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
-import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow, whenM)
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith, tshow)
-import System.FilePath ((</>))
+import System.FilePath ((</>), takeFileName)
 import UnliftIO
-import UnliftIO.Directory (doesFileExist, getFileSize)
 
 data RemoteCommand
   = RCHello {deviceName :: Text}
   | RCSend {command :: Text} -- TODO maybe ChatCommand here?
   | RCRecv {wait :: Int} -- this wait should be less than HTTP timeout
   | -- local file encryption is determined by the host, but can be overridden for videos
-    RCStoreFile {fileSize :: Word32, encrypt :: Maybe Bool} -- requires attachment
+    RCStoreFile {fileName :: String, fileSize :: Word32, fileDigest :: FileDigest} -- requires attachment
-  | RCGetFile {filePath :: FilePath}
+  | RCGetFile {file :: RemoteFile}
   deriving (Show)
 
 data RemoteResponse
-  = RRHello {encoding :: PlatformEncoding, deviceName :: Text}
+  = RRHello {encoding :: PlatformEncoding, deviceName :: Text, encryptFiles :: Bool}
   | RRChatResponse {chatResponse :: ChatResponse}
   | RRChatEvent {chatEvent :: Maybe ChatResponse} -- ^ 'Nothing' on poll timeout
-  | RRFileStored {fileSource :: CryptoFile}
+  | RRFileStored {filePath :: String}
-  | RRFile {fileSize :: Word32} -- provides attachment
+  | RRFile {fileSize :: Word32, fileDigest :: FileDigest} -- provides attachment , fileDigest :: FileDigest
   | RRProtocolError {remoteProcotolError :: RemoteProtocolError} -- ^ The protocol error happened on the server side
   deriving (Show)
 
@@ -67,14 +68,13 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 createRemoteHostClient :: HTTP2Client -> Text -> ExceptT RemoteProtocolError IO RemoteHostClient
 createRemoteHostClient httpClient desktopName = do
-  logInfo "Sending initial hello"
+  logDebug "Sending initial hello"
-  (_getNext, rr) <- sendRemoteCommand httpClient localEncoding Nothing RCHello {deviceName = desktopName}
+  sendRemoteCommand' httpClient localEncoding Nothing RCHello {deviceName = desktopName} >>= \case
-  case rr of
+    RRHello {encoding, deviceName = mobileName, encryptFiles} -> do
-    rrh@RRHello {encoding, deviceName = mobileName} -> do
+      logDebug "Got initial hello"
-      logInfo $ "Got initial hello: " <> tshow rrh
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError RPEIncompatibleEncoding
-      pure RemoteHostClient {remoteEncoding = encoding, remoteDeviceName = mobileName, httpClient}
+      pure RemoteHostClient {hostEncoding = encoding, hostDeviceName = mobileName, httpClient, encryptHostFiles = encryptFiles}
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+    r -> badResponse r
 
 closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
 closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
@@ -82,48 +82,37 @@ closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client
 -- ** Commands
 
 remoteSend :: RemoteHostClient -> ByteString -> ExceptT RemoteProtocolError IO ChatResponse
-remoteSend RemoteHostClient {httpClient, remoteEncoding} cmd = do
+remoteSend RemoteHostClient {httpClient, hostEncoding} cmd =
-  (_getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCSend {command = decodeUtf8 cmd}
+  sendRemoteCommand' httpClient hostEncoding Nothing RCSend {command = decodeUtf8 cmd} >>= \case
-  case rr of
     RRChatResponse cr -> pure cr
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+    r -> badResponse r
 
 remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
-remoteRecv RemoteHostClient {httpClient, remoteEncoding} ms = do
+remoteRecv RemoteHostClient {httpClient, hostEncoding} ms =
-  (_getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCRecv {wait=ms}
+  sendRemoteCommand' httpClient hostEncoding Nothing RCRecv {wait = ms} >>= \case
-  case rr of
     RRChatEvent cr_ -> pure cr_
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+    r -> badResponse r
 
-remoteStoreFile :: RemoteHostClient -> FilePath -> Maybe Bool -> ExceptT RemoteProtocolError IO CryptoFile
+remoteStoreFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
-remoteStoreFile RemoteHostClient {httpClient, remoteEncoding} localPath encrypt = do
+remoteStoreFile RemoteHostClient {httpClient, hostEncoding} localPath fileName = do
-  (_getNext, rr) <- withFile localPath ReadMode $ \h -> do
+  (fileSize, fileDigest) <- getFileInfo localPath
-    fileSize' <- hFileSize h
+  let send h = sendRemoteCommand' httpClient hostEncoding (Just (h, fileSize)) RCStoreFile {fileName, fileSize, fileDigest}
-    when (fileSize' > toInteger (maxBound :: Word32)) $ throwError RPEFileTooLarge
+  withFile localPath ReadMode send >>= \case
-    let fileSize = fromInteger fileSize'
+    RRFileStored {filePath = filePath'} -> pure filePath'
-    sendRemoteCommand httpClient remoteEncoding (Just (h, fileSize)) RCStoreFile {encrypt, fileSize}
+    r -> badResponse r
-  case rr of
-    RRFileStored {fileSource} -> pure fileSource
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
 
--- TODO this should work differently for CLI and UI clients
+remoteGetFile :: RemoteHostClient -> FilePath -> RemoteFile -> ExceptT RemoteProtocolError IO ()
--- CLI - potentially, create new unique names and report them as created
+remoteGetFile RemoteHostClient {httpClient, hostEncoding} destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
--- UI - always use the same names and report error if file already exists
+  sendRemoteCommand httpClient hostEncoding Nothing RCGetFile {file = rf} >>= \case
--- alternatively, CLI should also use a fixed folder for remote session
+    (getChunk, RRFile {fileSize, fileDigest}) -> do
--- Possibly, path in the database should be optional and CLI commands should allow configuring it per session or use temp or download folder
+      -- TODO we could optimize by checking size and hash before receiving the file
-remoteGetFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
+      let localPath = destDir </> takeFileName filePath
-remoteGetFile RemoteHostClient {httpClient, remoteEncoding} baseDir filePath = do
+      receiveRemoteFile getChunk fileSize fileDigest localPath
-  (getNext, rr) <- sendRemoteCommand httpClient remoteEncoding Nothing RCGetFile {filePath}
+    (_, r) -> badResponse r
-  expectedSize <- case rr of
+
-    RRFile {fileSize} -> pure fileSize
+-- TODO validate there is no attachment
-    _ -> throwError $ RPEUnexpectedResponse $ tshow rr
+sendRemoteCommand' :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse
-  whenM (liftIO $ doesFileExist localFile) $ throwError RPEStoredFileExists
+sendRemoteCommand' http remoteEncoding attachment_ rc = snd <$> sendRemoteCommand http remoteEncoding attachment_ rc
-  rc <- liftIO $ withFile localFile WriteMode $ \h -> hReceiveFile getNext h expectedSize
-  when (rc /= 0) $ throwError RPEInvalidSize
-  whenM ((== expectedSize) . fromIntegral <$> getFileSize localFile) $ throwError RPEInvalidSize
-  pure localFile
-  where
-    localFile = baseDir </> filePath
 
 sendRemoteCommand :: HTTP2Client -> PlatformEncoding -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
 sendRemoteCommand http remoteEncoding attachment_ rc = do
@@ -139,6 +128,12 @@ sendRemoteCommand http remoteEncoding attachment_ rc = do
         Just (h, sz) -> hSendFile h send sz
       flush
 
+badResponse :: RemoteResponse -> ExceptT RemoteProtocolError IO a
+badResponse = \case
+  RRProtocolError e -> throwError e
+  -- TODO handle chat errors?
+  r -> throwError $ RPEUnexpectedResponse $ tshow r
+
 -- * Transport-level wrappers
 
 convertJSON :: PlatformEncoding -> PlatformEncoding -> J.Value -> J.Value
@@ -183,7 +178,7 @@ pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
 
 -- | Convert a command or a response into 'Builder'.
 sizePrefixedEncode :: J.ToJSON a => a -> Builder
-sizePrefixedEncode value = word32BE (fromIntegral $ BL.length json) <> lazyByteString json
+sizePrefixedEncode value = word32BE (fromIntegral $ LB.length json) <> lazyByteString json
   where
     json = J.encode value
 

src/Simplex/Chat/Remote/Transport.hs

@@ -0,0 +1,27 @@
+module Simplex.Chat.Remote.Transport where
+
+import Control.Monad
+import Control.Monad.Except
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.Word (Word32)
+import Simplex.FileTransfer.Description (FileDigest (..))
+import Simplex.Chat.Remote.Types
+import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile)
+import UnliftIO
+import UnliftIO.Directory (getFileSize)
+
+receiveRemoteFile :: (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO ()
+receiveRemoteFile getChunk fileSize fileDigest toPath = do
+  diff <- liftIO $ withFile toPath WriteMode $ \h -> hReceiveFile getChunk h fileSize
+  unless (diff == 0) $ throwError RPEFileSize
+  digest <- liftIO $ LC.sha512Hash <$> LB.readFile toPath
+  unless (FileDigest digest == fileDigest) $ throwError RPEFileDigest
+
+getFileInfo :: FilePath -> ExceptT RemoteProtocolError IO (Word32, FileDigest)
+getFileInfo filePath = do
+  fileDigest <- liftIO $ FileDigest . LC.sha512Hash <$> LB.readFile filePath
+  fileSize' <- getFileSize filePath
+  when (fileSize' > toInteger (maxBound :: Word32)) $ throwError RPEFileSize
+  pure (fromInteger fileSize', fileDigest)

src/Simplex/Chat/Remote/Types.hs

@@ -10,14 +10,16 @@ import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
 import Data.Text (Text)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
 import UnliftIO
 
 data RemoteHostClient = RemoteHostClient
-  { remoteEncoding :: PlatformEncoding,
+  { hostEncoding :: PlatformEncoding,
-    remoteDeviceName :: Text,
+    hostDeviceName :: Text,
-    httpClient :: HTTP2Client
+    httpClient :: HTTP2Client,
+    encryptHostFiles :: Bool
   }
 
 data RemoteHostSession = RemoteHostSession
@@ -32,7 +34,8 @@ data RemoteProtocolError
   | RPEIncompatibleEncoding
   | RPEUnexpectedFile
   | RPENoFile
-  | RPEFileTooLarge
+  | RPEFileSize
+  | RPEFileDigest
   | RPEUnexpectedResponse {response :: Text} -- ^ Wrong response received for the command sent
   | RPEStoredFileExists -- ^ A file already exists in the destination position
   | RPEHTTP2 {http2Error :: Text}
@@ -87,7 +90,14 @@ data RemoteCtrlInfo = RemoteCtrlInfo
   }
   deriving (Show)
 
--- TODO: put into a proper place
+data RemoteFile = RemoteFile
+  { userId :: Int64,
+    fileId :: Int64,
+    sent :: Bool,
+    fileSource :: CryptoFile
+  }
+  deriving (Show)
+
 data PlatformEncoding
   = PESwift
   | PEKotlin
@@ -122,3 +132,5 @@ $(J.deriveJSON defaultJSON ''RemoteHostInfo)
 $(J.deriveJSON defaultJSON ''RemoteCtrl)
 
 $(J.deriveJSON defaultJSON ''RemoteCtrlInfo)
+
+$(J.deriveJSON defaultJSON ''RemoteFile)

src/Simplex/Chat/Store/Files.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -71,6 +72,7 @@ module Simplex.Chat.Store.Files
     getSndFileTransfer,
     getSndFileTransfers,
     getContactFileInfo,
+    getLocalCryptoFile,
     updateDirectCIFileStatus,
   )
 where
@@ -602,7 +604,10 @@ getRcvFileTransferById db fileId = do
   (user,) <$> getRcvFileTransfer db user fileId
 
 getRcvFileTransfer :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
-getRcvFileTransfer db User {userId} fileId = do
+getRcvFileTransfer db User {userId} = getRcvFileTransfer_ db userId
+
+getRcvFileTransfer_ :: DB.Connection -> UserId -> FileTransferId -> ExceptT StoreError IO RcvFileTransfer
+getRcvFileTransfer_ db userId fileId = do
   rftRow <-
     ExceptT . firstRow id (SERcvFileNotFound fileId) $
       DB.query
@@ -808,25 +813,26 @@ getFileTransferProgress db user fileId = do
 
 getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
 getFileTransfer db user@User {userId} fileId =
-  fileTransfer =<< liftIO getFileTransferRow
+  fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId)
   where
     fileTransfer :: [(Maybe Int64, Maybe Int64)] -> ExceptT StoreError IO FileTransfer
     fileTransfer [(Nothing, Just _)] = FTRcv <$> getRcvFileTransfer db user fileId
     fileTransfer _ = do
       (ftm, fts) <- getSndFileTransfer db user fileId
       pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts}
-    getFileTransferRow :: IO [(Maybe Int64, Maybe Int64)]
+
-    getFileTransferRow =
+getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64)]
-      DB.query
+getFileTransferRow_ db userId fileId =
-        db
+  DB.query
-        [sql|
+    db
-          SELECT s.file_id, r.file_id
+    [sql|
-          FROM files f
+      SELECT s.file_id, r.file_id
-          LEFT JOIN snd_files s ON s.file_id = f.file_id
+      FROM files f
-          LEFT JOIN rcv_files r ON r.file_id = f.file_id
+      LEFT JOIN snd_files s ON s.file_id = f.file_id
-          WHERE user_id = ? AND f.file_id = ?
+      LEFT JOIN rcv_files r ON r.file_id = f.file_id
-        |]
+      WHERE user_id = ? AND f.file_id = ?
-        (userId, fileId)
+    |]
+    (userId, fileId)
 
 getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
 getSndFileTransfer db user fileId = do
@@ -861,7 +867,10 @@ getSndFileTransfers_ db userId fileId =
         Nothing -> Left $ SESndFileInvalid fileId
 
 getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
-getFileTransferMeta db User {userId} fileId =
+getFileTransferMeta db User {userId} = getFileTransferMeta_ db userId
+
+getFileTransferMeta_ :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO FileTransferMeta
+getFileTransferMeta_ db userId fileId =
   ExceptT . firstRow fileTransferMeta (SEFileNotFound fileId) $
     DB.query
       db
@@ -883,6 +892,20 @@ getContactFileInfo db User {userId} Contact {contactId} =
   map toFileInfo
     <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.contact_id = ?") (userId, contactId)
 
+getLocalCryptoFile :: DB.Connection -> UserId -> Int64 -> Bool -> ExceptT StoreError IO CryptoFile
+getLocalCryptoFile db userId fileId sent =
+  liftIO (getFileTransferRow_ db userId fileId) >>= \case
+    [(Nothing, Just _)] -> do
+      when sent $ throwError $ SEFileNotFound fileId
+      RcvFileTransfer {fileStatus, cryptoArgs} <- getRcvFileTransfer_ db userId fileId
+      case fileStatus of
+        RFSComplete RcvFileInfo {filePath} -> pure $ CryptoFile filePath cryptoArgs
+        _ -> throwError $ SEFileNotFound fileId
+    _ -> do
+      unless sent $ throwError $ SEFileNotFound fileId
+      FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId
+      pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs
+
 updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
 updateDirectCIFileStatus db user fileId fileStatus = do
   aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId

src/Simplex/Chat/View.hs

@@ -14,6 +14,7 @@ module Simplex.Chat.View where
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
 import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
 import Data.Function (on)
@@ -76,7 +77,7 @@ serializeChatResponse :: (Maybe RemoteHostId, Maybe User) -> CurrentTime -> Time
 serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz remoteHost_
 
 responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
-responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
+responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
@@ -185,10 +186,10 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
   CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
   CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
-  CRRcvFileStart u ci -> ttyUser u $ receivingFile_' testView "started" ci
+  CRRcvFileStart u ci -> ttyUser u $ receivingFile_' hu testView "started" ci
-  CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' testView "completed" ci
+  CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' hu testView "completed" ci
   CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
-  CRRcvFileError u ci e -> ttyUser u $ receivingFile_' testView "error" ci <> [sShow e]
+  CRRcvFileError u ci e -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
   CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
   CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
   CRSndFileStartXFTP {} -> []
@@ -272,6 +273,9 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei
   CRRemoteHostList hs -> viewRemoteHosts hs
   CRRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
   CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
+  CRRemoteFileStored rhId (CryptoFile filePath cfArgs_) ->
+    [plain $ "file " <> filePath <> " stored on remote host " <> show rhId]
+      <> maybe [] ((: []) . plain . cryptoFileArgsStr testView) cfArgs_
   CRRemoteCtrlList cs -> viewRemoteCtrls cs
   CRRemoteCtrlRegistered RemoteCtrlInfo {remoteCtrlId = rcId} -> ["remote controller " <> sShow rcId <> " registered"]
   CRRemoteCtrlAnnounce fingerprint -> ["remote controller announced", "connection code:", plain $ strEncode fingerprint]
@@ -1493,18 +1497,25 @@ savingFile' (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource
   ["saving file " <> sShow fileId <> fileFrom chat chatDir <> " to " <> plain filePath]
 savingFile' _ = ["saving file"] -- shouldn't happen
 
-receivingFile_' :: Bool -> String -> AChatItem -> [StyledString]
+receivingFile_' :: (Maybe RemoteHostId, Maybe User) -> Bool -> String -> AChatItem -> [StyledString]
-receivingFile_' testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just (CryptoFile _ cfArgs_)}, chatDir}) =
+receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just f@(CryptoFile _ cfArgs_)}, chatDir}) =
-  [plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_
+  [plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_ <> getRemoteFileStr
   where
-    cfArgsStr (Just cfArgs@(CFArgs key nonce)) = [plain s | status == "completed"]
+    cfArgsStr (Just cfArgs) = [plain (cryptoFileArgsStr testView cfArgs) | status == "completed"]
-      where
-      s =
-        if testView
-          then LB.toStrict $ J.encode cfArgs
-          else "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce
     cfArgsStr _ = []
-receivingFile_' _ status _ = [plain status <> " receiving file"] -- shouldn't happen
+    getRemoteFileStr = case hu of
+      (Just rhId, Just User {userId}) | status == "completed" ->
+        [ "File received to connected remote host " <> sShow rhId,
+          "To download to this device use:",
+          highlight ("/get remote file " <> show rhId <> " " <> LB.unpack (J.encode RemoteFile {userId, fileId, sent = False, fileSource = f}))
+        ]
+      _ -> []
+receivingFile_' _ _ status _ = [plain status <> " receiving file"] -- shouldn't happen
+
+cryptoFileArgsStr :: Bool -> CryptoFileArgs -> ByteString
+cryptoFileArgsStr testView cfArgs@(CFArgs key nonce)
+  | testView = LB.toStrict $ J.encode cfArgs
+  | otherwise = "encryption key: " <> strEncode key <> ", nonce: " <> strEncode nonce
 
 fileFrom :: ChatInfo c -> CIDirection c d -> StyledString
 fileFrom (DirectChat ct) CIDirectRcv = " from " <> ttyContact' ct
@@ -1818,8 +1829,8 @@ viewChatError logLevel = \case
         Nothing -> ""
       cId :: Connection -> StyledString
       cId conn = sShow conn.connId
-  ChatErrorRemoteCtrl todo'rc -> [sShow todo'rc]
+  ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e]
-  ChatErrorRemoteHost remoteHostId todo'rh -> [sShow remoteHostId, sShow todo'rh]
+  ChatErrorRemoteHost rhId e -> [plain $ "remote host " <> show rhId <> " error: " <> show e]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
     sqliteError' = \case

tests/RemoteTests.hs

@@ -9,7 +9,9 @@ import ChatClient
 import ChatTests.Utils
 import Control.Logger.Simple
 import Control.Monad
+import qualified Data.Aeson as J
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
 import Network.HTTP.Types (ok200)
@@ -17,10 +19,14 @@ import qualified Network.HTTP2.Client as C
 import qualified Network.HTTP2.Server as S
 import qualified Network.Socket as N
 import qualified Network.TLS as TLS
+import Simplex.Chat.Archive (archiveFilesFolder)
+import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
 import qualified Simplex.Chat.Controller as Controller
+import Simplex.Chat.Mobile.File
 import Simplex.Chat.Remote.Types
 import qualified Simplex.Chat.Remote.Discovery as Discovery
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String
 import qualified Simplex.Messaging.Transport as Transport
 import Simplex.Messaging.Transport.Client (TransportHost (..))
@@ -28,7 +34,7 @@ import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Response (..), closeHTTP2Client, sendRequest)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import Simplex.Messaging.Util
-import System.FilePath (makeRelative, (</>))
+import System.FilePath ((</>))
 import Test.Hspec
 import UnliftIO
 import UnliftIO.Concurrent
@@ -41,7 +47,9 @@ remoteTests = describe "Remote" $ do
   it "performs protocol handshake" remoteHandshakeTest
   it "performs protocol handshake (again)" remoteHandshakeTest -- leaking servers regression check
   it "sends messages" remoteMessageTest
-  xit "sends files" remoteFileTest
+  describe "remote files" $ do
+    it "store/get/send/receive files" remoteStoreFileTest
+    it "should sends files from CLI wihtout /store" remoteCLIFileTest
 
 -- * Low-level TLS with ephemeral credentials
 
@@ -159,32 +167,158 @@ remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
   threadDelay 1000000
   logNote "done"
 
-remoteFileTest :: (HasCallStack) => FilePath -> IO ()
+remoteStoreFileTest :: HasCallStack => FilePath -> IO ()
-remoteFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
+remoteStoreFileTest =
+  testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob ->
+    withXFTPServer $ do
+      let mobileFiles = "./tests/tmp/mobile_files"
+      mobile ##> ("/_files_folder " <> mobileFiles)
+      mobile <## "ok"
+      let desktopFiles = "./tests/tmp/desktop_files"
+      desktop ##> ("/_files_folder " <> desktopFiles)
+      desktop <## "ok"
+      let desktopHostFiles = "./tests/tmp/remote_hosts_data"
+      desktop ##> ("/remote_hosts_folder " <> desktopHostFiles)
+      desktop <## "ok"
+      let bobFiles = "./tests/tmp/bob_files"
+      bob ##> ("/_files_folder " <> bobFiles)
+      bob <## "ok"
+      startRemote mobile desktop
+      contactBob desktop bob
+      rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
+      desktopHostStore <- case M.lookup 1 rhs of
+        Just RemoteHostSession {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
+        _ -> fail "Host session 1 should be started"
+      desktop ##> "/store remote file 1 tests/fixtures/test.pdf"
+      desktop <## "file test.pdf stored on remote host 1"
+      src <- B.readFile "tests/fixtures/test.pdf"
+      B.readFile (mobileFiles </> "test.pdf") `shouldReturn` src
+      B.readFile (desktopHostStore </> "test.pdf") `shouldReturn` src
+      desktop ##> "/store remote file 1 tests/fixtures/test.pdf"
+      desktop <## "file test_1.pdf stored on remote host 1"
+      B.readFile (mobileFiles </> "test_1.pdf") `shouldReturn` src
+      B.readFile (desktopHostStore </> "test_1.pdf") `shouldReturn` src
+      desktop ##> "/store remote file 1 encrypt=on tests/fixtures/test.pdf"
+      desktop <## "file test_2.pdf stored on remote host 1"
+      Just cfArgs@(CFArgs key nonce) <- J.decode . LB.pack <$> getTermLine desktop
+      chatReadFile (mobileFiles </> "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src)
+      chatReadFile (desktopHostStore </> "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src)
+
+      removeFile (desktopHostStore </> "test_1.pdf")
+      removeFile (desktopHostStore </> "test_2.pdf")
+
+      -- cannot get file before it is used
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      hostError desktop "SEFileNotFound"
+      -- send file not encrypted locally on mobile host
+      desktop ##> "/_send @2 json {\"filePath\": \"test_1.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"sending a file\"}}"
+      desktop <# "@bob sending a file"
+      desktop <# "/f @bob test_1.pdf" 
+      desktop <## "use /fc 1 to cancel sending"
+      bob <# "alice> sending a file"
+      bob <# "alice> sends file test_1.pdf (266.0 KiB / 272376 bytes)"
+      bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+      bob ##> "/fr 1"
+      concurrentlyN_
+        [ do
+            desktop <## "completed uploading file 1 (test_1.pdf) for bob",
+          do
+            bob <## "saving file 1 from alice to test_1.pdf"
+            bob <## "started receiving file 1 (test_1.pdf) from alice"
+            bob <## "completed receiving file 1 (test_1.pdf) from alice"
+        ]
+      B.readFile (bobFiles </> "test_1.pdf") `shouldReturn` src
+      -- returns error for inactive user
+      desktop ##> "/get remote file 1 {\"userId\": 2, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      hostError desktop "CEDifferentActiveUser"
+      -- returns error with incorrect file ID
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 2, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      hostError desktop "SEFileNotFound"
+      -- gets file
+      doesFileExist (desktopHostStore </> "test_1.pdf") `shouldReturn` False
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 1, \"sent\": true, \"fileSource\": {\"filePath\": \"test_1.pdf\"}}"
+      desktop <## "ok"
+      B.readFile (desktopHostStore </> "test_1.pdf") `shouldReturn` src
+
+      -- send file encrypted locally on mobile host
+      desktop ##> ("/_send @2 json {\"fileSource\": {\"filePath\":\"test_2.pdf\", \"cryptoArgs\": " <> LB.unpack (J.encode cfArgs) <> "}, \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}")
+      desktop <# "/f @bob test_2.pdf" 
+      desktop <## "use /fc 2 to cancel sending"
+      bob <# "alice> sends file test_2.pdf (266.0 KiB / 272376 bytes)"
+      bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+      bob ##> "/fr 2"
+      concurrentlyN_
+        [ do
+            desktop <## "completed uploading file 2 (test_2.pdf) for bob",
+          do
+            bob <## "saving file 2 from alice to test_2.pdf"
+            bob <## "started receiving file 2 (test_2.pdf) from alice"
+            bob <## "completed receiving file 2 (test_2.pdf) from alice"
+        ]
+      B.readFile (bobFiles </> "test_2.pdf") `shouldReturn` src
+
+      -- receive file via remote host
+      copyFile "./tests/fixtures/test.jpg" (bobFiles </> "test.jpg")
+      bob #> "/f @alice test.jpg"
+      bob <## "use /fc 3 to cancel sending"
+      desktop <# "bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
+      desktop <## "use /fr 3 [<dir>/ | <path>] to receive it"
+      desktop ##> "/fr 3 encrypt=on"
+      concurrentlyN_
+        [ do
+            bob <## "completed uploading file 3 (test.jpg) for alice",
+          do
+            desktop <## "saving file 3 from bob to test.jpg"
+            desktop <## "started receiving file 3 (test.jpg) from bob"
+            desktop <## "completed receiving file 3 (test.jpg) from bob"
+        ]
+      Just cfArgs'@(CFArgs key' nonce') <- J.decode . LB.pack <$> getTermLine desktop
+      desktop <## "File received to connected remote host 1"
+      desktop <## "To download to this device use:"
+      getCmd <- getTermLine desktop
+      getCmd `shouldBe` ("/get remote file 1 {\"userId\":1,\"fileId\":3,\"sent\":false,\"fileSource\":{\"filePath\":\"test.jpg\",\"cryptoArgs\":" <> LB.unpack (J.encode cfArgs') <> "}}")
+      src' <- B.readFile (bobFiles </> "test.jpg")
+      chatReadFile (mobileFiles </> "test.jpg") (strEncode key') (strEncode nonce') `shouldReturn` Right (LB.fromStrict src')
+      doesFileExist (desktopHostStore </> "test.jpg") `shouldReturn` False
+      -- returns error with incorrect key
+      desktop ##> "/get remote file 1 {\"userId\": 1, \"fileId\": 3, \"sent\": false, \"fileSource\": {\"filePath\": \"test.jpg\", \"cryptoArgs\": null}}"
+      hostError desktop "SEFileNotFound"
+      doesFileExist (desktopHostStore </> "test.jpg") `shouldReturn` False
+      desktop ##> getCmd
+      desktop <## "ok"
+      chatReadFile (desktopHostStore </> "test.jpg") (strEncode key') (strEncode nonce') `shouldReturn` Right (LB.fromStrict src')
+
+      stopMobile mobile desktop
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
+    hostError cc err = do
+      r <- getTermLine cc
+      r `shouldStartWith` "remote host 1 error"
+      r `shouldContain` err
+
+remoteCLIFileTest :: (HasCallStack) => FilePath -> IO ()
+remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
+  createDirectoryIfMissing True "./tests/tmp/tmp/"
   let mobileFiles = "./tests/tmp/mobile_files"
   mobile ##> ("/_files_folder " <> mobileFiles)
   mobile <## "ok"
-  let desktopFiles = "./tests/tmp/desktop_files"
+  let bobFiles = "./tests/tmp/bob_files/"
-  desktop ##> ("/_files_folder " <> desktopFiles)
+  createDirectoryIfMissing True bobFiles
+  let desktopHostFiles = "./tests/tmp/remote_hosts_data"
+  desktop ##> ("/remote_hosts_folder " <> desktopHostFiles)
   desktop <## "ok"
-  let bobFiles = "./tests/tmp/bob_files"
-  bob ##> ("/_files_folder " <> bobFiles)
-  bob <## "ok"
 
   startRemote mobile desktop
   contactBob desktop bob
 
   rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
-  desktopStore <- case M.lookup 1 rhs of
+  desktopHostStore <- case M.lookup 1 rhs of
-    Just RemoteHostSession {storePath} -> pure storePath
+    Just RemoteHostSession {storePath} -> pure $ desktopHostFiles </> storePath </> archiveFilesFolder
     _ -> fail "Host session 1 should be started"
 
-  doesFileExist "./tests/tmp/mobile_files/test.pdf" `shouldReturn` False
-  doesFileExist (desktopFiles </> desktopStore </> "test.pdf") `shouldReturn` False
   mobileName <- userName mobile
 
-  bobsFile <- makeRelative bobFiles <$> makeAbsolute "tests/fixtures/test.pdf"
+  bob #> ("/f @" <> mobileName <> " " <> "tests/fixtures/test.pdf")
-  bob #> ("/f @" <> mobileName <> " " <> bobsFile)
   bob <## "use /fc 1 to cancel sending"
 
   desktop <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
@@ -192,63 +326,47 @@ remoteFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile
   desktop ##> "/fr 1"
   concurrentlyN_
     [ do
-        bob <## "started sending file 1 (test.pdf) to alice"
+        bob <## "completed uploading file 1 (test.pdf) for alice",
-        bob <## "completed sending file 1 (test.pdf) to alice",
       do
         desktop <## "saving file 1 from bob to test.pdf"
         desktop <## "started receiving file 1 (test.pdf) from bob"
+        desktop <## "completed receiving file 1 (test.pdf) from bob"
     ]
-  let desktopReceived = desktopFiles </> desktopStore </> "test.pdf"
-  -- desktop <## ("completed receiving file 1 (" <> desktopReceived <> ") from bob")
-  desktop <## "completed receiving file 1 (test.pdf) from bob"
-  bobsFileSize <- getFileSize bobsFile
-  -- getFileSize desktopReceived `shouldReturn` bobsFileSize
-  bobsFileBytes <- B.readFile bobsFile
-  -- B.readFile desktopReceived `shouldReturn` bobsFileBytes
 
-  -- test file transit on mobile
+  desktop <## "File received to connected remote host 1"
-  mobile ##> "/fs 1"
+  desktop <## "To download to this device use:"
-  mobile <## "receiving file 1 (test.pdf) complete, path: test.pdf"
+  getCmd <- getTermLine desktop
-  getFileSize (mobileFiles </> "test.pdf") `shouldReturn` bobsFileSize
+  src <- B.readFile "tests/fixtures/test.pdf"
-  B.readFile (mobileFiles </> "test.pdf") `shouldReturn` bobsFileBytes
+  B.readFile (mobileFiles </> "test.pdf") `shouldReturn` src
+  doesFileExist (desktopHostStore </> "test.pdf") `shouldReturn` False
+  desktop ##> getCmd
+  desktop <## "ok"
+  B.readFile (desktopHostStore </> "test.pdf") `shouldReturn` src
 
-  logNote "file received"
+  desktop `send` "/f @bob tests/fixtures/test.jpg"
-
+  desktop <# "/f @bob test.jpg"
-  desktopFile <- makeRelative desktopFiles <$> makeAbsolute "tests/fixtures/logo.jpg" -- XXX: not necessary for _send, but required for /f
-  logNote $ "sending " <> tshow desktopFile
-  doesFileExist (bobFiles </> "logo.jpg") `shouldReturn` False
-  doesFileExist (mobileFiles </> "logo.jpg") `shouldReturn` False
-  desktop ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/logo.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
-  desktop <# "@bob hi, sending a file"
-  desktop <# "/f @bob logo.jpg"
   desktop <## "use /fc 2 to cancel sending"
 
-  bob <# "alice> hi, sending a file"
+  bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
-  bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
   bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
-  bob ##> "/fr 2"
+  bob ##> ("/fr 2 " <> bobFiles)
   concurrentlyN_
     [ do
-        bob <## "saving file 2 from alice to logo.jpg"
+        desktop <## "completed uploading file 2 (test.jpg) for bob",
-        bob <## "started receiving file 2 (logo.jpg) from alice"
-        bob <## "completed receiving file 2 (logo.jpg) from alice"
-        bob ##> "/fs 2"
-        bob <## "receiving file 2 (logo.jpg) complete, path: logo.jpg",
       do
-        desktop <## "started sending file 2 (logo.jpg) to bob"
+        bob <## "saving file 2 from alice to ./tests/tmp/bob_files/test.jpg"
-        desktop <## "completed sending file 2 (logo.jpg) to bob"
+        bob <## "started receiving file 2 (test.jpg) from alice"
+        bob <## "completed receiving file 2 (test.jpg) from alice"
     ]
-  desktopFileSize <- getFileSize desktopFile
-  getFileSize (bobFiles </> "logo.jpg") `shouldReturn` desktopFileSize
-  getFileSize (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileSize
 
-  desktopFileBytes <- B.readFile desktopFile
+  src' <- B.readFile "tests/fixtures/test.jpg"
-  B.readFile (bobFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
+  B.readFile (mobileFiles </> "test.jpg") `shouldReturn` src'
-  B.readFile (mobileFiles </> "logo.jpg") `shouldReturn` desktopFileBytes
+  B.readFile (desktopHostStore </> "test.jpg") `shouldReturn` src'
-
+  B.readFile (bobFiles </> "test.jpg") `shouldReturn` src'
-  logNote "file sent"
 
   stopMobile mobile desktop
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
 
 -- * Utils