From 6f11e2a6489aa2cdf477b045a4372fff548841a8 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 10 Feb 2026 14:09:32 +0000 Subject: [PATCH] concurrent and padded hellos in the server --- src/Simplex/FileTransfer/Agent.hs | 4 ++-- src/Simplex/FileTransfer/Client/Main.hs | 23 +++++++++++++---------- src/Simplex/FileTransfer/Crypto.hs | 3 ++- src/Simplex/FileTransfer/Server.hs | 20 +++++++++++++------- src/Simplex/FileTransfer/Types.hs | 5 +++-- src/Simplex/Messaging/Encoding.hs | 8 ++++++++ 6 files changed, 41 insertions(+), 22 deletions(-) diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs index ff271240b..a8b220327 100644 --- a/src/Simplex/FileTransfer/Agent.hs +++ b/src/Simplex/FileTransfer/Agent.hs @@ -47,7 +47,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as S -import Data.Text (Text) +import Data.Text (Text, pack) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Simplex.FileTransfer.Chunks (toKB) @@ -433,7 +433,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do encryptFileForUpload :: SndFile -> FilePath -> AM (FileDigest, [(XFTPChunkSpec, FileDigest)]) encryptFileForUpload SndFile {key, nonce, srcFile, redirect} fsEncPath = do let CryptoFile {filePath} = srcFile - fileName = takeFileName filePath + fileName = pack $ takeFileName filePath fileSize <- liftIO $ fromInteger <$> CF.getFileContentsSize srcFile when (fileSize > maxFileSizeHard) $ throwE $ FILE FT.SIZE let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing} diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index c73cac637..21b5f1b30 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -41,6 +41,7 @@ import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) +import Data.Text (Text) import qualified Data.Text as T import Data.Word (Word32) import GHC.Records (HasField (getField)) @@ -242,7 +243,8 @@ cliSendFile opts = cliSendFileOpts opts True $ printProgress "Uploaded" cliSendFileOpts :: SendOptions -> Bool -> (Int64 -> Int64 -> IO ()) -> ExceptT CLIError IO () cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, retryCount, tempPath, verbose} printInfo notifyProgress = do - let (_, fileName) = splitFileName filePath + let (_, fileNameStr) = splitFileName filePath + fileName = T.pack fileNameStr liftIO $ when printInfo $ printNoNewLine "Encrypting file..." g <- liftIO C.newRandom (encPath, fdRcv, fdSnd, chunkSpecs, encSize) <- encryptFileForUpload g fileName @@ -254,14 +256,14 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re liftIO $ do let fdRcvs = createRcvFileDescriptions fdRcv sentChunks fdSnd' = createSndFileDescription fdSnd sentChunks - (fdRcvPaths, fdSndPath) <- writeFileDescriptions fileName fdRcvs fdSnd' + (fdRcvPaths, fdSndPath) <- writeFileDescriptions fileNameStr fdRcvs fdSnd' when printInfo $ do printNoNewLine "File uploaded!" putStrLn $ "\nSender file description: " <> fdSndPath putStrLn "Pass file descriptions to the recipient(s):" forM_ fdRcvPaths putStrLn where - encryptFileForUpload :: TVar ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64) + encryptFileForUpload :: TVar ChaChaDRG -> Text -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64) encryptFileForUpload g fileName = do fileSize <- fromInteger <$> getFileSize filePath when (fileSize > maxFileSize) $ throwE $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported" @@ -430,13 +432,14 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, when verbose $ putStrLn "" pure (chunkNo, chunkPath) downloadFileChunk _ _ _ _ _ _ = throwE $ CLIError "chunk has no replicas" - getFilePath :: String -> ExceptT String IO FilePath - getFilePath name = - case filePath of - Just path -> - ifM (doesDirectoryExist path) (uniqueCombine path name) $ - ifM (doesFileExist path) (throwE "File already exists") (pure path) - _ -> (`uniqueCombine` name) . ( "Downloads") =<< getHomeDirectory + getFilePath :: Text -> ExceptT String IO FilePath + getFilePath name = case filePath of + Just path -> + ifM (doesDirectoryExist path) (uniqueCombine path name') $ + ifM (doesFileExist path) (throwE "File already exists") (pure path) + _ -> (`uniqueCombine` name') . ( "Downloads") =<< getHomeDirectory + where + name' = T.unpack name acknowledgeFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO () acknowledgeFileChunk a FileChunk {replicas = replica : _} = do let FileChunkReplica {server, replicaId, replicaKey} = replica diff --git a/src/Simplex/FileTransfer/Crypto.hs b/src/Simplex/FileTransfer/Crypto.hs index 72344f3c0..6c9039e0c 100644 --- a/src/Simplex/FileTransfer/Crypto.hs +++ b/src/Simplex/FileTransfer/Crypto.hs @@ -16,6 +16,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.Int (Int64) +import Data.Text (Text) import Simplex.FileTransfer.Types (FileHeader (..), authTagSize) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..)) @@ -54,7 +55,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 CryptoFile) -> ExceptT FTCryptoError IO CryptoFile +decryptChunks :: Int64 -> [FilePath] -> C.SbKey -> C.CbNonce -> (Text -> ExceptT String IO CryptoFile) -> ExceptT FTCryptoError IO CryptoFile decryptChunks _ [] _ _ _ = throwE $ FTCEInvalidHeader "empty" decryptChunks encSize (chPath : chPaths) key nonce getDestFile = case reverse chPaths of [] -> do diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index 762e86ceb..0c75daee5 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -167,26 +167,32 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira s <- atomically $ TM.lookup sessionId sessions r <- runExceptT $ case s of Nothing -> processHello Nothing - Just (HandshakeSent pk) -> processClientHandshake pk + Just (HandshakeSent pk) + | webHello -> processHello (Just pk) + | otherwise -> processClientHandshake pk Just (HandshakeAccepted thParams) | webHello -> processHello (serverPrivKey <$> thAuth thParams) + | webHandshake, Just auth <- thAuth thParams -> processClientHandshake (serverPrivKey auth) | otherwise -> pure $ Just thParams either sendError pure r where webHello = sniUsed && any (\(t, _) -> tokenKey t == "xftp-web-hello") (fst $ H.requestHeaders request) + webHandshake = sniUsed && any (\(t, _) -> tokenKey t == "xftp-handshake") (fst $ H.requestHeaders request) processHello pk_ = do challenge_ <- if | B.null bodyHead -> pure Nothing | sniUsed -> do - XFTPClientHello {webChallenge} <- liftHS $ smpDecode bodyHead + body <- liftHS $ C.unPad bodyHead + XFTPClientHello {webChallenge} <- liftHS $ smpDecode body pure webChallenge | otherwise -> throwE HANDSHAKE - (k, pk) <- maybe - (atomically . C.generateKeyPair =<< asks random) - (\pk -> pure (C.publicKey pk, pk)) - pk_ - atomically $ TM.insert sessionId (HandshakeSent pk) sessions + rng <- asks random + k <- atomically $ TM.lookup sessionId sessions >>= \case + Just (HandshakeSent pk') -> pure $ C.publicKey pk' + _ -> do + kp <- maybe (C.generateKeyPair rng) (\p -> pure (C.publicKey p, p)) pk_ + fst kp <$ TM.insert sessionId (HandshakeSent $ snd kp) sessions let authPubKey = CertChainPubKey chain (C.signX509 serverSignKey $ C.publicToX509 k) webIdentityProof = C.sign serverSignKey . (<> sessionId) <$> challenge_ let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey, webIdentityProof} diff --git a/src/Simplex/FileTransfer/Types.hs b/src/Simplex/FileTransfer/Types.hs index aa465a12e..8c48b25c4 100644 --- a/src/Simplex/FileTransfer/Types.hs +++ b/src/Simplex/FileTransfer/Types.hs @@ -10,6 +10,7 @@ import qualified Data.Aeson.TH as J import qualified Data.Attoparsec.ByteString.Char8 as A import Data.ByteString.Char8 (ByteString) import Data.Int (Int64) +import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Word (Word32) @@ -33,8 +34,8 @@ authTagSize = fromIntegral C.authTagSize -- fileExtra is added to allow header extension in future versions data FileHeader = FileHeader - { fileName :: String, - fileExtra :: Maybe String + { fileName :: Text, + fileExtra :: Maybe Text } deriving (Eq, Show) diff --git a/src/Simplex/Messaging/Encoding.hs b/src/Simplex/Messaging/Encoding.hs index ef0033dfb..d069e5518 100644 --- a/src/Simplex/Messaging/Encoding.hs +++ b/src/Simplex/Messaging/Encoding.hs @@ -24,6 +24,8 @@ import Data.Bits (shiftL, shiftR, (.|.)) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.ByteString.Internal (c2w, w2c) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8', encodeUtf8) import Data.Int (Int64) import qualified Data.List.NonEmpty as L import Data.Time.Clock.System (SystemTime (..)) @@ -156,6 +158,12 @@ smpEncodeList xs = B.cons (lenEncode $ length xs) . B.concat $ map smpEncode xs smpListP :: Encoding a => Parser [a] smpListP = (`A.count` smpP) =<< lenP +instance Encoding Text where + smpEncode = smpEncode . encodeUtf8 + {-# INLINE smpEncode #-} + smpP = either (fail . show) pure . decodeUtf8' =<< smpP + {-# INLINE smpP #-} + instance Encoding String where smpEncode = smpEncode . B.pack {-# INLINE smpEncode #-}