core: encrypt stored/loaded remote files (#3366)

* core: encrypt stored/loaded remote files

* simplexmq

* constant

src/Simplex/Chat/Remote.hs

@@ -62,7 +62,6 @@ import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (TLS, closeConnection, tlsUniq)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError, closeHTTP2Client)
-import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Transport.HTTP2.Server (HTTP2Request (..))
 import Simplex.Messaging.Util
 import Simplex.RemoteControl.Client
@@ -399,8 +398,8 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
     processCommand user getNext = \case
       RCSend {command} -> handleSend execChatCommand command >>= reply
       RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
-      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile fileName fileSize fileDigest getNext >>= reply
-      RCGetFile {file} -> handleGetFile user file replyWith
+      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile encryption fileName fileSize fileDigest getNext >>= reply
+      RCGetFile {file} -> handleGetFile encryption user file replyWith
     reply :: RemoteResponse -> m ()
     reply = (`replyWith` \_ -> pure ())
     replyWith :: Respond m
@@ -444,8 +443,8 @@ handleRecv time events = do
 
 -- TODO this command could remember stored files and return IDs to allow removing files that are not needed.
 -- Also, there should be some process removing unused files uploaded to remote host (possibly, all unused files).
-handleStoreFile :: forall m. ChatMonad m => FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
-handleStoreFile fileName fileSize fileDigest getChunk =
+handleStoreFile :: forall m. ChatMonad m => RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
+handleStoreFile encryption fileName fileSize fileDigest getChunk =
   either RRProtocolError RRFileStored <$> (chatReadVar filesFolder >>= storeFile)
   where
     storeFile :: Maybe FilePath -> m (Either RemoteProtocolError FilePath)
@@ -455,11 +454,11 @@ handleStoreFile fileName fileSize fileDigest getChunk =
     storeFileTo :: FilePath -> m (Either RemoteProtocolError FilePath)
     storeFileTo dir = liftRC . tryRemoteError $ do
       filePath <- dir `uniqueCombine` fileName
-      receiveRemoteFile getChunk fileSize fileDigest filePath
+      receiveEncryptedFile encryption getChunk fileSize fileDigest filePath
       pure filePath
 
-handleGetFile :: ChatMonad m => User -> RemoteFile -> Respond m -> m ()
-handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
+handleGetFile :: ChatMonad m => RemoteCrypto -> User -> RemoteFile -> Respond m -> m ()
+handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
   logDebug $ "GetFile: " <> tshow filePath
   unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId}
   path <- maybe filePath (</> filePath) <$> chatReadVar filesFolder
@@ -469,8 +468,9 @@ handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fi
   liftRC (tryRemoteError $ getFileInfo path) >>= \case
     Left e -> reply (RRProtocolError e) $ \_ -> pure ()
     Right (fileSize, fileDigest) ->
-      withFile path ReadMode $ \h ->
-        reply RRFile {fileSize, fileDigest} $ \send -> hSendFile h send fileSize
+      withFile path ReadMode $ \h -> do
+        encFile <- liftRC $ prepareEncryptedFile encryption (h, fileSize)
+        reply RRFile {fileSize, fileDigest} $ sendEncryptedFile encFile
 
 discoverRemoteCtrls :: ChatMonad m => TM.TMap C.KeyHash (TransportHost, Word16) -> m ()
 discoverRemoteCtrls discovered = do

src/Simplex/Chat/Remote/Protocol.hs

@@ -47,7 +47,6 @@ import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFi
 import Simplex.Messaging.Transport.Buffer (getBuffered)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
-import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
 import Simplex.Messaging.Util (liftEitherError, liftEitherWith, liftError, tshow)
 import Simplex.RemoteControl.Types (CtrlSessKeys (..), HostSessKeys (..), RCErrorType (..), SessionCode)
 import Simplex.RemoteControl.Client (xrcpBlockSize)
@@ -127,31 +126,30 @@ remoteStoreFile c localPath fileName = do
     r -> badResponse r
 
 remoteGetFile :: RemoteHostClient -> FilePath -> RemoteFile -> ExceptT RemoteProtocolError IO ()
-remoteGetFile c destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
+remoteGetFile c@RemoteHostClient{encryption} destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} =
   sendRemoteCommand c Nothing RCGetFile {file = rf} >>= \case
     (getChunk, RRFile {fileSize, fileDigest}) -> do
       -- TODO we could optimize by checking size and hash before receiving the file
       let localPath = destDir </> takeFileName filePath
-      receiveRemoteFile getChunk fileSize fileDigest localPath
+      receiveEncryptedFile encryption getChunk fileSize fileDigest localPath
     (_, r) -> badResponse r
 
--- TODO validate there is no attachment
+-- TODO validate there is no attachment in response
 sendRemoteCommand' :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse
 sendRemoteCommand' c attachment_ rc = snd <$> sendRemoteCommand c attachment_ rc
 
 sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
-sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} attachment_ cmd = do
-  req <- httpRequest <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
+sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_ cmd = do
+  encFile_ <- mapM (prepareEncryptedFile encryption) file_ 
+  req <- httpRequest encFile_ <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
   HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
   (header, getNext) <- parseDecryptHTTP2Body encryption response respBody
   rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecode header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
   pure (getNext, rr)
   where
-    httpRequest cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
+    httpRequest encFile_ cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
       send cmdBld
-      case attachment_ of
-        Nothing -> pure ()
-        Just (h, sz) -> hSendFile h send sz
+      forM_ encFile_ (`sendEncryptedFile` send)
       flush
 
 badResponse :: RemoteResponse -> ExceptT RemoteProtocolError IO a

src/Simplex/Chat/Remote/Transport.hs

@@ -1,23 +1,52 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Simplex.Chat.Remote.Transport where
 
 import Control.Monad
 import Control.Monad.Except
+import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Word (Word32)
 import Simplex.FileTransfer.Description (FileDigest (..))
 import Simplex.Chat.Remote.Types
+import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
-import Simplex.Messaging.Transport.HTTP2.File (hReceiveFile)
+import Simplex.FileTransfer.Transport (ReceiveFileError (..), receiveSbFile, sendEncFile)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith)
+import Simplex.RemoteControl.Types (RCErrorType (..))
 import UnliftIO
 import UnliftIO.Directory (getFileSize)
 
-receiveRemoteFile :: (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO ()
-receiveRemoteFile getChunk fileSize fileDigest toPath = do
-  diff <- liftIO $ withFile toPath WriteMode $ \h -> hReceiveFile getChunk h fileSize
-  unless (diff == 0) $ throwError RPEFileSize
+type EncryptedFile = ((Handle, Word32), C.CbNonce, LC.SbState)
+
+prepareEncryptedFile :: RemoteCrypto -> (Handle, Word32) -> ExceptT RemoteProtocolError IO EncryptedFile
+prepareEncryptedFile RemoteCrypto {drg, hybridKey} f = do
+  nonce <- atomically $ C.pseudoRandomCbNonce drg
+  sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.kcbInit hybridKey nonce
+  pure (f, nonce, sbState)
+
+sendEncryptedFile :: EncryptedFile -> (Builder -> IO ()) -> IO ()
+sendEncryptedFile ((h, sz), nonce, sbState) send = do
+  send $ byteString $ smpEncode ('\x01', nonce, sz + fromIntegral C.authTagSize)
+  sendEncFile h send sbState sz
+
+receiveEncryptedFile :: RemoteCrypto -> (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO ()
+receiveEncryptedFile RemoteCrypto {hybridKey} getChunk fileSize fileDigest toPath = do
+  c <- liftIO $ getChunk 1
+  unless (c == "\x01") $ throwError RPENoFile
+  nonce <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 24
+  size <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 4
+  unless (size == fileSize + fromIntegral C.authTagSize) $ throwError RPEFileSize
+  sbState <- liftEitherWith (const $ PRERemoteControl RCEDecrypt) $ LC.kcbInit hybridKey nonce
+  liftEitherError fErr $ withFile toPath WriteMode $ \h -> receiveSbFile getChunk h sbState fileSize
   digest <- liftIO $ LC.sha512Hash <$> LB.readFile toPath
   unless (FileDigest digest == fileDigest) $ throwError RPEFileDigest
+  where
+    fErr RFESize = RPEFileSize
+    fErr RFECrypto = PRERemoteControl RCEDecrypt
 
 getFileInfo :: FilePath -> ExceptT RemoteProtocolError IO (Word32, FileDigest)
 getFileInfo filePath = do