From 0a4920daae4ea8f042fe227d9588d2bd22151489 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Tue, 14 Nov 2023 16:44:12 +0000 Subject: [PATCH] core: encrypt stored/loaded remote files (#3366) * core: encrypt stored/loaded remote files * simplexmq * constant --- src/Simplex/Chat/Remote.hs | 20 +++++++------- src/Simplex/Chat/Remote/Protocol.hs | 18 ++++++------- src/Simplex/Chat/Remote/Transport.hs | 39 ++++++++++++++++++++++++---- 3 files changed, 52 insertions(+), 25 deletions(-) diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index bb96107127..49c29b6733 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/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 diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs index eae71d09c7..c1acee1e0f 100644 --- a/src/Simplex/Chat/Remote/Protocol.hs +++ b/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 diff --git a/src/Simplex/Chat/Remote/Transport.hs b/src/Simplex/Chat/Remote/Transport.hs index bf798444c0..c5ddfbdb8f 100644 --- a/src/Simplex/Chat/Remote/Transport.hs +++ b/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