mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-11 01:57:20 +00:00
Evgeny Poberezkin
57 lines
2.6 KiB
Haskell
57 lines
2.6 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Simplex.Chat.Remote.Transport where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Except
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString.Builder (Builder, byteString)
|
|
import qualified Data.ByteString.Lazy as LB
|
|
import Data.Word (Word32)
|
|
import Simplex.Chat.Remote.Types
|
|
import Simplex.FileTransfer.Description (FileDigest (..))
|
|
import Simplex.FileTransfer.Transport (ReceiveFileError (..), receiveSbFile, sendEncFile)
|
|
import qualified Simplex.Messaging.Crypto as C
|
|
import qualified Simplex.Messaging.Crypto.Lazy as LC
|
|
import Simplex.Messaging.Encoding
|
|
import Simplex.Messaging.Util (liftEitherError, liftEitherWith)
|
|
import Simplex.RemoteControl.Types (RCErrorType (..))
|
|
import UnliftIO
|
|
import UnliftIO.Directory (getFileSize)
|
|
|
|
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
|
|
fileDigest <- liftIO $ FileDigest . LC.sha512Hash <$> LB.readFile filePath
|
|
fileSize' <- getFileSize filePath
|
|
when (fileSize' > toInteger (maxBound :: Word32)) $ throwError RPEFileSize
|
|
pure (fromInteger fileSize', fileDigest)
|