From fa90b501b4c7157a7db8ed193c205c49cf00d5bd Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 28 Aug 2023 15:31:37 +0100
Subject: [PATCH 1/4] agent: support encrypted local files

---
 simplexmq.cabal                         |   1 +
 src/Simplex/FileTransfer/Agent.hs       |   6 +-
 src/Simplex/FileTransfer/Client/Main.hs |   7 +-
 src/Simplex/FileTransfer/Crypto.hs      |  39 ++++-----
 src/Simplex/Messaging/Crypto/File.hs    | 100 ++++++++++++++++++++++++
 src/Simplex/Messaging/Crypto/Lazy.hs    |   2 +
 6 files changed, 129 insertions(+), 26 deletions(-)
 create mode 100644 src/Simplex/Messaging/Crypto/File.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index cf02c13c1..affa9a1f6 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -94,6 +94,7 @@ library
       Simplex.Messaging.Client
       Simplex.Messaging.Client.Agent
       Simplex.Messaging.Crypto
+      Simplex.Messaging.Crypto.File
       Simplex.Messaging.Crypto.Lazy
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Encoding
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 14b6af33b..86316ce88 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -53,6 +53,7 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (EncryptedFile (..))
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol (EntityId, XFTPServer)
@@ -250,7 +251,7 @@ runXFTPRcvLocalWorker c doWork = do
       withStore' c $ \db -> updateRcvFileStatus db rcvFileId RFSDecrypting
       chunkPaths <- getChunkPaths chunks
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
-      void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure fsSavePath
+      void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure $ EncryptedFile fsSavePath Nothing
       notify c rcvFileEntityId $ RFDONE fsSavePath
       forM_ tmpPath (removePath <=< toFSFilePath)
       atomically $ waitUntilForeground c
@@ -341,7 +342,8 @@ runXFTPSndPrepareWorker c doWork = do
               chunkSizes = prepareChunkSizes $ fileSize' + fileSizeLen + authTagSize
               chunkSizes' = map fromIntegral chunkSizes
               encSize = sum chunkSizes'
-          void $ liftError (INTERNAL . show) $ encryptFile filePath fileHdr key nonce fileSize' encSize fsEncPath
+              srcFile = EncryptedFile filePath Nothing
+          void $ liftError (INTERNAL . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
           digest <- liftIO $ LC.sha512Hash <$> LB.readFile fsEncPath
           let chunkSpecs = prepareChunkSpecs fsEncPath chunkSizes
           chunkDigests <- map FileDigest <$> mapM (liftIO . getChunkDigest) chunkSpecs
diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index 951b62a8e..a5b7623bb 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -59,6 +59,7 @@ import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
 import Simplex.FileTransfer.Types
 import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (EncryptedFile (..), FTCryptoError (..))
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
@@ -102,6 +103,7 @@ cliCryptoError = \case
   FTCECryptoError e -> CLIError $ "Error decrypting file: " <> show e
   FTCEInvalidHeader e -> CLIError $ "Invalid file header: " <> e
   FTCEInvalidAuthTag -> CLIError "Error decrypting file: incorrect auth tag"
+  FTCEInvalidFileSize -> CLIError "Error decrypting file: incorrect file size"
   FTCEFileIOError e -> CLIError $ "File IO error: " <> show e
 
 data CliCommand
@@ -301,7 +303,8 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
           defChunkSize = head chunkSizes
           chunkSizes' = map fromIntegral chunkSizes
           encSize = sum chunkSizes'
-      withExceptT (CLIError . show) $ encryptFile filePath fileHdr key nonce fileSize' encSize encPath
+          srcFile = EncryptedFile filePath Nothing
+      withExceptT (CLIError . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize encPath
       digest <- liftIO $ LC.sha512Hash <$> LB.readFile encPath
       let chunkSpecs = prepareChunkSpecs encPath chunkSizes
           fdRcv = FileDescription {party = SFRecipient, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = []}
@@ -434,7 +437,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
       when (FileSize encSize /= size) $ throwError $ CLIError "File size mismatch"
       liftIO $ printNoNewLine "Decrypting file..."
-      path <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce getFilePath
+      EncryptedFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap (`EncryptedFile` Nothing) . getFilePath
       forM_ chunks $ acknowledgeFileChunk a
       whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
       liftIO $ do
diff --git a/src/Simplex/FileTransfer/Crypto.hs b/src/Simplex/FileTransfer/Crypto.hs
index 71f5dec96..c7d4a4edf 100644
--- a/src/Simplex/FileTransfer/Crypto.hs
+++ b/src/Simplex/FileTransfer/Crypto.hs
@@ -16,6 +16,8 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Simplex.FileTransfer.Types (FileHeader (..), authTagSize)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (EncryptedFile (..), FTCryptoError (..))
+import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Crypto.Lazy (LazyByteString)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
@@ -23,10 +25,10 @@ import Simplex.Messaging.Util (liftEitherWith)
 import UnliftIO
 import UnliftIO.Directory (removeFile)
 
-encryptFile :: FilePath -> ByteString -> C.SbKey -> C.CbNonce -> Int64 -> Int64 -> FilePath -> ExceptT FTCryptoError IO ()
-encryptFile filePath fileHdr key nonce fileSize' encSize encFile = do
+encryptFile :: EncryptedFile -> ByteString -> C.SbKey -> C.CbNonce -> Int64 -> Int64 -> FilePath -> ExceptT FTCryptoError IO ()
+encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
   sb <- liftEitherWith FTCECryptoError $ LC.sbInit key nonce
-  withFile filePath ReadMode $ \r -> withFile encFile WriteMode $ \w -> do
+  CF.withFile srcFile ReadMode $ \r -> withFile encFile WriteMode $ \w -> do
     let lenStr = smpEncode fileSize'
         (hdr, !sb') = LC.sbEncryptChunk sb $ lenStr <> fileHdr
         padLen = encSize - authTagSize - fileSize' - 8
@@ -36,7 +38,7 @@ encryptFile filePath fileHdr key nonce fileSize' encSize encFile = do
     let tag = BA.convert $ LC.sbAuth sb3
     liftIO $ B.hPut w tag
   where
-    encryptChunks r = encryptChunks_ $ liftIO . B.hGet r . fromIntegral
+    encryptChunks r = encryptChunks_ $ liftIO . CF.hGet r . fromIntegral
     encryptPad = encryptChunks_ $ \sz -> pure $ B.replicate (fromIntegral sz) '#'
     encryptChunks_ :: (Int64 -> IO ByteString) -> Handle -> (LC.SbState, Int64) -> ExceptT FTCryptoError IO LC.SbState
     encryptChunks_ get w (!sb, !len)
@@ -49,28 +51,28 @@ encryptFile filePath fileHdr key nonce fileSize' encSize encFile = do
         liftIO $ B.hPut w ch'
         encryptChunks_ get w (sb', len - chSize)
 
-decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO String) -> ExceptT FTCryptoError IO FilePath
+decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO EncryptedFile) -> ExceptT FTCryptoError IO EncryptedFile
 decryptChunks _ [] _ _ _ = throwError $ FTCEInvalidHeader "empty"
-decryptChunks encSize (chPath : chPaths) key nonce getFilePath = case reverse chPaths of
+decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse chPaths of
   [] -> do
     (!authOk, !f) <- liftEither . first FTCECryptoError . LC.sbDecryptTailTag key nonce (encSize - authTagSize) =<< liftIO (LB.readFile chPath)
     unless authOk $ throwError FTCEInvalidAuthTag
     (FileHeader {fileName}, !f') <- parseFileHeader f
-    path <- withExceptT FTCEFileIOError $ getFilePath fileName
-    liftIO $ LB.writeFile path f'
-    pure path
+    destFile <- withExceptT FTCEFileIOError $ getDestFile fileName
+    CF.writeFile destFile f'
+    pure destFile
   lastPath : chPaths' -> do
     (state, expectedLen, ch) <- decryptFirstChunk
     (FileHeader {fileName}, ch') <- parseFileHeader ch
-    path <- withExceptT FTCEFileIOError $ getFilePath fileName
-    authOk <- liftIO . withFile path WriteMode $ \h -> do
-      liftIO $ LB.hPut h ch'
+    destFile@(EncryptedFile path _) <- withExceptT FTCEFileIOError $ getDestFile fileName
+    authOk <- CF.withFile destFile WriteMode $ \h -> liftIO $ do
+      CF.hPut h ch'
       state' <- foldM (decryptChunk h) state $ reverse chPaths'
       decryptLastChunk h state' expectedLen
     unless authOk $ do
       removeFile path
       throwError FTCEInvalidAuthTag
-    pure path
+    pure destFile
     where
       decryptFirstChunk = do
         sb <- liftEitherWith FTCECryptoError $ LC.sbInit key nonce
@@ -83,7 +85,7 @@ decryptChunks encSize (chPath : chPaths) key nonce getFilePath = case reverse ch
         ch <- LB.readFile chPth
         let len' = len + LB.length ch
             (ch', sb') = LC.sbDecryptChunkLazy sb ch
-        LB.hPut h ch'
+        CF.hPut h ch'
         pure (sb', len')
       decryptLastChunk h (!sb, !len) expectedLen = do
         ch <- LB.readFile lastPath
@@ -93,7 +95,7 @@ decryptChunks encSize (chPath : chPaths) key nonce getFilePath = case reverse ch
             len' = len + LB.length ch2
             ch3 = LB.take (LB.length ch2 - len' + expectedLen) ch2
             tag :: ByteString = BA.convert (LC.sbAuth sb')
-        LB.hPut h ch3
+        CF.hPut h ch3
         pure $ B.length tag'' == 16 && BA.constEq tag'' tag
   where
     parseFileHeader :: LazyByteString -> ExceptT FTCryptoError IO (FileHeader, LazyByteString)
@@ -106,10 +108,3 @@ decryptChunks encSize (chPath : chPaths) key nonce getFilePath = case reverse ch
 
 readChunks :: [FilePath] -> IO LB.ByteString
 readChunks = foldM (\s path -> (s <>) <$> LB.readFile path) ""
-
-data FTCryptoError
-  = FTCECryptoError C.CryptoError
-  | FTCEInvalidHeader String
-  | FTCEInvalidAuthTag
-  | FTCEFileIOError String
-  deriving (Show, Eq, Exception)
diff --git a/src/Simplex/Messaging/Crypto/File.hs b/src/Simplex/Messaging/Crypto/File.hs
new file mode 100644
index 000000000..6558fab7b
--- /dev/null
+++ b/src/Simplex/Messaging/Crypto/File.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Messaging.Crypto.File where
+
+import Control.Exception
+import Control.Monad.Except
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Aeson as J
+import Data.Bifunctor (first)
+import qualified Data.ByteArray as BA
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
+import Data.List.NonEmpty (NonEmpty (..))
+import GHC.Generics (Generic)
+import Simplex.Messaging.Client.Agent ()
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Lazy (LazyByteString)
+import qualified Simplex.Messaging.Crypto.Lazy as LC
+import Simplex.Messaging.Util (liftEitherWith)
+import UnliftIO (Handle, IOMode (..))
+import qualified UnliftIO as IO
+import UnliftIO.STM
+
+data EncryptedFile = EncryptedFile {filePath :: FilePath, encFileArgs :: Maybe EncryptedFileArgs}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON EncryptedFile where
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+
+data EncryptedFileArgs = EFArgs {fileSbKey :: C.SbKey, fileNonce :: C.CbNonce}
+  deriving (Eq, Show, Generic, FromJSON)
+
+instance ToJSON EncryptedFileArgs where toEncoding = J.genericToEncoding J.defaultOptions
+
+data EncryptedFileHandle = EFHandle Handle (Maybe (TVar LC.SbState))
+
+readFile :: EncryptedFile -> ExceptT FTCryptoError IO LazyByteString
+readFile (EncryptedFile path fKey_) = do
+  s <- liftIO $ LB.readFile path
+  case fKey_ of
+    Just (EFArgs (C.SbKey key) (C.CbNonce nonce)) -> do
+      let len = LB.length s - fromIntegral C.authTagSize
+      when (len < 0) $ throwError FTCEInvalidFileSize
+      let (s', tag') = LB.splitAt len s
+      (tag :| cs) <- liftEitherWith FTCECryptoError $ LC.secretBox LC.sbDecryptChunk key nonce s'
+      unless (BA.constEq (LB.toStrict tag') tag) $ throwError FTCEInvalidAuthTag
+      pure $ LB.fromChunks cs
+    Nothing -> pure s
+
+writeFile :: EncryptedFile -> LazyByteString -> ExceptT FTCryptoError IO ()
+writeFile (EncryptedFile path fKey_) s = do
+  s' <- case fKey_ of
+    Just (EFArgs (C.SbKey key) (C.CbNonce nonce)) ->
+      liftEitherWith FTCECryptoError $ LB.fromChunks <$> LC.secretBoxTailTag LC.sbEncryptChunk key nonce s
+    Nothing -> pure s
+  liftIO $ LB.writeFile path s'
+
+withFile :: EncryptedFile -> IOMode -> (EncryptedFileHandle -> ExceptT FTCryptoError IO a) -> ExceptT FTCryptoError IO a
+withFile (EncryptedFile path fKey_) mode action = do
+  sb <- forM fKey_ $ \(EFArgs key nonce) ->
+    liftEitherWith FTCECryptoError (LC.sbInit key nonce) >>= newTVarIO
+  IO.withFile path mode $ \h -> action $ EFHandle h sb
+
+hPut :: EncryptedFileHandle -> LazyByteString -> IO ()
+hPut (EFHandle h sb_) s = LB.hPut h =<< maybe (pure s) encrypt sb_
+  where
+    encrypt sb = atomically $ stateTVar sb (`LC.sbEncryptChunkLazy` s)
+
+hPutTag :: EncryptedFileHandle -> IO ()
+hPutTag (EFHandle h sb_) = forM_ sb_ $ B.hPut h . BA.convert . LC.sbAuth <=< readTVarIO
+
+hGet :: EncryptedFileHandle -> Int -> IO ByteString
+hGet (EFHandle h sb_) n = B.hGet h n >>= maybe pure decrypt sb_
+  where
+    decrypt sb s = atomically $ stateTVar sb (`LC.sbDecryptChunk` s)
+
+-- | Read and validate the auth tag.
+-- This function should be called after reading the whole file, it assumes you know the file size and read only the needed bytes.
+hGetTag :: EncryptedFileHandle -> ExceptT FTCryptoError IO ()
+hGetTag (EFHandle h sb_) = forM_ sb_ $ \sb -> do
+  tag <- liftIO $ B.hGet h C.authTagSize
+  tag' <- LC.sbAuth <$> readTVarIO sb
+  unless (BA.constEq tag tag') $ throwError FTCEInvalidAuthTag
+
+fileIO :: IO a -> ExceptT FTCryptoError IO a
+fileIO action = ExceptT $ first (\(e :: IOException) -> FTCEFileIOError $ show e) <$> try action
+
+data FTCryptoError
+  = FTCECryptoError C.CryptoError
+  | FTCEInvalidHeader String
+  | FTCEInvalidFileSize
+  | FTCEInvalidAuthTag
+  | FTCEFileIOError String
+  deriving (Show, Eq, Exception)
diff --git a/src/Simplex/Messaging/Crypto/Lazy.hs b/src/Simplex/Messaging/Crypto/Lazy.hs
index ab972c8da..6fb37adf7 100644
--- a/src/Simplex/Messaging/Crypto/Lazy.hs
+++ b/src/Simplex/Messaging/Crypto/Lazy.hs
@@ -17,6 +17,8 @@ module Simplex.Messaging.Crypto.Lazy
     sbEncryptTailTag,
     sbDecryptTailTag,
     fastReplicate,
+    secretBox,
+    secretBoxTailTag,
     SbState,
     cbInit,
     sbInit,

From e12d7d4b0939ffa8316e59c11f3fe6998f694388 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 30 Aug 2023 11:07:26 +0100
Subject: [PATCH 2/4] migration, update store, api

---
 simplexmq.cabal                               |  1 +
 src/Simplex/FileTransfer/Agent.hs             | 27 ++++---
 src/Simplex/FileTransfer/Client/Main.hs       |  6 +-
 src/Simplex/FileTransfer/Crypto.hs            |  8 +-
 src/Simplex/FileTransfer/Types.hs             |  5 +-
 src/Simplex/Messaging/Agent.hs                | 15 ++--
 src/Simplex/Messaging/Agent/Store/SQLite.hs   | 37 +++++----
 .../Agent/Store/SQLite/Migrations.hs          |  4 +-
 .../Migrations/M20230829_crypto_files.hs      | 24 ++++++
 .../Store/SQLite/Migrations/agent_schema.sql  |  5 ++
 src/Simplex/Messaging/Crypto/File.hs          | 79 +++++++++++--------
 tests/XFTPAgent.hs                            | 22 +++---
 12 files changed, 146 insertions(+), 87 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20230829_crypto_files.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index affa9a1f6..852e33a08 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -89,6 +89,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
       Simplex.Messaging.Agent.TAsyncs
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 86316ce88..f0786ff45 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -53,7 +53,7 @@ import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.File (EncryptedFile (..))
+import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol (EntityId, XFTPServer)
@@ -100,8 +100,8 @@ closeXFTPAgent XFTPAgent {xftpRcvWorkers, xftpSndWorkers} = do
       ws <- atomically $ stateTVar wsSel (,M.empty)
       mapM_ (uninterruptibleCancel . snd) ws
 
-xftpReceiveFile' :: AgentMonad m => AgentClient -> UserId -> ValidFileDescription 'FRecipient -> m RcvFileId
-xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks}) = do
+xftpReceiveFile' :: AgentMonad m => AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> m RcvFileId
+xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks}) cfArgs = do
   g <- asks idsDrg
   prefixPath <- getPrefixPath "rcv.xftp"
   createDirectory prefixPath
@@ -110,7 +110,8 @@ xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks}) = d
       relSavePath = relPrefixPath </> "xftp.decrypted"
   createDirectory =<< toFSFilePath relTmpPath
   createEmptyFile =<< toFSFilePath relSavePath
-  fId <- withStore c $ \db -> createRcvFile db g userId fd relPrefixPath relTmpPath relSavePath
+  let saveFile = CryptoFile relSavePath cfArgs
+  fId <- withStore c $ \db -> createRcvFile db g userId fd relPrefixPath relTmpPath saveFile
   forM_ chunks downloadChunk
   pure fId
   where
@@ -244,14 +245,16 @@ runXFTPRcvLocalWorker c doWork = do
           decryptFile f `catchAgentError` (rcvWorkerInternalError c rcvFileId rcvFileEntityId tmpPath . show)
     noWorkToDo = void . atomically $ tryTakeTMVar doWork
     decryptFile :: RcvFile -> m ()
-    decryptFile RcvFile {rcvFileId, rcvFileEntityId, key, nonce, tmpPath, savePath, status, chunks} = do
+    decryptFile RcvFile {rcvFileId, rcvFileEntityId, key, nonce, tmpPath, saveFile, status, chunks} = do
+      let CryptoFile savePath cfArgs = saveFile
       fsSavePath <- toFSFilePath savePath
       when (status == RFSDecrypting) $
         whenM (doesFileExist fsSavePath) (removeFile fsSavePath >> createEmptyFile fsSavePath)
       withStore' c $ \db -> updateRcvFileStatus db rcvFileId RFSDecrypting
       chunkPaths <- getChunkPaths chunks
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
-      void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure $ EncryptedFile fsSavePath Nothing
+      let destFile = CryptoFile fsSavePath cfArgs
+      void $ liftError (INTERNAL . show) $ decryptChunks encSize chunkPaths key nonce $ \_ -> pure destFile
       notify c rcvFileEntityId $ RFDONE fsSavePath
       forM_ tmpPath (removePath <=< toFSFilePath)
       atomically $ waitUntilForeground c
@@ -278,8 +281,8 @@ xftpDeleteRcvFile' c rcvFileEntityId = do
 notify :: forall m e. (MonadUnliftIO m, AEntityI e) => AgentClient -> EntityId -> ACommand 'Agent e -> m ()
 notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, APC (sAEntity @e) cmd)
 
-xftpSendFile' :: AgentMonad m => AgentClient -> UserId -> FilePath -> Int -> m SndFileId
-xftpSendFile' c userId filePath numRecipients = do
+xftpSendFile' :: AgentMonad m => AgentClient -> UserId -> CryptoFile -> Int -> m SndFileId
+xftpSendFile' c userId file numRecipients = do
   g <- asks idsDrg
   prefixPath <- getPrefixPath "snd.xftp"
   createDirectory prefixPath
@@ -287,7 +290,7 @@ xftpSendFile' c userId filePath numRecipients = do
   key <- liftIO C.randomSbKey
   nonce <- liftIO C.randomCbNonce
   -- saving absolute filePath will not allow to restore file encryption after app update, but it's a short window
-  fId <- withStore c $ \db -> createSndFile db g userId numRecipients filePath relPrefixPath key nonce
+  fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce
   addXFTPSndWorker c Nothing
   pure fId
 
@@ -333,8 +336,9 @@ runXFTPSndPrepareWorker c doWork = do
       withStore' c $ \db -> updateSndFileStatus db sndFileId SFSUploading
       where
         encryptFileForUpload :: SndFile -> FilePath -> m (FileDigest, [(XFTPChunkSpec, FileDigest)])
-        encryptFileForUpload SndFile {key, nonce, filePath} fsEncPath = do
-          let fileName = takeFileName filePath
+        encryptFileForUpload SndFile {key, nonce, srcFile} fsEncPath = do
+          let CryptoFile {filePath} = srcFile
+              fileName = takeFileName filePath
           fileSize <- fromInteger <$> getFileSize filePath
           when (fileSize > maxFileSize) $ throwError $ INTERNAL "max file size exceeded"
           let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
@@ -342,7 +346,6 @@ runXFTPSndPrepareWorker c doWork = do
               chunkSizes = prepareChunkSizes $ fileSize' + fileSizeLen + authTagSize
               chunkSizes' = map fromIntegral chunkSizes
               encSize = sum chunkSizes'
-              srcFile = EncryptedFile filePath Nothing
           void $ liftError (INTERNAL . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize fsEncPath
           digest <- liftIO $ LC.sha512Hash <$> LB.readFile fsEncPath
           let chunkSpecs = prepareChunkSpecs fsEncPath chunkSizes
diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index a5b7623bb..2a05f0b5c 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -59,7 +59,7 @@ import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
 import Simplex.FileTransfer.Types
 import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.File (EncryptedFile (..), FTCryptoError (..))
+import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
@@ -303,7 +303,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
           defChunkSize = head chunkSizes
           chunkSizes' = map fromIntegral chunkSizes
           encSize = sum chunkSizes'
-          srcFile = EncryptedFile filePath Nothing
+          srcFile = CryptoFile filePath Nothing
       withExceptT (CLIError . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize encPath
       digest <- liftIO $ LC.sha512Hash <$> LB.readFile encPath
       let chunkSpecs = prepareChunkSpecs encPath chunkSizes
@@ -437,7 +437,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
       when (FileSize encSize /= size) $ throwError $ CLIError "File size mismatch"
       liftIO $ printNoNewLine "Decrypting file..."
-      EncryptedFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap (`EncryptedFile` Nothing) . getFilePath
+      CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap (`CryptoFile` Nothing) . getFilePath
       forM_ chunks $ acknowledgeFileChunk a
       whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
       liftIO $ do
diff --git a/src/Simplex/FileTransfer/Crypto.hs b/src/Simplex/FileTransfer/Crypto.hs
index c7d4a4edf..62060c17c 100644
--- a/src/Simplex/FileTransfer/Crypto.hs
+++ b/src/Simplex/FileTransfer/Crypto.hs
@@ -16,7 +16,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Simplex.FileTransfer.Types (FileHeader (..), authTagSize)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Crypto.File (EncryptedFile (..), FTCryptoError (..))
+import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Crypto.Lazy (LazyByteString)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -25,7 +25,7 @@ import Simplex.Messaging.Util (liftEitherWith)
 import UnliftIO
 import UnliftIO.Directory (removeFile)
 
-encryptFile :: EncryptedFile -> ByteString -> C.SbKey -> C.CbNonce -> Int64 -> Int64 -> FilePath -> ExceptT FTCryptoError IO ()
+encryptFile :: CryptoFile -> ByteString -> C.SbKey -> C.CbNonce -> Int64 -> Int64 -> FilePath -> ExceptT FTCryptoError IO ()
 encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
   sb <- liftEitherWith FTCECryptoError $ LC.sbInit key nonce
   CF.withFile srcFile ReadMode $ \r -> withFile encFile WriteMode $ \w -> do
@@ -51,7 +51,7 @@ encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
         liftIO $ B.hPut w ch'
         encryptChunks_ get w (sb', len - chSize)
 
-decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO EncryptedFile) -> ExceptT FTCryptoError IO EncryptedFile
+decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (String -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile
 decryptChunks _ [] _ _ _ = throwError $ FTCEInvalidHeader "empty"
 decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse chPaths of
   [] -> do
@@ -64,7 +64,7 @@ decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse ch
   lastPath : chPaths' -> do
     (state, expectedLen, ch) <- decryptFirstChunk
     (FileHeader {fileName}, ch') <- parseFileHeader ch
-    destFile@(EncryptedFile path _) <- withExceptT FTCEFileIOError $ getDestFile fileName
+    destFile@(CryptoFile path _) <- withExceptT FTCEFileIOError $ getDestFile fileName
     authOk <- CF.withFile destFile WriteMode $ \h -> liftIO $ do
       CF.hPut h ch'
       state' <- foldM (decryptChunk h) state $ reverse chPaths'
diff --git a/src/Simplex/FileTransfer/Types.hs b/src/Simplex/FileTransfer/Types.hs
index 0e0c4ac0d..e51cb14e3 100644
--- a/src/Simplex/FileTransfer/Types.hs
+++ b/src/Simplex/FileTransfer/Types.hs
@@ -13,6 +13,7 @@ import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
 import Simplex.FileTransfer.Description
 import Simplex.Messaging.Agent.Protocol (RcvFileId, SndFileId)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (fromTextField_)
@@ -49,7 +50,7 @@ data RcvFile = RcvFile
     chunks :: [RcvFileChunk],
     prefixPath :: FilePath,
     tmpPath :: Maybe FilePath,
-    savePath :: FilePath,
+    saveFile :: CryptoFile,
     status :: RcvFileStatus,
     deleted :: Bool
   }
@@ -120,7 +121,7 @@ data SndFile = SndFile
     key :: C.SbKey,
     nonce :: C.CbNonce,
     chunks :: [SndFileChunk],
-    filePath :: FilePath,
+    srcFile :: CryptoFile,
     prefixPath :: Maybe FilePath,
     status :: SndFileStatus,
     deleted :: Bool
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index d0b089600..6dac14717 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -119,12 +119,12 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust, isNothing, catMaybes)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock
 import Data.Time.Clock.System (systemToUTCTime)
-import Simplex.FileTransfer.Agent (closeXFTPAgent, xftpDeleteRcvFile', deleteSndFileInternal, deleteSndFileRemote, xftpReceiveFile', xftpSendFile', startXFTPWorkers, toFSFilePath)
+import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpReceiveFile', xftpSendFile')
 import Simplex.FileTransfer.Description (ValidFileDescription)
 import Simplex.FileTransfer.Protocol (FileParty (..))
 import Simplex.FileTransfer.Util (removePath)
@@ -140,6 +140,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client (ProtocolClient (..), ServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -356,15 +357,15 @@ xftpStartWorkers :: AgentErrorMonad m => AgentClient -> Maybe FilePath -> m ()
 xftpStartWorkers c = withAgentEnv c . startXFTPWorkers c
 
 -- | Receive XFTP file
-xftpReceiveFile :: AgentErrorMonad m => AgentClient -> UserId -> ValidFileDescription 'FRecipient -> m RcvFileId
-xftpReceiveFile c = withAgentEnv c .: xftpReceiveFile' c
+xftpReceiveFile :: AgentErrorMonad m => AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> m RcvFileId
+xftpReceiveFile c = withAgentEnv c .:. xftpReceiveFile' c
 
 -- | Delete XFTP rcv file (deletes work files from file system and db records)
 xftpDeleteRcvFile :: AgentErrorMonad m => AgentClient -> RcvFileId -> m ()
 xftpDeleteRcvFile c = withAgentEnv c . xftpDeleteRcvFile' c
 
 -- | Send XFTP file
-xftpSendFile :: AgentErrorMonad m => AgentClient -> UserId -> FilePath -> Int -> m SndFileId
+xftpSendFile :: AgentErrorMonad m => AgentClient -> UserId -> CryptoFile -> Int -> m SndFileId
 xftpSendFile c = withAgentEnv c .:. xftpSendFile' c
 
 -- | Delete XFTP snd file internally (deletes work files from file system and db records)
@@ -2339,8 +2340,8 @@ mkAgentConfirmation :: AgentMonad m => Compatible Version -> AgentClient -> Conn
 mkAgentConfirmation (Compatible agentVersion) c cData sq srv connInfo
   | agentVersion == 1 = pure $ AgentConnInfo connInfo
   | otherwise = do
-      qInfo <- createReplyQueue c cData sq srv
-      pure $ AgentConnInfoReply (qInfo :| []) connInfo
+    qInfo <- createReplyQueue c cData sq srv
+    pure $ AgentConnInfoReply (qInfo :| []) connInfo
 
 enqueueConfirmation :: AgentMonad m => AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
 enqueueConfirmation c cData sq connInfo e2eEncryption_ = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index 9040274ce..77175634a 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -255,6 +255,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (DownMigration (..), MTRError, Migration (..), MigrationsToRun (..), mtrErrorDescription)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -2080,8 +2081,8 @@ getXFTPServerId_ db ProtocolServer {host, port, keyHash} = do
   firstRow fromOnly SEXFTPServerNotFound $
     DB.query db "SELECT xftp_server_id FROM xftp_servers WHERE xftp_host = ? AND xftp_port = ? AND xftp_key_hash = ?" (host, port, keyHash)
 
-createRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> FilePath -> IO (Either StoreError RcvFileId)
-createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath savePath = runExceptT $ do
+createRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> IO (Either StoreError RcvFileId)
+createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath (CryptoFile savePath cfArgs) = runExceptT $ do
   (rcvFileEntityId, rcvFileId) <- ExceptT $ insertRcvFile fd
   liftIO $
     forM_ chunks $ \fc@FileChunk {replicas} -> do
@@ -2095,8 +2096,8 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath save
         createWithRandomId gVar $ \rcvFileEntityId ->
           DB.execute
             db
-            "INSERT INTO rcv_files (rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, status) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
-            ((rcvFileEntityId, userId, size, digest, key, nonce, chunkSize) :. (prefixPath, tmpPath, savePath, RFSReceiving))
+            "INSERT INTO rcv_files (rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)"
+            ((rcvFileEntityId, userId, size, digest, key, nonce, chunkSize) :. (prefixPath, tmpPath, savePath, fileKey <$> cfArgs, fileNonce <$> cfArgs, RFSReceiving))
       rcvFileId <- liftIO $ insertedRowId db
       pure (rcvFileEntityId, rcvFileId)
     insertChunk :: FileChunk -> DBRcvFileId -> IO Int64
@@ -2136,15 +2137,17 @@ getRcvFile db rcvFileId = runExceptT $ do
         DB.query
           db
           [sql|
-            SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, status, deleted
+            SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, deleted
             FROM rcv_files
             WHERE rcv_file_id = ?
           |]
           (Only rcvFileId)
       where
-        toFile :: (RcvFileId, UserId, FileSize Int64, FileDigest, C.SbKey, C.CbNonce, FileSize Word32, FilePath, Maybe FilePath, FilePath, RcvFileStatus, Bool) -> RcvFile
-        toFile (rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath, savePath, status, deleted) =
-          RcvFile {rcvFileId, rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath, savePath, status, deleted, chunks = []}
+        toFile :: (RcvFileId, UserId, FileSize Int64, FileDigest, C.SbKey, C.CbNonce, FileSize Word32, FilePath, Maybe FilePath) :. (FilePath, Maybe C.SbKey, Maybe C.CbNonce, RcvFileStatus, Bool) -> RcvFile
+        toFile ((rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath) :. (savePath, saveKey_, saveNonce_, status, deleted)) =
+          let cfArgs = CFArgs <$> saveKey_ <*> saveNonce_
+              saveFile = CryptoFile savePath cfArgs
+           in RcvFile {rcvFileId, rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath, saveFile, status, deleted, chunks = []}
     getChunks :: RcvFileId -> UserId -> FilePath -> IO [RcvFileChunk]
     getChunks rcvFileEntityId userId fileTmpPath = do
       chunks <-
@@ -2333,13 +2336,13 @@ getRcvFilesExpired db ttl = do
     |]
     (Only cutoffTs)
 
-createSndFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> Int -> FilePath -> FilePath -> C.SbKey -> C.CbNonce -> IO (Either StoreError SndFileId)
-createSndFile db gVar userId numRecipients path prefixPath key nonce =
+createSndFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> CryptoFile -> Int -> FilePath -> C.SbKey -> C.CbNonce -> IO (Either StoreError SndFileId)
+createSndFile db gVar userId (CryptoFile path cfArgs) numRecipients prefixPath key nonce =
   createWithRandomId gVar $ \sndFileEntityId ->
     DB.execute
       db
-      "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)
+      "INSERT INTO snd_files (snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, prefix_path, key, nonce, status) VALUES (?,?,?,?,?,?,?,?,?,?)"
+      (sndFileEntityId, userId, path, fileKey <$> cfArgs, fileNonce <$> cfArgs, numRecipients, prefixPath, key, nonce, SFSNew)
 
 getSndFileByEntityId :: DB.Connection -> SndFileId -> IO (Either StoreError SndFile)
 getSndFileByEntityId db sndFileEntityId = runExceptT $ do
@@ -2363,15 +2366,17 @@ getSndFile db sndFileId = runExceptT $ do
         DB.query
           db
           [sql|
-            SELECT snd_file_entity_id, user_id, num_recipients, digest, key, nonce, path, prefix_path, status, deleted
+            SELECT snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, digest, prefix_path, key, nonce, status, deleted
             FROM snd_files
             WHERE snd_file_id = ?
           |]
           (Only sndFileId)
       where
-        toFile :: (SndFileId, UserId, Int, Maybe FileDigest, C.SbKey, C.CbNonce, FilePath, Maybe FilePath, SndFileStatus, Bool) -> SndFile
-        toFile (sndFileEntityId, userId, numRecipients, digest, key, nonce, filePath, prefixPath, status, deleted) =
-          SndFile {sndFileId, sndFileEntityId, userId, numRecipients, digest, key, nonce, filePath, prefixPath, status, deleted, chunks = []}
+        toFile :: (SndFileId, UserId, FilePath, Maybe C.SbKey, Maybe C.CbNonce, Int, Maybe FileDigest, Maybe FilePath, C.SbKey, C.CbNonce, SndFileStatus, Bool) -> SndFile
+        toFile (sndFileEntityId, userId, srcPath, srcKey_, srcNonce_, numRecipients, digest, prefixPath, key, nonce, status, deleted) =
+          let cfArgs = CFArgs <$> srcKey_ <*> srcNonce_
+              srcFile = CryptoFile srcPath cfArgs
+           in SndFile {sndFileId, sndFileEntityId, userId, srcFile, numRecipients, digest, prefixPath, key, nonce, status, deleted, chunks = []}
     getChunks :: SndFileId -> UserId -> Int -> FilePath -> IO [SndFileChunk]
     getChunks sndFileEntityId userId numRecipients filePrefixPath = do
       chunks <-
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
index d84d8d2fe..6d46b7cc0 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs
@@ -67,6 +67,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receip
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -99,7 +100,8 @@ schemaMigrations =
     ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
     ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
     ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
-    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes)
+    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
+    ("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20230829_crypto_files.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20230829_crypto_files.hs
new file mode 100644
index 000000000..a2ed8321b
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20230829_crypto_files.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230829_crypto_files :: Query
+m20230829_crypto_files =
+  [sql|
+ALTER TABLE rcv_files ADD COLUMN save_file_key BLOB;
+ALTER TABLE rcv_files ADD COLUMN save_file_nonce BLOB;
+ALTER TABLE snd_files ADD COLUMN src_file_key BLOB;
+ALTER TABLE snd_files ADD COLUMN src_file_nonce BLOB;
+|]
+
+down_m20230829_crypto_files :: Query
+down_m20230829_crypto_files =
+  [sql|
+ALTER TABLE rcv_files DROP COLUMN save_file_key;
+ALTER TABLE rcv_files DROP COLUMN save_file_nonce;
+ALTER TABLE snd_files DROP COLUMN src_file_key;
+ALTER TABLE snd_files DROP COLUMN src_file_nonce;
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
index 5f355591e..dbb1dface 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -271,6 +271,8 @@ CREATE TABLE rcv_files(
   error TEXT,
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now')),
+  save_file_key BLOB,
+  save_file_nonce BLOB,
   UNIQUE(rcv_file_entity_id)
 );
 CREATE TABLE rcv_file_chunks(
@@ -311,6 +313,9 @@ CREATE TABLE snd_files(
   error TEXT,
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
+  ,
+  src_file_key BLOB,
+  src_file_nonce BLOB
 );
 CREATE TABLE snd_file_chunks(
   snd_file_chunk_id INTEGER PRIMARY KEY,
diff --git a/src/Simplex/Messaging/Crypto/File.hs b/src/Simplex/Messaging/Crypto/File.hs
index 6558fab7b..1416d2507 100644
--- a/src/Simplex/Messaging/Crypto/File.hs
+++ b/src/Simplex/Messaging/Crypto/File.hs
@@ -1,16 +1,29 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Simplex.Messaging.Crypto.File where
+module Simplex.Messaging.Crypto.File
+  ( CryptoFile (..),
+    CryptoFileArgs (..),
+    CryptoFileHandle (..),
+    FTCryptoError (..),
+    Simplex.Messaging.Crypto.File.readFile,
+    Simplex.Messaging.Crypto.File.writeFile,
+    withFile,
+    hPut,
+    hPutTag,
+    hGet,
+    hGetTag,
+    plain,
+    randomArgs,
+  )
+where
 
 import Control.Exception
 import Control.Monad.Except
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
-import Data.Bifunctor (first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -26,25 +39,26 @@ import UnliftIO (Handle, IOMode (..))
 import qualified UnliftIO as IO
 import UnliftIO.STM
 
-data EncryptedFile = EncryptedFile {filePath :: FilePath, encFileArgs :: Maybe EncryptedFileArgs}
+-- Possibly encrypted local file
+data CryptoFile = CryptoFile {filePath :: FilePath, cryptoArgs :: Maybe CryptoFileArgs}
   deriving (Eq, Show, Generic, FromJSON)
 
-instance ToJSON EncryptedFile where
+instance ToJSON CryptoFile where
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
 
-data EncryptedFileArgs = EFArgs {fileSbKey :: C.SbKey, fileNonce :: C.CbNonce}
+data CryptoFileArgs = CFArgs {fileKey :: C.SbKey, fileNonce :: C.CbNonce}
   deriving (Eq, Show, Generic, FromJSON)
 
-instance ToJSON EncryptedFileArgs where toEncoding = J.genericToEncoding J.defaultOptions
+instance ToJSON CryptoFileArgs where toEncoding = J.genericToEncoding J.defaultOptions
 
-data EncryptedFileHandle = EFHandle Handle (Maybe (TVar LC.SbState))
+data CryptoFileHandle = CFHandle Handle (Maybe (TVar LC.SbState))
 
-readFile :: EncryptedFile -> ExceptT FTCryptoError IO LazyByteString
-readFile (EncryptedFile path fKey_) = do
+readFile :: CryptoFile -> ExceptT FTCryptoError IO LazyByteString
+readFile (CryptoFile path cfArgs) = do
   s <- liftIO $ LB.readFile path
-  case fKey_ of
-    Just (EFArgs (C.SbKey key) (C.CbNonce nonce)) -> do
+  case cfArgs of
+    Just (CFArgs (C.SbKey key) (C.CbNonce nonce)) -> do
       let len = LB.length s - fromIntegral C.authTagSize
       when (len < 0) $ throwError FTCEInvalidFileSize
       let (s', tag') = LB.splitAt len s
@@ -53,44 +67,41 @@ readFile (EncryptedFile path fKey_) = do
       pure $ LB.fromChunks cs
     Nothing -> pure s
 
-writeFile :: EncryptedFile -> LazyByteString -> ExceptT FTCryptoError IO ()
-writeFile (EncryptedFile path fKey_) s = do
-  s' <- case fKey_ of
-    Just (EFArgs (C.SbKey key) (C.CbNonce nonce)) ->
+writeFile :: CryptoFile -> LazyByteString -> ExceptT FTCryptoError IO ()
+writeFile (CryptoFile path cfArgs) s = do
+  s' <- case cfArgs of
+    Just (CFArgs (C.SbKey key) (C.CbNonce nonce)) ->
       liftEitherWith FTCECryptoError $ LB.fromChunks <$> LC.secretBoxTailTag LC.sbEncryptChunk key nonce s
     Nothing -> pure s
   liftIO $ LB.writeFile path s'
 
-withFile :: EncryptedFile -> IOMode -> (EncryptedFileHandle -> ExceptT FTCryptoError IO a) -> ExceptT FTCryptoError IO a
-withFile (EncryptedFile path fKey_) mode action = do
-  sb <- forM fKey_ $ \(EFArgs key nonce) ->
+withFile :: CryptoFile -> IOMode -> (CryptoFileHandle -> ExceptT FTCryptoError IO a) -> ExceptT FTCryptoError IO a
+withFile (CryptoFile path cfArgs) mode action = do
+  sb <- forM cfArgs $ \(CFArgs key nonce) ->
     liftEitherWith FTCECryptoError (LC.sbInit key nonce) >>= newTVarIO
-  IO.withFile path mode $ \h -> action $ EFHandle h sb
+  IO.withFile path mode $ \h -> action $ CFHandle h sb
 
-hPut :: EncryptedFileHandle -> LazyByteString -> IO ()
-hPut (EFHandle h sb_) s = LB.hPut h =<< maybe (pure s) encrypt sb_
+hPut :: CryptoFileHandle -> LazyByteString -> IO ()
+hPut (CFHandle h sb_) s = LB.hPut h =<< maybe (pure s) encrypt sb_
   where
     encrypt sb = atomically $ stateTVar sb (`LC.sbEncryptChunkLazy` s)
 
-hPutTag :: EncryptedFileHandle -> IO ()
-hPutTag (EFHandle h sb_) = forM_ sb_ $ B.hPut h . BA.convert . LC.sbAuth <=< readTVarIO
+hPutTag :: CryptoFileHandle -> IO ()
+hPutTag (CFHandle h sb_) = forM_ sb_ $ B.hPut h . BA.convert . LC.sbAuth <=< readTVarIO
 
-hGet :: EncryptedFileHandle -> Int -> IO ByteString
-hGet (EFHandle h sb_) n = B.hGet h n >>= maybe pure decrypt sb_
+hGet :: CryptoFileHandle -> Int -> IO ByteString
+hGet (CFHandle h sb_) n = B.hGet h n >>= maybe pure decrypt sb_
   where
     decrypt sb s = atomically $ stateTVar sb (`LC.sbDecryptChunk` s)
 
 -- | Read and validate the auth tag.
 -- This function should be called after reading the whole file, it assumes you know the file size and read only the needed bytes.
-hGetTag :: EncryptedFileHandle -> ExceptT FTCryptoError IO ()
-hGetTag (EFHandle h sb_) = forM_ sb_ $ \sb -> do
+hGetTag :: CryptoFileHandle -> ExceptT FTCryptoError IO ()
+hGetTag (CFHandle h sb_) = forM_ sb_ $ \sb -> do
   tag <- liftIO $ B.hGet h C.authTagSize
   tag' <- LC.sbAuth <$> readTVarIO sb
   unless (BA.constEq tag tag') $ throwError FTCEInvalidAuthTag
 
-fileIO :: IO a -> ExceptT FTCryptoError IO a
-fileIO action = ExceptT $ first (\(e :: IOException) -> FTCEFileIOError $ show e) <$> try action
-
 data FTCryptoError
   = FTCECryptoError C.CryptoError
   | FTCEInvalidHeader String
@@ -98,3 +109,9 @@ data FTCryptoError
   | FTCEInvalidAuthTag
   | FTCEFileIOError String
   deriving (Show, Eq, Exception)
+
+plain :: FilePath -> CryptoFile
+plain = (`CryptoFile` Nothing)
+
+randomArgs :: IO CryptoFileArgs
+randomArgs = CFArgs <$> C.randomSbKey <*> C.randomCbNonce
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index ad7c81f56..fa7a35de4 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -22,6 +22,7 @@ import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
 import Simplex.Messaging.Agent (AgentClient, disconnectAgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendFile, xftpStartWorkers)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
 import Simplex.Messaging.Agent.Protocol (ACommand (..), AgentErrorType (..), BrokerErrorType (..), RcvFileId, SndFileId, noAuthSrv)
+import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (BasicAuth, ProtoServerWithAuth (..), ProtocolServer (..), XFTPServerWithAuth)
 import System.Directory (doesDirectoryExist, doesFileExist, getFileSize, listDirectory)
@@ -32,7 +33,7 @@ import XFTPCLI
 import XFTPClient
 
 xftpAgentTests :: Spec
-xftpAgentTests = around_ testBracket . describe "Functional API" $ do
+xftpAgentTests = around_ testBracket . describe "agent XFTP API" $ do
   it "should send and receive file" testXFTPAgentSendReceive
   it "should resume receiving file after restart" testXFTPAgentReceiveRestore
   it "should cleanup rcv tmp path after permanent error" testXFTPAgentReceiveCleanup
@@ -80,7 +81,6 @@ checkProgress (prev, expected) (progress, total) loop
 testXFTPAgentSendReceive :: IO ()
 testXFTPAgentSendReceive = withXFTPServer $ do
   filePath <- createRandomFile
-
   -- send file, delete snd file internally
   sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
   (rfd1, rfd2) <- runRight $ do
@@ -109,7 +109,7 @@ createRandomFile = do
 testSend :: AgentClient -> FilePath -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
 testSend sndr filePath = do
   xftpStartWorkers sndr (Just senderFiles)
-  sfId <- xftpSendFile sndr 1 filePath 2
+  sfId <- xftpSendFile sndr 1 (CF.plain filePath) 2
   sfProgress sndr $ mb 18
   ("", sfId', SFDONE sndDescr [rfd1, rfd2]) <- sfGet sndr
   liftIO $ sfId' `shouldBe` sfId
@@ -118,7 +118,7 @@ testSend sndr filePath = do
 testReceive :: AgentClient -> ValidFileDescription 'FRecipient -> FilePath -> ExceptT AgentErrorType IO RcvFileId
 testReceive rcp rfd originalFilePath = do
   xftpStartWorkers rcp (Just recipientFiles)
-  rfId <- xftpReceiveFile rcp 1 rfd
+  rfId <- xftpReceiveFile rcp 1 rfd Nothing
   rfProgress rcp $ mb 18
   ("", rfId', RFDONE path) <- rfGet rcp
   liftIO $ do
@@ -149,7 +149,7 @@ testXFTPAgentReceiveRestore = withGlobalLogging logCfgNoLogs $ do
   rcp <- getSMPAgentClient' agentCfg initAgentServers testDB2
   rfId <- runRight $ do
     xftpStartWorkers rcp (Just recipientFiles)
-    rfId <- xftpReceiveFile rcp 1 rfd
+    rfId <- xftpReceiveFile rcp 1 rfd Nothing
     liftIO $ timeout 300000 (get rcp) `shouldReturn` Nothing -- wait for worker attempt
     pure rfId
   disconnectAgentClient rcp
@@ -197,7 +197,7 @@ testXFTPAgentReceiveCleanup = withGlobalLogging logCfgNoLogs $ do
   rcp <- getSMPAgentClient' agentCfg initAgentServers testDB2
   rfId <- runRight $ do
     xftpStartWorkers rcp (Just recipientFiles)
-    rfId <- xftpReceiveFile rcp 1 rfd
+    rfId <- xftpReceiveFile rcp 1 rfd Nothing
     liftIO $ timeout 300000 (get rcp) `shouldReturn` Nothing -- wait for worker attempt
     pure rfId
   disconnectAgentClient rcp
@@ -224,7 +224,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
   sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
   sfId <- runRight $ do
     xftpStartWorkers sndr (Just senderFiles)
-    sfId <- xftpSendFile sndr 1 filePath 2
+    sfId <- xftpSendFile sndr 1 (CF.plain filePath) 2
     liftIO $ timeout 1000000 (get sndr) `shouldReturn` Nothing -- wait for worker to encrypt and attempt to create file
     pure sfId
   disconnectAgentClient sndr
@@ -273,7 +273,7 @@ testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
     sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
     sfId <- runRight $ do
       xftpStartWorkers sndr (Just senderFiles)
-      sfId <- xftpSendFile sndr 1 filePath 2
+      sfId <- xftpSendFile sndr 1 (CF.plain filePath) 2
       -- wait for progress events for 5 out of 6 chunks - at this point all chunks should be created on the server
       forM_ [1 .. 5 :: Integer] $ \_ -> do
         (_, _, SFPROG _ _) <- sfGet sndr
@@ -331,7 +331,7 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
     rcp2 <- getSMPAgentClient' agentCfg initAgentServers testDB2
     runRight $ do
       xftpStartWorkers rcp2 (Just recipientFiles)
-      rfId <- xftpReceiveFile rcp2 1 rfd2
+      rfId <- xftpReceiveFile rcp2 1 rfd2 Nothing
       ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
       liftIO $ rfId' `shouldBe` rfId
 
@@ -375,7 +375,7 @@ testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
     rcp2 <- getSMPAgentClient' agentCfg initAgentServers testDB3
     runRight $ do
       xftpStartWorkers rcp2 (Just recipientFiles)
-      rfId <- xftpReceiveFile rcp2 1 rfd2
+      rfId <- xftpReceiveFile rcp2 1 rfd2 Nothing
       ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
       liftIO $ rfId' `shouldBe` rfId
 
@@ -387,7 +387,7 @@ testXFTPAgentRequestAdditionalRecipientIDs = withXFTPServer $ do
   sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
   rfds <- runRight $ do
     xftpStartWorkers sndr (Just senderFiles)
-    sfId <- xftpSendFile sndr 1 filePath 500
+    sfId <- xftpSendFile sndr 1 (CF.plain filePath) 500
     sfProgress sndr $ mb 18
     ("", sfId', SFDONE _sndDescr rfds) <- sfGet sndr
     liftIO $ do

From b5efa05f176f4566934920be2eb00a9bb4a118ec Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 30 Aug 2023 22:26:03 +0100
Subject: [PATCH 3/4] tests, fix

---
 simplexmq.cabal                      |  1 +
 src/Simplex/FileTransfer/Agent.hs    |  3 +-
 src/Simplex/FileTransfer/Crypto.hs   |  2 +
 src/Simplex/Messaging/Crypto/File.hs |  8 +++
 tests/CoreTests/CryptoFileTests.hs   | 97 ++++++++++++++++++++++++++++
 tests/Test.hs                        |  2 +
 tests/XFTPAgent.hs                   | 81 +++++++++++++++--------
 tests/XFTPClient.hs                  |  4 +-
 8 files changed, 169 insertions(+), 29 deletions(-)
 create mode 100644 tests/CoreTests/CryptoFileTests.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 852e33a08..7850890bc 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -538,6 +538,7 @@ test-suite simplexmq-test
       AgentTests.SQLiteTests
       CLITests
       CoreTests.BatchingTests
+      CoreTests.CryptoFileTests
       CoreTests.CryptoTests
       CoreTests.EncodingTests
       CoreTests.ProtocolErrorTests
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index f0786ff45..f4eaae1a7 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -54,6 +54,7 @@ import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
+import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol (EntityId, XFTPServer)
@@ -339,7 +340,7 @@ runXFTPSndPrepareWorker c doWork = do
         encryptFileForUpload SndFile {key, nonce, srcFile} fsEncPath = do
           let CryptoFile {filePath} = srcFile
               fileName = takeFileName filePath
-          fileSize <- fromInteger <$> getFileSize filePath
+          fileSize <- liftIO $ fromInteger <$> CF.getFileContentsSize srcFile
           when (fileSize > maxFileSize) $ throwError $ INTERNAL "max file size exceeded"
           let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
               fileSize' = fromIntegral (B.length fileHdr) + fileSize
diff --git a/src/Simplex/FileTransfer/Crypto.hs b/src/Simplex/FileTransfer/Crypto.hs
index 62060c17c..64b66dfc7 100644
--- a/src/Simplex/FileTransfer/Crypto.hs
+++ b/src/Simplex/FileTransfer/Crypto.hs
@@ -34,6 +34,7 @@ encryptFile srcFile fileHdr key nonce fileSize' encSize encFile = do
         padLen = encSize - authTagSize - fileSize' - 8
     liftIO $ B.hPut w hdr
     sb2 <- encryptChunks r w (sb', fileSize' - fromIntegral (B.length fileHdr))
+    CF.hGetTag r
     sb3 <- encryptPad w (sb2, padLen)
     let tag = BA.convert $ LC.sbAuth sb3
     liftIO $ B.hPut w tag
@@ -96,6 +97,7 @@ decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse ch
             ch3 = LB.take (LB.length ch2 - len' + expectedLen) ch2
             tag :: ByteString = BA.convert (LC.sbAuth sb')
         CF.hPut h ch3
+        CF.hPutTag h
         pure $ B.length tag'' == 16 && BA.constEq tag'' tag
   where
     parseFileHeader :: LazyByteString -> ExceptT FTCryptoError IO (FileHeader, LazyByteString)
diff --git a/src/Simplex/Messaging/Crypto/File.hs b/src/Simplex/Messaging/Crypto/File.hs
index 1416d2507..ab55a9198 100644
--- a/src/Simplex/Messaging/Crypto/File.hs
+++ b/src/Simplex/Messaging/Crypto/File.hs
@@ -17,6 +17,7 @@ module Simplex.Messaging.Crypto.File
     hGetTag,
     plain,
     randomArgs,
+    getFileContentsSize,
   )
 where
 
@@ -29,12 +30,14 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.List.NonEmpty (NonEmpty (..))
+import Data.Maybe (isJust)
 import GHC.Generics (Generic)
 import Simplex.Messaging.Client.Agent ()
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Lazy (LazyByteString)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Util (liftEitherWith)
+import System.Directory (getFileSize)
 import UnliftIO (Handle, IOMode (..))
 import qualified UnliftIO as IO
 import UnliftIO.STM
@@ -115,3 +118,8 @@ plain = (`CryptoFile` Nothing)
 
 randomArgs :: IO CryptoFileArgs
 randomArgs = CFArgs <$> C.randomSbKey <*> C.randomCbNonce
+
+getFileContentsSize :: CryptoFile -> IO Integer
+getFileContentsSize (CryptoFile path cfArgs) = do
+  size <- getFileSize path
+  pure $ if isJust cfArgs then size - fromIntegral C.authTagSize else size
diff --git a/tests/CoreTests/CryptoFileTests.hs b/tests/CoreTests/CryptoFileTests.hs
new file mode 100644
index 000000000..0e750d5b9
--- /dev/null
+++ b/tests/CoreTests/CryptoFileTests.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module CoreTests.CryptoFileTests (cryptoFileTests) where
+
+import AgentTests.FunctionalAPITests (runRight_)
+import Control.Monad.Except
+import Crypto.Random (getRandomBytes)
+import qualified Data.ByteString.Lazy as LB
+import GHC.IO.IOMode (IOMode (..))
+import qualified Simplex.FileTransfer.Types as C
+import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
+import qualified Simplex.Messaging.Crypto.File as CF
+import System.Directory (getFileSize)
+import Test.Hspec
+
+cryptoFileTests :: Spec
+cryptoFileTests = do
+  it "should write/read file" testWriteReadFile
+  it "should put/get file" testPutGetFile
+  it "should write/get file" testWriteGetFile
+  it "should put/read file" testPutReadFile
+  it "should fail reading empty or small file" testSmallFile
+
+testFilePath :: FilePath
+testFilePath = "tests/tmp/testcryptofile"
+
+testWriteReadFile :: IO ()
+testWriteReadFile = do
+  s <- LB.fromStrict <$> getRandomBytes 100000
+  file <- mkCryptoFile
+  runRight_ $ do
+    CF.writeFile file s
+    liftIO $ CF.getFileContentsSize file `shouldReturn` 100000
+    liftIO $ getFileSize testFilePath `shouldReturn` 100000 + fromIntegral C.authTagSize
+    s' <- CF.readFile file
+    liftIO $ s `shouldBe` s'
+
+testPutGetFile :: IO ()
+testPutGetFile = do
+  s <- LB.fromStrict <$> getRandomBytes 50000
+  s' <- LB.fromStrict <$> getRandomBytes 50000
+  file <- mkCryptoFile
+  runRight_ $ do
+    CF.withFile file WriteMode $ \h -> liftIO $ do
+      CF.hPut h s
+      CF.hPut h s'
+      CF.hPutTag h
+    liftIO $ CF.getFileContentsSize file `shouldReturn` 100000
+    liftIO $ getFileSize testFilePath `shouldReturn` 100000 + fromIntegral C.authTagSize
+    CF.withFile file ReadMode $ \h -> do
+      s1 <- liftIO $ CF.hGet h 30000
+      s2 <- liftIO $ CF.hGet h 40000
+      s3 <- liftIO $ CF.hGet h 30000
+      CF.hGetTag h
+      liftIO $ (s <> s') `shouldBe` LB.fromStrict (s1 <> s2 <> s3)
+
+testWriteGetFile :: IO ()
+testWriteGetFile = do
+  s <- LB.fromStrict <$> getRandomBytes 100000
+  file <- mkCryptoFile
+  runRight_ $ do
+    CF.writeFile file s
+    CF.withFile file ReadMode $ \h -> do
+      s' <- liftIO $ CF.hGet h 50000
+      s'' <- liftIO $ CF.hGet h 50000
+      CF.hGetTag h
+      liftIO $ runExceptT (CF.hGetTag h) `shouldReturn` Left FTCEInvalidAuthTag
+      liftIO $ s `shouldBe` LB.fromStrict (s' <> s'')
+
+testPutReadFile :: IO ()
+testPutReadFile = do
+  s <- LB.fromStrict <$> getRandomBytes 50000
+  s' <- LB.fromStrict <$> getRandomBytes 50000
+  file <- mkCryptoFile
+  runRight_ $ do
+    CF.withFile file WriteMode $ \h -> liftIO $ do
+      CF.hPut h s
+      CF.hPut h s'
+  runExceptT (CF.readFile file) `shouldReturn` Left FTCEInvalidAuthTag
+  runRight_ $ do
+    CF.withFile file WriteMode $ \h -> liftIO $ do
+      CF.hPut h s
+      CF.hPut h s'
+      CF.hPutTag h
+    s'' <- CF.readFile file
+    liftIO $ (s <> s') `shouldBe` s''
+
+testSmallFile :: IO ()
+testSmallFile = do
+  file <- mkCryptoFile
+  LB.writeFile testFilePath ""
+  runExceptT (CF.readFile file) `shouldReturn` Left FTCEInvalidFileSize
+  LB.writeFile testFilePath "123"
+  runExceptT (CF.readFile file) `shouldReturn` Left FTCEInvalidFileSize
+
+mkCryptoFile :: IO CryptoFile
+mkCryptoFile = CryptoFile testFilePath . Just <$> CF.randomArgs
diff --git a/tests/Test.hs b/tests/Test.hs
index 21c6453e5..5c07cde1e 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -5,6 +5,7 @@ import AgentTests.SchemaDump (schemaDumpTest)
 import CLITests
 import Control.Logger.Simple
 import CoreTests.BatchingTests
+import CoreTests.CryptoFileTests
 import CoreTests.CryptoTests
 import CoreTests.EncodingTests
 import CoreTests.ProtocolErrorTests
@@ -43,6 +44,7 @@ main = do
           describe "Protocol error tests" protocolErrorTests
           describe "Version range" versionRangeTests
           describe "Encryption tests" cryptoTests
+          describe "Encrypted files tests" cryptoFileTests
           describe "Retry interval tests" retryIntervalTests
           describe "Util tests" utilTests
         describe "SMP server via TLS" $ serverTests (transport @TLS)
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index fa7a35de4..4562c5b76 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -10,8 +10,8 @@ import AgentTests.FunctionalAPITests (get, getSMPAgentClient', rfGet, runRight,
 import Control.Concurrent (threadDelay)
 import Control.Logger.Simple
 import Control.Monad.Except
-import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
 import Data.Int (Int64)
 import Data.List (find, isSuffixOf)
 import Data.Maybe (fromJust)
@@ -22,6 +22,7 @@ import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
 import Simplex.Messaging.Agent (AgentClient, disconnectAgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendFile, xftpStartWorkers)
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
 import Simplex.Messaging.Agent.Protocol (ACommand (..), AgentErrorType (..), BrokerErrorType (..), RcvFileId, SndFileId, noAuthSrv)
+import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (BasicAuth, ProtoServerWithAuth (..), ProtocolServer (..), XFTPServerWithAuth)
@@ -35,6 +36,7 @@ import XFTPClient
 xftpAgentTests :: Spec
 xftpAgentTests = around_ testBracket . describe "agent XFTP API" $ do
   it "should send and receive file" testXFTPAgentSendReceive
+  it "should send and receive with encrypted local files" testXFTPAgentSendReceiveEncrypted
   it "should resume receiving file after restart" testXFTPAgentReceiveRestore
   it "should cleanup rcv tmp path after permanent error" testXFTPAgentReceiveCleanup
   it "should resume sending file after restart" testXFTPAgentSendRestore
@@ -55,22 +57,24 @@ xftpAgentTests = around_ testBracket . describe "agent XFTP API" $ do
       it "should fail without password" $ testXFTPServerTest auth (srv Nothing) `shouldReturn` authErr
       it "should fail with incorrect password" $ testXFTPServerTest auth (srv $ Just "wrong") `shouldReturn` authErr
 
-rfProgress :: (MonadIO m, MonadFail m) => AgentClient -> Int64 -> m ()
+rfProgress :: forall m. (HasCallStack, MonadIO m, MonadFail m) => AgentClient -> Int64 -> m ()
 rfProgress c expected = loop 0
   where
+    loop :: HasCallStack => Int64 -> m ()
     loop prev = do
       (_, _, RFPROG rcvd total) <- rfGet c
       checkProgress (prev, expected) (rcvd, total) loop
 
-sfProgress :: (MonadIO m, MonadFail m) => AgentClient -> Int64 -> m ()
+sfProgress :: forall m. (HasCallStack, MonadIO m, MonadFail m) => AgentClient -> Int64 -> m ()
 sfProgress c expected = loop 0
   where
+    loop :: HasCallStack => Int64 -> m ()
     loop prev = do
       (_, _, SFPROG sent total) <- sfGet c
       checkProgress (prev, expected) (sent, total) loop
 
 -- checks that progress increases till it reaches total
-checkProgress :: MonadIO m => (Int64, Int64) -> (Int64, Int64) -> (Int64 -> m ()) -> m ()
+checkProgress :: (HasCallStack, MonadIO m) => (Int64, Int64) -> (Int64, Int64) -> (Int64 -> m ()) -> m ()
 checkProgress (prev, expected) (progress, total) loop
   | total /= expected = error "total /= expected"
   | progress <= prev = error "progress <= prev"
@@ -78,7 +82,7 @@ checkProgress (prev, expected) (progress, total) loop
   | progress < total = loop progress
   | otherwise = pure ()
 
-testXFTPAgentSendReceive :: IO ()
+testXFTPAgentSendReceive :: HasCallStack => IO ()
 testXFTPAgentSendReceive = withXFTPServer $ do
   filePath <- createRandomFile
   -- send file, delete snd file internally
@@ -99,42 +103,67 @@ testXFTPAgentSendReceive = withXFTPServer $ do
         xftpDeleteRcvFile rcp rfId
       disconnectAgentClient rcp
 
-createRandomFile :: IO FilePath
+testXFTPAgentSendReceiveEncrypted :: HasCallStack => IO ()
+testXFTPAgentSendReceiveEncrypted = withXFTPServer $ do
+  filePath <- createRandomFile
+  s <- LB.readFile filePath
+  file <- CryptoFile (senderFiles </> "encrypted_testfile") . Just <$> CF.randomArgs
+  runRight_ $ CF.writeFile file s
+  sndr <- getSMPAgentClient' agentCfg initAgentServers testDB
+  (rfd1, rfd2) <- runRight $ do
+    (sfId, _, rfd1, rfd2) <- testSendCF sndr file
+    xftpDeleteSndFileInternal sndr sfId
+    pure (rfd1, rfd2)
+  -- receive file, delete rcv file
+  testReceiveDelete rfd1 filePath
+  testReceiveDelete rfd2 filePath
+  where
+    testReceiveDelete rfd originalFilePath = do
+      rcp <- getSMPAgentClient' agentCfg initAgentServers testDB2
+      cfArgs <- Just <$> CF.randomArgs
+      runRight_ $ do
+        rfId <- testReceiveCF rcp rfd cfArgs originalFilePath
+        xftpDeleteRcvFile rcp rfId
+      disconnectAgentClient rcp
+
+createRandomFile :: HasCallStack => IO FilePath
 createRandomFile = do
   let filePath = senderFiles </> "testfile"
   xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath]
   getFileSize filePath `shouldReturn` mb 17
   pure filePath
 
-testSend :: AgentClient -> FilePath -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
-testSend sndr filePath = do
+testSend :: HasCallStack => AgentClient -> FilePath -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
+testSend sndr = testSendCF sndr . CF.plain
+
+testSendCF :: HasCallStack => AgentClient -> CryptoFile -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
+testSendCF sndr file = do
   xftpStartWorkers sndr (Just senderFiles)
-  sfId <- xftpSendFile sndr 1 (CF.plain filePath) 2
+  sfId <- xftpSendFile sndr 1 file 2
   sfProgress sndr $ mb 18
   ("", sfId', SFDONE sndDescr [rfd1, rfd2]) <- sfGet sndr
   liftIO $ sfId' `shouldBe` sfId
   pure (sfId, sndDescr, rfd1, rfd2)
 
-testReceive :: AgentClient -> ValidFileDescription 'FRecipient -> FilePath -> ExceptT AgentErrorType IO RcvFileId
-testReceive rcp rfd originalFilePath = do
+testReceive :: HasCallStack => AgentClient -> ValidFileDescription 'FRecipient -> FilePath -> ExceptT AgentErrorType IO RcvFileId
+testReceive rcp rfd = testReceiveCF rcp rfd Nothing
+
+testReceiveCF :: HasCallStack => AgentClient -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> FilePath -> ExceptT AgentErrorType IO RcvFileId
+testReceiveCF rcp rfd cfArgs originalFilePath = do
   xftpStartWorkers rcp (Just recipientFiles)
-  rfId <- xftpReceiveFile rcp 1 rfd Nothing
+  rfId <- xftpReceiveFile rcp 1 rfd cfArgs
   rfProgress rcp $ mb 18
   ("", rfId', RFDONE path) <- rfGet rcp
   liftIO $ do
     rfId' `shouldBe` rfId
-    file <- B.readFile originalFilePath
-    B.readFile path `shouldReturn` file
+    sentFile <- LB.readFile originalFilePath
+    runExceptT (CF.readFile $ CryptoFile path cfArgs) `shouldReturn` Right sentFile
   pure rfId
 
-getFileDescription :: FilePath -> ExceptT AgentErrorType IO (ValidFileDescription 'FRecipient)
-getFileDescription path =
-  ExceptT $ first (INTERNAL . ("Failed to parse file description: " <>)) . strDecode <$> B.readFile path
-
 logCfgNoLogs :: LogConfig
 logCfgNoLogs = LogConfig {lc_file = Nothing, lc_stderr = False}
 
-testXFTPAgentReceiveRestore :: IO ()
+testXFTPAgentReceiveRestore :: HasCallStack => IO ()
 testXFTPAgentReceiveRestore = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -182,7 +211,7 @@ testXFTPAgentReceiveRestore = withGlobalLogging logCfgNoLogs $ do
   -- tmp path should be removed after receiving file
   doesDirectoryExist tmpPath `shouldReturn` False
 
-testXFTPAgentReceiveCleanup :: IO ()
+testXFTPAgentReceiveCleanup :: HasCallStack => IO ()
 testXFTPAgentReceiveCleanup = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -216,7 +245,7 @@ testXFTPAgentReceiveCleanup = withGlobalLogging logCfgNoLogs $ do
   -- tmp path should be removed after permanent error
   doesDirectoryExist tmpPath `shouldReturn` False
 
-testXFTPAgentSendRestore :: IO ()
+testXFTPAgentSendRestore :: HasCallStack => IO ()
 testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -264,7 +293,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
     runRight_ $
       void $ testReceive rcp rfd1 filePath
 
-testXFTPAgentSendCleanup :: IO ()
+testXFTPAgentSendCleanup :: HasCallStack => IO ()
 testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -300,7 +329,7 @@ testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
     doesDirectoryExist prefixPath `shouldReturn` False
     doesFileExist encPath `shouldReturn` False
 
-testXFTPAgentDelete :: IO ()
+testXFTPAgentDelete :: HasCallStack => IO ()
 testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
   withXFTPServer $ do
     filePath <- createRandomFile
@@ -335,7 +364,7 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs $
       ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
       liftIO $ rfId' `shouldBe` rfId
 
-testXFTPAgentDeleteRestore :: IO ()
+testXFTPAgentDeleteRestore :: HasCallStack => IO ()
 testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -379,7 +408,7 @@ testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
       ("", rfId', RFERR (INTERNAL "XFTP {xftpErr = AUTH}")) <- rfGet rcp2
       liftIO $ rfId' `shouldBe` rfId
 
-testXFTPAgentRequestAdditionalRecipientIDs :: IO ()
+testXFTPAgentRequestAdditionalRecipientIDs :: HasCallStack => IO ()
 testXFTPAgentRequestAdditionalRecipientIDs = withXFTPServer $ do
   filePath <- createRandomFile
 
@@ -404,7 +433,7 @@ testXFTPAgentRequestAdditionalRecipientIDs = withXFTPServer $ do
     void $ testReceive rcp (rfds !! 299) filePath
     void $ testReceive rcp (rfds !! 499) filePath
 
-testXFTPServerTest :: Maybe BasicAuth -> XFTPServerWithAuth -> IO (Maybe ProtocolTestFailure)
+testXFTPServerTest :: HasCallStack => Maybe BasicAuth -> XFTPServerWithAuth -> IO (Maybe ProtocolTestFailure)
 testXFTPServerTest newFileBasicAuth srv =
   withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2} $ \_ -> do
     a <- getSMPAgentClient' agentCfg initAgentServers testDB -- initially passed server is not running
diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs
index 658344aed..50d75377a 100644
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -57,10 +57,10 @@ withXFTPServerCfg cfg =
 withXFTPServerThreadOn :: HasCallStack => (HasCallStack => ThreadId -> IO a) -> IO a
 withXFTPServerThreadOn = withXFTPServerCfg testXFTPServerConfig
 
-withXFTPServer :: IO a -> IO a
+withXFTPServer :: HasCallStack => IO a -> IO a
 withXFTPServer = withXFTPServerCfg testXFTPServerConfig . const
 
-withXFTPServer2 :: IO a -> IO a
+withXFTPServer2 :: HasCallStack => IO a -> IO a
 withXFTPServer2 = withXFTPServerCfg testXFTPServerConfig {xftpPort = xftpTestPort2, filesPath = xftpServerFiles2} . const
 
 xftpTestPort :: ServiceName

From 5ddce27299f90b3a7d91ac83f14aced92bbd3c87 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 31 Aug 2023 11:41:40 +0100
Subject: [PATCH 4/4] use CF.plain

---
 src/Simplex/FileTransfer/Client/Main.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs
index 2a05f0b5c..b40169def 100644
--- a/src/Simplex/FileTransfer/Client/Main.hs
+++ b/src/Simplex/FileTransfer/Client/Main.hs
@@ -60,6 +60,7 @@ import Simplex.FileTransfer.Types
 import Simplex.FileTransfer.Util (uniqueCombine)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
+import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
@@ -303,7 +304,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
           defChunkSize = head chunkSizes
           chunkSizes' = map fromIntegral chunkSizes
           encSize = sum chunkSizes'
-          srcFile = CryptoFile filePath Nothing
+          srcFile = CF.plain filePath
       withExceptT (CLIError . show) $ encryptFile srcFile fileHdr key nonce fileSize' encSize encPath
       digest <- liftIO $ LC.sha512Hash <$> LB.readFile encPath
       let chunkSpecs = prepareChunkSpecs encPath chunkSizes
@@ -437,7 +438,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       encSize <- liftIO $ foldM (\s path -> (s +) . fromIntegral <$> getFileSize path) 0 chunkPaths
       when (FileSize encSize /= size) $ throwError $ CLIError "File size mismatch"
       liftIO $ printNoNewLine "Decrypting file..."
-      CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap (`CryptoFile` Nothing) . getFilePath
+      CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap CF.plain . getFilePath
       forM_ chunks $ acknowledgeFileChunk a
       whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
       liftIO $ do