core: compress commands in remote connection

This commit is contained in:
Evgeny Poberezkin 2025-03-22 09:09:37 +00:00
parent 15742aee30
commit b678ccd900
No known key found for this signature in database
GPG key ID: 494BDDD9A28B577D
3 changed files with 14 additions and 5 deletions

View file

@ -276,6 +276,7 @@ library
, unliftio-core ==0.2.*
, uuid ==1.3.*
, zip ==2.0.*
, zstd ==0.1.3.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON

View file

@ -509,7 +509,7 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
parseRequest :: ExceptT RemoteProtocolError IO (C.SbKeyNonce, GetChunk, RemoteCommand)
parseRequest = do
(rfKN, header, getNext) <- parseDecryptHTTP2Body encryption request reqBody
(rfKN,getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecode header)
(rfKN,getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecodeStrict header)
replyError = reply . RRChatResponse . CRChatCmdError Nothing
processCommand :: User -> C.SbKeyNonce -> GetChunk -> RemoteCommand -> CM ()
processCommand user rfKN getNext = \case

View file

@ -11,6 +11,7 @@
module Simplex.Chat.Remote.Protocol where
import qualified Codec.Compression.Zstd as Z1
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
@ -27,6 +28,7 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Builder (Builder, byteString, lazyByteString)
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Lazy.Internal as LB
import Data.String (fromString)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
@ -152,7 +154,7 @@ sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_
let req = httpRequest encFile_ encCmd
HTTP2Response {response, respBody} <- liftError' (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
(rfKN, header, getNext) <- parseDecryptHTTP2Body encryption response respBody
rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecode header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecodeStrict header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
pure (rfKN, getNext, rr)
where
httpRequest encFile_ cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do
@ -224,7 +226,8 @@ pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
encryptEncodeHTTP2Body :: Word32 -> C.SbKeyNonce -> RemoteCrypto -> LazyByteString -> ExceptT RemoteProtocolError IO Builder
encryptEncodeHTTP2Body corrId cmdKN RemoteCrypto {sessionCode, signatures} s = do
ct <- liftError PRERemoteControl $ RC.rcEncryptBody cmdKN $ LB.fromStrict (smpEncode sessionCode) <> s
let s' = LB.fromStrict $ Z1.compress 3 $ LB.toStrict s
ct <- liftError PRERemoteControl $ RC.rcEncryptBody cmdKN $ LB.Chunk (smpEncode sessionCode) s'
let ctLen = encodeWord32 (fromIntegral $ LB.length ct)
signed = LB.fromStrict (encodeWord32 corrId <> ctLen) <> ct
sigs <- bodySignatures signed
@ -242,12 +245,12 @@ encryptEncodeHTTP2Body corrId cmdKN RemoteCrypto {sessionCode, signatures} s = d
sign k = C.signatureBytes . C.sign' k . BA.convert . CH.hashFinalize
-- | Parse and decrypt HTTP2 request/response
parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, LazyByteString, Int -> IO ByteString)
parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, ByteString, Int -> IO ByteString)
parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures} hr HTTP2Body {bodyBuffer} = do
(corrId, ct) <- getBody
(cmdKN, rfKN) <- ExceptT $ atomically $ getRemoteRcvKeys rc corrId
s <- liftError PRERemoteControl $ RC.rcDecryptBody cmdKN ct
s' <- parseBody s
s' <- decompress =<< parseBody s
pure (rfKN, s', getNext)
where
getBody :: ExceptT RemoteProtocolError IO (Word32, LazyByteString)
@ -296,3 +299,8 @@ parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures} hr HTTP2Body {bo
unless (LB.length bs == n) $ throwError PRESessionCode
pure (LB.toStrict bs, rest)
getNext sz = getBuffered bodyBuffer sz Nothing $ getBodyChunk hr
decompress :: LazyByteString -> ExceptT RemoteProtocolError IO ByteString
decompress s = case Z1.decompress $ LB.toStrict s of
Z1.Error e -> throwError $ RPEInvalidBody e
Z1.Skip -> pure B.empty
Z1.Decompress s' -> pure s'