core: optionally encrypt SMP files (#3082)

* core: optionally encrypt SMP files

* encrypt to temp file and rename or remove encryption args if it fails

* fix file encryption error handling

src/Simplex/Chat.hs

@@ -73,6 +73,7 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
+import Simplex.Chat.Util (encryptFile)
 import Simplex.FileTransfer.Client.Main (maxFileSize)
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
 import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
@@ -1734,22 +1735,15 @@ processChatCommand = \case
       ft' <- if encrypted then encryptLocalFile ft else pure ft
       receiveFile' user ft' rcvInline_ filePath_
     where
-      encryptLocalFile ft@RcvFileTransfer {xftpRcvFile} = case xftpRcvFile of
+      encryptLocalFile ft = do
-        Nothing -> throwChatError $ CEFileInternal "locally encrypted files can't be received via SMP"
+        cfArgs <- liftIO $ CF.randomArgs
-        Just f -> do
+        withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
-          cfArgs <- liftIO $ CF.randomArgs
+        pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs}
-          withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
-          pure ft {xftpRcvFile = Just ((f :: XFTPRcvFile) {cryptoArgs = Just cfArgs})}
   SetFileToReceive fileId encrypted -> withUser $ \_ -> do
     withChatLock "setFileToReceive" . procCmd $ do
-      cfArgs <- if encrypted then fileCryptoArgs else pure Nothing
+      cfArgs <- if encrypted then Just <$> liftIO CF.randomArgs else pure Nothing
       withStore' $ \db -> setRcvFileToReceive db fileId cfArgs
       ok_
-    where
-      fileCryptoArgs = do
-        (_, RcvFileTransfer {xftpRcvFile = f}) <- withStore (`getRcvFileTransferById` fileId)
-        unless (isJust f) $ throwChatError $ CEFileInternal "locally encrypted files can't be received via SMP"
-        liftIO $ Just <$> CF.randomArgs
   CancelFile fileId -> withUser $ \user@User {userId} ->
     withChatLock "cancelFile" . procCmd $
       withStore (\db -> getFileTransfer db user fileId) >>= \case
@@ -2319,7 +2313,7 @@ receiveFile' user ft rcvInline_ filePath_ = do
       e -> throwError e
 
 acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m AChatItem
-acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
+acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} rcvInline_ filePath_ = do
   unless (fileStatus == RFSNew) $ case fileStatus of
     RFSCancelled _ -> throwChatError $ CEFileCancelled fName
     _ -> throwChatError $ CEFileAlreadyReceiving fName
@@ -2332,7 +2326,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
       filePath <- getRcvFilePath fileId filePath_ fName True
       withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath subMode
     -- XFTP
-    (Just XFTPRcvFile {cryptoArgs}, _) -> do
+    (Just XFTPRcvFile {}, _) -> do
       filePath <- getRcvFilePath fileId filePath_ fName False
       (ci, rfd) <- withStoreCtx (Just "acceptFileReceive, xftpAcceptRcvFT ...") $ \db -> do
         -- marking file as accepted and reading description in the same transaction
@@ -2406,7 +2400,7 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
     asks filesFolder >>= readTVarIO >>= \case
       Nothing -> do
         dir <- (`combine` "Downloads") <$> getHomeDirectory
-        ifM (doesDirectoryExist dir) (pure dir) getTemporaryDirectory
+        ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory
           >>= (`uniqueCombine` fn)
           >>= createEmptyFile
       Just filesFolder ->
@@ -2434,14 +2428,18 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
       pure fPath
     getTmpHandle :: FilePath -> m Handle
     getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show)
-    uniqueCombine :: FilePath -> String -> m FilePath
+
-    uniqueCombine filePath fileName = tryCombine (0 :: Int)
+uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
-      where
+uniqueCombine filePath fileName = tryCombine (0 :: Int)
-        tryCombine n =
+  where
-          let (name, ext) = splitExtensions fileName
+    tryCombine n =
-              suffix = if n == 0 then "" else "_" <> show n
+      let (name, ext) = splitExtensions fileName
-              f = filePath `combine` (name <> suffix <> ext)
+          suffix = if n == 0 then "" else "_" <> show n
-           in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
+          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
@@ -3513,12 +3511,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           RcvChunkOk ->
             if B.length chunk /= fromInteger chunkSize
               then badRcvFileChunk ft "incorrect chunk size"
-              else ack $ appendFileChunk ft chunkNo chunk
+              else ack $ appendFileChunk ft chunkNo chunk False
           RcvChunkFinal ->
             if B.length chunk > fromInteger chunkSize
               then badRcvFileChunk ft "incorrect chunk size"
               else do
-                appendFileChunk ft chunkNo chunk
+                appendFileChunk ft chunkNo chunk True
                 ci <- withStore $ \db -> do
                   liftIO $ do
                     updateRcvFileStatus db fileId FSComplete
@@ -3526,7 +3524,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                     deleteRcvFileChunks db ft
                   getChatItemByFileId db user fileId
                 toView $ CRRcvFileComplete user ci
-                closeFileHandle fileId rcvFiles
                 forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn)
           RcvChunkDuplicate -> ack $ pure ()
           RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
@@ -3772,14 +3769,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     processFDMessage fileId fileDescr = do
       ft <- withStore $ \db -> getRcvFileTransfer db user fileId
       unless (rcvFileCompleteOrCancelled ft) $ do
-        (rfd, RcvFileTransfer {fileStatus, xftpRcvFile}) <- withStore $ \db -> do
+        (rfd, RcvFileTransfer {fileStatus, xftpRcvFile, cryptoArgs}) <- withStore $ \db -> do
           rfd <- appendRcvFD db userId fileId fileDescr
           -- reading second time in the same transaction as appending description
           -- to prevent race condition with accept
           ft' <- getRcvFileTransfer db user fileId
           pure (rfd, ft')
         case (fileStatus, xftpRcvFile) of
-          (RFSAccepted _, Just XFTPRcvFile {cryptoArgs}) -> receiveViaCompleteFD user fileId rfd cryptoArgs
+          (RFSAccepted _, Just XFTPRcvFile {}) -> receiveViaCompleteFD user fileId rfd cryptoArgs
           _ -> pure ()
 
     cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
@@ -4787,8 +4784,8 @@ readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo = do
 parseFileChunk :: ChatMonad m => ByteString -> m FileChunk
 parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode
 
-appendFileChunk :: ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> m ()
+appendFileChunk :: forall m. ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> Bool -> m ()
-appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
+appendFileChunk ft@RcvFileTransfer {fileId, fileStatus, cryptoArgs} chunkNo chunk final =
   case fileStatus of
     RFSConnected RcvFileInfo {filePath} -> append_ filePath
     -- sometimes update of file transfer status to FSConnected
@@ -4797,11 +4794,27 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
     RFSCancelled _ -> pure ()
     _ -> throwChatError $ CEFileInternal "receiving file transfer not in progress"
   where
+    append_ :: FilePath -> m ()
     append_ filePath = do
       fsFilePath <- toFSFilePath filePath
       h <- getFileHandle fileId fsFilePath rcvFiles AppendMode
-      liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (ChatError . CEFileWrite filePath . show)
+      liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (fileErr  . show)
       withStore' $ \db -> updatedRcvFileChunkStored db ft chunkNo
+      when final $ do
+        closeFileHandle fileId rcvFiles
+        forM_ cryptoArgs $ \cfArgs -> do
+          tmpFile <- getChatTempDirectory >>= (`uniqueCombine` ft.fileInvitation.fileName)
+          tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
+            Right () -> do
+              removeFile fsFilePath `catchChatError` \_ -> pure ()
+              renameFile tmpFile fsFilePath
+            Left e -> do
+              toView $ CRChatError Nothing e
+              removeFile tmpFile `catchChatError` \_ -> pure ()
+              withStore' (`removeFileCryptoArgs` fileId)
+      where
+        encryptErr e = fileErr $ e <> ", received file not encrypted"
+        fileErr = ChatError . CEFileWrite filePath
 
 getFileHandle :: ChatMonad m => Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> m Handle
 getFileHandle fileId filePath files ioMode = do

src/Simplex/Chat/Mobile/File.hs

@@ -34,6 +34,7 @@ import Foreign.Ptr
 import Foreign.Storable (poke)
 import GHC.Generics (Generic)
 import Simplex.Chat.Mobile.Shared
+import Simplex.Chat.Util (chunkSize, encryptFile)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
@@ -105,16 +106,8 @@ chatEncryptFile fromPath toPath =
   where
     encrypt = do
       cfArgs <- liftIO $ CF.randomArgs
-      let toFile = CryptoFile toPath $ Just cfArgs
+      encryptFile fromPath toPath cfArgs
-      withExceptT show $
-        withFile fromPath ReadMode $ \r -> CF.withFile toFile WriteMode $ \w -> do
-          encryptChunks r w
-          liftIO $ CF.hPutTag w
       pure cfArgs
-    encryptChunks r w = do
-      ch <- liftIO $ LB.hGet r chunkSize
-      unless (LB.null ch) $ liftIO $ CF.hPut w ch
-      unless (LB.length ch < chunkSize) $ encryptChunks r w
 
 cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString
 cChatDecryptFile cFromPath cKey cNonce cToPath = do
@@ -149,7 +142,3 @@ chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runCatchExcept
 
 runCatchExceptT :: ExceptT String IO a -> IO (Either String a)
 runCatchExceptT action = runExceptT action `catchAll` (pure . Left . show)
-
-chunkSize :: Num a => a
-chunkSize = 65536
-{-# INLINE chunkSize #-}

src/Simplex/Chat/Store/Files.hs

@@ -57,6 +57,7 @@ module Simplex.Chat.Store.Files
     xftpAcceptRcvFT,
     setRcvFileToReceive,
     setFileCryptoArgs,
+    removeFileCryptoArgs,
     getRcvFilesToReceive,
     setRcvFTAgentDeleted,
     updateRcvFileStatus,
@@ -487,7 +488,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
   rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
   let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
       -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
-      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
+      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
       fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
   fileId <- liftIO $ do
     DB.execute
@@ -500,7 +501,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
       db
       "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
       (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
+  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing}
 
 createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
 createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
@@ -508,7 +509,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
   rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
   let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_
       -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
-      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
+      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
       fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
   fileId <- liftIO $ do
     DB.execute
@@ -521,7 +522,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
       db
       "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
       (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
+  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId, cryptoArgs = Nothing}
 
 createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
 createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
@@ -639,8 +640,8 @@ getRcvFileTransfer db User {userId} fileId = do
         ft senderDisplayName fileStatus =
           let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
               cryptoArgs = CFArgs <$> fileKey <*> fileNonce
-              xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, cryptoArgs}) <$> rfd_
+              xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_
-           in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
+           in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs}
         rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_
         rfi_ = case (filePath_, connId_, agentConnId_) of
           (Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
@@ -709,6 +710,11 @@ setFileCryptoArgs_ db fileId (CFArgs key nonce) currentTs =
     "UPDATE files SET file_crypto_key = ?, file_crypto_nonce = ?, updated_at = ? WHERE file_id = ?"
     (key, nonce, currentTs, fileId)
 
+removeFileCryptoArgs :: DB.Connection -> FileTransferId -> IO ()
+removeFileCryptoArgs db fileId = do
+  currentTs <- getCurrentTime
+  DB.execute db "UPDATE files SET file_crypto_key = NULL, file_crypto_nonce = NULL, updated_at = ? WHERE file_id = ?" (currentTs, fileId)
+
 getRcvFilesToReceive :: DB.Connection -> User -> IO [RcvFileTransfer]
 getRcvFilesToReceive db user@User {userId} = do
   cutoffTs <- addUTCTime (- (2 * nominalDay)) <$> getCurrentTime

src/Simplex/Chat/Types.hs

@@ -986,7 +986,10 @@ data RcvFileTransfer = RcvFileTransfer
     senderDisplayName :: ContactName,
     chunkSize :: Integer,
     cancelled :: Bool,
-    grpMemberId :: Maybe Int64
+    grpMemberId :: Maybe Int64,
+    -- XFTP files are encrypted as they are received, they are never stored unecrypted
+    -- SMP files are encrypted after all chunks are received
+    cryptoArgs :: Maybe CryptoFileArgs
   }
   deriving (Eq, Show, Generic)
 
@@ -995,8 +998,7 @@ instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.default
 data XFTPRcvFile = XFTPRcvFile
   { rcvFileDescription :: RcvFileDescr,
     agentRcvFileId :: Maybe AgentRcvFileId,
-    agentRcvFileDeleted :: Bool,
+    agentRcvFileDeleted :: Bool
-    cryptoArgs :: Maybe CryptoFileArgs
   }
   deriving (Eq, Show, Generic)
 

src/Simplex/Chat/Util.hs

@@ -1,6 +1,32 @@
-module Simplex.Chat.Util (week) where
+module Simplex.Chat.Util (week, encryptFile, chunkSize) where
 
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.IO.Class
+import qualified Data.ByteString.Lazy as LB
 import Data.Time (NominalDiffTime)
+import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
+import qualified Simplex.Messaging.Crypto.File as CF
+import UnliftIO.IO (IOMode (..), withFile)
 
 week :: NominalDiffTime
 week = 7 * 86400
+
+encryptFile :: FilePath -> FilePath -> CryptoFileArgs -> ExceptT String IO ()
+encryptFile fromPath toPath cfArgs = do
+  let toFile = CryptoFile toPath $ Just cfArgs
+  -- uncomment to test encryption error in runTestFileTransferEncrypted
+  -- throwError "test error"
+  withExceptT show $
+    withFile fromPath ReadMode $ \r -> CF.withFile toFile WriteMode $ \w -> do
+      encryptChunks r w
+      liftIO $ CF.hPutTag w
+  where
+    encryptChunks r w = do
+      ch <- liftIO $ LB.hGet r chunkSize
+      unless (LB.null ch) $ liftIO $ CF.hPut w ch
+      unless (LB.length ch < chunkSize) $ encryptChunks r w
+
+chunkSize :: Num a => a
+chunkSize = 65536
+{-# INLINE chunkSize #-}

src/Simplex/Chat/View.hs

@@ -1592,8 +1592,8 @@ viewChatError logLevel = \case
     CEFileCancelled f -> ["file cancelled: " <> plain f]
     CEFileCancel fileId e -> ["error cancelling file " <> sShow fileId <> ": " <> sShow e]
     CEFileAlreadyExists f -> ["file already exists: " <> plain f]
-    CEFileRead f e -> ["cannot read file " <> plain f, sShow e]
+    CEFileRead f e -> ["cannot read file " <> plain f <> ": " <> plain e]
-    CEFileWrite f e -> ["cannot write file " <> plain f, sShow e]
+    CEFileWrite f e -> ["cannot write file " <> plain f <> ": " <> plain e]
     CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
     CEFileRcvChunk e -> ["error receiving file: " <> plain e]
     CEFileInternal e -> ["file error: " <> plain e]

tests/ChatTests/Files.hs

@@ -31,6 +31,7 @@ chatFileTests :: SpecWith FilePath
 chatFileTests = do
   describe "sending and receiving files" $ do
     describe "send and receive file" $ fileTestMatrix2 runTestFileTransfer
+    describe "send file, receive and locally encrypt file" $ fileTestMatrix2 runTestFileTransferEncrypted
     it "send and receive file inline (without accepting)" testInlineFileTransfer
     xit'' "accept inline file transfer, sender cancels during transfer" testAcceptInlineFileSndCancelDuringTransfer
     it "send and receive small file inline (default config)" testSmallInlineFileTransfer
@@ -97,6 +98,37 @@ runTestFileTransfer alice bob = do
   dest <- B.readFile "./tests/tmp/test.pdf"
   dest `shouldBe` src
 
+runTestFileTransferEncrypted :: HasCallStack => TestCC -> TestCC -> IO ()
+runTestFileTransferEncrypted alice bob = do
+  connectUsers alice bob
+  alice #> "/f @bob ./tests/fixtures/test.pdf"
+  alice <## "use /fc 1 to cancel sending"
+  bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+  bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+  bob ##> "/fr 1 encrypt=on ./tests/tmp"
+  bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+  Just (CFArgs key nonce) <- J.decode . LB.pack <$> getTermLine bob
+  concurrently_
+    (bob <## "started receiving file 1 (test.pdf) from alice")
+    (alice <## "started sending file 1 (test.pdf) to bob")
+
+  concurrentlyN_
+    [ do
+        bob #> "@alice receiving here..."
+        -- uncomment this and below to test encryption error in encryptFile
+        -- bob <## "cannot write file ./tests/tmp/test.pdf: test error, received file not encrypted"
+        bob <## "completed receiving file 1 (test.pdf) from alice",
+      alice
+        <### [ WithTime "bob> receiving here...",
+               "completed sending file 1 (test.pdf) to bob"
+             ]
+    ]
+  src <- B.readFile "./tests/fixtures/test.pdf"
+  -- dest <- B.readFile "./tests/tmp/test.pdf"
+  -- dest `shouldBe` src
+  Right dest <- chatReadFile "./tests/tmp/test.pdf" (strEncode key) (strEncode nonce)
+  LB.toStrict dest `shouldBe` src
+
 testInlineFileTransfer :: HasCallStack => FilePath -> IO ()
 testInlineFileTransfer =
   testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do