core: compress commands in remote connection (#5776)

* core: compress commands in remote connection * backwards compatible compression * show in CLI if compression is enabled * use aroundWith for ghc 8.10.7 compatibility * skip bot API tests in GHC 8.10.7
2026-10-23 19:23:36 +00:00 · 2025-12-30 07:49:17 +00:00
1 parent e3fd481bfb
commit 59b31e2631
@@ -110,6 +110,7 @@ defaultChatConfig =
      deliveryWorkerDelay = 0,
      deliveryBucketSize = 10000,
      deviceNameForRemote = "",
+      remoteCompression = True,
      chatHooks = defaultChatHooks
    }

@@ -159,6 +159,7 @@ data ChatConfig = ChatConfig
    deliveryBucketSize :: Int,
    highlyAvailable :: Bool,
    deviceNameForRemote :: Text,
+    remoteCompression :: Bool,
    chatHooks :: ChatHooks
  }

@@ -754,7 +755,7 @@ data ChatResponse
  | CRRemoteFileStored {remoteHostId :: RemoteHostId, remoteFileSource :: CryptoFile}
  | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
  | CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo, ctrlAppInfo :: CtrlAppInfo, appVersion :: AppVersion}
-  | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
+  | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo, compression :: Bool}
  | CRSQLResult {rows :: [Text]}
 #if !defined(dbPostgres)
  | CRArchiveExported {archiveErrors :: [ArchiveError]}
@@ -857,7 +858,7 @@ data ChatEvent
  | CEvtNtfMessage {user :: User, connEntity :: ConnectionEntity, ntfMessage :: NtfMsgAckInfo}
  | CEvtRemoteHostSessionCode {remoteHost_ :: Maybe RemoteHostInfo, sessionCode :: Text}
  | CEvtNewRemoteHost {remoteHost :: RemoteHostInfo}
-  | CEvtRemoteHostConnected {remoteHost :: RemoteHostInfo}
+  | CEvtRemoteHostConnected {remoteHost :: RemoteHostInfo, compression :: Bool}
  | CEvtRemoteHostStopped {remoteHostId_ :: Maybe RemoteHostId, rhsState :: RemoteHostSessionState, rhStopReason :: RemoteHostStopReason}
  | CEvtRemoteCtrlFound {remoteCtrl :: RemoteCtrlInfo, ctrlAppInfo_ :: Maybe CtrlAppInfo, appVersion :: AppVersion, compatible :: Bool}
  | CEvtRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
@@ -897,7 +898,7 @@ allowRemoteEvent = \case
  CEvtChatSuspended -> False
  CEvtRemoteHostSessionCode {} -> False
  CEvtNewRemoteHost _ -> False
-  CEvtRemoteHostConnected _ -> False
+  CEvtRemoteHostConnected {} -> False
  CEvtRemoteHostStopped {} -> False
  CEvtRemoteCtrlFound {} -> False
  CEvtRemoteCtrlSessionCode {} -> False
@@ -1397,7 +1398,8 @@ data RemoteCtrlSession
  | RCSessionConnecting
      { remoteCtrlId_ :: Maybe RemoteCtrlId,
        rcsClient :: RCCtrlClient,
-        rcsWaitSession :: Async ()
+        rcsWaitSession :: Async (),
+        ctrlAppInfo :: CtrlAppInfo
      }
  | RCSessionPendingConfirmation
      { remoteCtrlId_ :: Maybe RemoteCtrlId,
@@ -1406,7 +1408,8 @@ data RemoteCtrlSession
        tls :: TLS 'TClient,
        sessionCode :: Text,
        rcsWaitSession :: Async (),
-        rcsWaitConfirmation :: TMVar (Either RCErrorType (RCCtrlSession, RCCtrlPairing))
+        rcsWaitConfirmation :: TMVar (Either RCErrorType (RCCtrlSession, RCCtrlPairing)),
+        ctrlAppInfo :: CtrlAppInfo
      }
  | RCSessionConnected
      { remoteCtrlId :: RemoteCtrlId,
@@ -1414,7 +1417,8 @@ data RemoteCtrlSession
        tls :: TLS 'TClient,
        rcsSession :: RCCtrlSession,
        http2Server :: Async (),
-        remoteOutputQ :: TBQueue (Either ChatError ChatEvent)
+        remoteOutputQ :: TBQueue (Either ChatError ChatEvent),
+        ctrlAppInfo :: CtrlAppInfo
      }

 data RemoteCtrlSessionState
@@ -2959,7 +2959,7 @@ processChatCommand vr nm = \case
  ConfirmRemoteCtrl rcId -> withUser_ $ do
    (rc, ctrlAppInfo) <- confirmRemoteCtrl rcId
    pure CRRemoteCtrlConnecting {remoteCtrl_ = Just rc, ctrlAppInfo, appVersion = currentAppVersion}
-  VerifyRemoteCtrlSession sessId -> withUser_ $ CRRemoteCtrlConnected <$> verifyRemoteCtrlSession (execChatCommand Nothing) sessId
+  VerifyRemoteCtrlSession sessId -> withUser_ $ verifyRemoteCtrlSession (execChatCommand Nothing) sessId
  StopRemoteCtrl -> withUser_ $ stopRemoteCtrl >> ok_
  ListRemoteCtrls -> withUser_ $ CRRemoteCtrlList <$> listRemoteCtrls
  DeleteRemoteCtrl rc -> withUser_ $ deleteRemoteCtrl rc >> ok_
@@ -165,7 +165,8 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
  where
    mkCtrlAppInfo = do
      deviceName <- chatReadVar localDeviceName
-      pure CtrlAppInfo {appVersionRange = ctrlAppVersionRange, deviceName}
+      useCompression <- asks $ remoteCompression . config
+      pure CtrlAppInfo {appVersionRange = ctrlAppVersionRange, deviceName, compression = BoolDef useCompression}
    parseHostAppInfo :: RCHostHello -> ExceptT RemoteHostError IO HostAppInfo
    parseHostAppInfo RCHostHello {app = hostAppInfo} = do
      hostInfo@HostAppInfo {appVersion, encoding} <-
@@ -213,7 +214,9 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
        RHSessionConfirmed _ RHPendingSession {rchClient} -> Right ((), RHSessionConnected {rchClient, tls, rhClient, pollAction, storePath})
        _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
      chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
-      toView $ CEvtRemoteHostConnected rhi {sessionState = Just RHSConnected {sessionCode}}
+      let RemoteHostClient {encryption = RemoteCrypto {compression}} = rhClient
+          remoteHost = rhi {sessionState = Just RHSConnected {sessionCode}} :: RemoteHostInfo
+      toView $ CEvtRemoteHostConnected {remoteHost, compression}
    upsertRemoteHost :: RCHostPairing -> Maybe RemoteHostInfo -> Maybe RCCtrlAddress -> Text -> SessionSeq -> RemoteHostSessionState -> CM RemoteHostInfo
    upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ rcAddr_ hostDeviceName sseq state = do
      KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
@@ -459,7 +462,7 @@ startRemoteCtrlSession = do

 connectRemoteCtrl :: RCVerifiedInvitation -> SessionSeq -> CM (Maybe RemoteCtrlInfo, CtrlAppInfo)
 connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app}) sseq = handleCtrlError sseq RCSRConnectionFailed "connectRemoteCtrl" $ do
-  ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName} <- parseCtrlAppInfo app
+  ctrlInfo <- parseCtrlAppInfo app
  v <- checkAppVersion ctrlInfo
  rc_ <- withStore' $ \db -> getRemoteCtrlByFingerprint db ca
  mapM_ (validateRemoteCtrl inv) rc_
@@ -469,23 +472,23 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
  cmdOk <- newEmptyTMVarIO
  rcsWaitSession <- async $ do
    atomically $ takeTMVar cmdOk
-    handleCtrlError sseq RCSRConnectionFailed "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlDeviceName rcsClient vars
+    handleCtrlError sseq RCSRConnectionFailed "waitForCtrlSession" $ waitForCtrlSession rc_ ctrlInfo rcsClient vars
  updateRemoteCtrlSession sseq $ \case
-    RCSessionStarting -> Right RCSessionConnecting {remoteCtrlId_ = remoteCtrlId' <$> rc_, rcsClient, rcsWaitSession}
+    RCSessionStarting -> Right RCSessionConnecting {remoteCtrlId_ = remoteCtrlId' <$> rc_, rcsClient, rcsWaitSession, ctrlAppInfo = ctrlInfo}
    _ -> Left $ ChatErrorRemoteCtrl RCEBadState
  atomically $ putTMVar cmdOk ()
  pure ((`remoteCtrlInfo` Just RCSConnecting) <$> rc_, ctrlInfo)
  where
    validateRemoteCtrl RCInvitation {idkey} RemoteCtrl {ctrlPairing = RCCtrlPairing {idPubKey}} =
      unless (idkey == idPubKey) $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError $ PRERemoteControl RCEIdentity
-    waitForCtrlSession :: Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS 'TClient, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> CM ()
-    waitForCtrlSession rc_ ctrlName rcsClient vars = do
+    waitForCtrlSession :: Maybe RemoteCtrl -> CtrlAppInfo -> RCCtrlClient -> RCStepTMVar (ByteString, TLS 'TClient, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> CM ()
+    waitForCtrlSession rc_ ctrlAppInfo@CtrlAppInfo {deviceName = ctrlName} rcsClient vars = do
      (uniq, tls, rcsWaitConfirmation) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
      let sessionCode = verificationCode uniq
      updateRemoteCtrlSession sseq $ \case
        RCSessionConnecting {rcsWaitSession} ->
          let remoteCtrlId_ = remoteCtrlId' <$> rc_
-           in Right RCSessionPendingConfirmation {remoteCtrlId_, ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation}
+           in Right RCSessionPendingConfirmation {remoteCtrlId_, ctrlDeviceName = ctrlName, rcsClient, tls, sessionCode, rcsWaitSession, rcsWaitConfirmation, ctrlAppInfo}
        _ -> Left $ ChatErrorRemoteCtrl RCEBadState
      toView CEvtRemoteCtrlSessionCode {remoteCtrl_ = (`remoteCtrlInfo` Just RCSPendingConfirmation {sessionCode}) <$> rc_, sessionCode}
    checkAppVersion CtrlAppInfo {appVersionRange} =
@@ -495,7 +498,8 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
    getHostAppInfo appVersion = do
      hostDeviceName <- chatReadVar localDeviceName
      encryptFiles <- chatReadVar encryptLocalFiles
-      pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles}
+      useCompression <- asks $ remoteCompression . config
+      pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles, compression = BoolDef useCompression}

 parseCtrlAppInfo :: JT.Value -> CM CtrlAppInfo
 parseCtrlAppInfo ctrlAppInfo = do
@@ -514,7 +518,7 @@ handleRemoteCommand execCC encryption remoteOutputQ HTTP2Request {request, reqBo
    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 . RRError
    processCommand :: User -> C.SbKeyNonce -> GetChunk -> RemoteCommand -> CM ()
    processCommand user rfKN getNext = \case
@@ -611,7 +615,7 @@ remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionState =
  RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionState}

 -- | Take a look at emoji of tlsunique, commit pairing, and start session server
-verifyRemoteCtrlSession :: (ByteString -> Int -> CM' (Either ChatError ChatResponse)) -> Text -> CM RemoteCtrlInfo
+verifyRemoteCtrlSession :: (ByteString -> Int -> CM' (Either ChatError ChatResponse)) -> Text -> CM ChatResponse
 verifyRemoteCtrlSession execCC sessCode' = do
  (sseq, client, ctrlName, sessionCode, vars) <-
    chatReadVar remoteCtrlSession >>= \case
@@ -625,14 +629,15 @@ verifyRemoteCtrlSession execCC sessCode' = do
    (rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
    rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
    remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
-    encryption <- mkCtrlRemoteCrypto sessionKeys $ tlsUniq tls
+    encryption@RemoteCrypto {compression} <- mkCtrlRemoteCrypto sessionKeys (tlsUniq tls) =<< getRemoteCtrlAppInfo sseq
    cc <- ask
    http2Server <- liftIO . async $ attachHTTP2Server tls $ \req -> handleRemoteCommand execCC encryption remoteOutputQ req `runReaderT` cc
    void . forkIO $ monitor sseq http2Server
    updateRemoteCtrlSession sseq $ \case
-      RCSessionPendingConfirmation {} -> Right RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ}
+      RCSessionPendingConfirmation {ctrlAppInfo} -> Right RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ, ctrlAppInfo}
      _ -> Left $ ChatErrorRemoteCtrl RCEBadState
-    pure $ remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
+    let remoteCtrl = remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
+    pure CRRemoteCtrlConnected {remoteCtrl, compression}
  where
    upsertRemoteCtrl :: Text -> RCCtrlPairing -> CM RemoteCtrl
    upsertRemoteCtrl ctrlName rcCtrlPairing = withStore $ \db -> do
@@ -717,6 +722,18 @@ updateRemoteCtrlSession sseq state = do
            Right st' -> Right () <$ writeTVar session (Just (sseq, st'))
  liftEither r

+getRemoteCtrlAppInfo :: SessionSeq -> CM (Maybe CtrlAppInfo)
+getRemoteCtrlAppInfo sseq = chatReadVar remoteCtrlSession $>>= pure . appInfo
+  where
+    appInfo (currSseq, sess)
+      | sseq == currSseq = case sess of
+          RCSessionStarting -> Nothing
+          RCSessionSearching {} -> Nothing
+          RCSessionConnecting {ctrlAppInfo} -> Just ctrlAppInfo
+          RCSessionPendingConfirmation {ctrlAppInfo} -> Just ctrlAppInfo
+          RCSessionConnected {ctrlAppInfo} -> Just ctrlAppInfo
+      | otherwise = Nothing
+
 utf8String :: [Char] -> ByteString
 utf8String = encodeUtf8 . T.pack
 {-# INLINE utf8String #-}
@@ -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)
@@ -37,6 +39,7 @@ import Network.Transport.Internal (decodeWord32, encodeWord32)
 import Simplex.Chat.Controller
 import Simplex.Chat.Remote.Transport
 import Simplex.Chat.Remote.Types
+import Simplex.Chat.Types (BoolDef (..))
 import Simplex.FileTransfer.Description (FileDigest (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
@@ -102,10 +105,10 @@ $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 -- * Client side / desktop

 mkRemoteHostClient :: HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> CM RemoteHostClient
-mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles} = do
+mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles, compression} = do
  let HostSessKeys {chainKeys, idPrivKey, sessPrivKey} = sessionKeys
      signatures = RSSign {idPrivKey, sessPrivKey}
-  encryption <- liftIO $ mkRemoteCrypto sessionCode chainKeys signatures
+  encryption <- mkRemoteCrypto sessionCode chainKeys signatures $ isTrue compression
  pure
    RemoteHostClient
      { hostEncoding = encoding,
@@ -116,17 +119,19 @@ mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {enc
        storePath
      }

-mkCtrlRemoteCrypto :: CtrlSessKeys -> SessionCode -> CM RemoteCrypto
-mkCtrlRemoteCrypto CtrlSessKeys {chainKeys, idPubKey, sessPubKey} sessionCode =
+mkCtrlRemoteCrypto :: CtrlSessKeys -> SessionCode -> Maybe CtrlAppInfo -> CM RemoteCrypto
+mkCtrlRemoteCrypto CtrlSessKeys {chainKeys, idPubKey, sessPubKey} sessionCode ctrlAppInfo_ = do
  let signatures = RSVerify {idPubKey, sessPubKey}
-   in liftIO $ mkRemoteCrypto sessionCode chainKeys signatures
+      peerCompression = maybe False (\CtrlAppInfo {compression} -> isTrue compression) ctrlAppInfo_
+  mkRemoteCrypto sessionCode chainKeys signatures peerCompression

-mkRemoteCrypto :: SessionCode -> TSbChainKeys -> RemoteSignatures -> IO RemoteCrypto
-mkRemoteCrypto sessionCode chainKeys signatures = do
+mkRemoteCrypto :: SessionCode -> TSbChainKeys -> RemoteSignatures -> Bool -> CM RemoteCrypto
+mkRemoteCrypto sessionCode chainKeys signatures peerCompression = do
  sndCounter <- newTVarIO 0
  rcvCounter <- newTVarIO 0
  skippedKeys <- liftIO TM.emptyIO
-  pure RemoteCrypto {sessionCode, sndCounter, rcvCounter, chainKeys, skippedKeys, signatures}
+  useCompression <- asks $ remoteCompression . config
+  pure RemoteCrypto {sessionCode, sndCounter, rcvCounter, chainKeys, skippedKeys, signatures, compression = peerCompression && useCompression}

 closeRemoteHostClient :: RemoteHostClient -> IO ()
 closeRemoteHostClient RemoteHostClient {httpClient} = closeHTTP2Client httpClient
@@ -176,7 +181,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
@@ -247,8 +252,11 @@ pattern OwsfTag = (SingleFieldJSONTag, J.Bool True)
 -- See https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2023-10-25-remote-control.md for encoding

 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
+encryptEncodeHTTP2Body corrId cmdKN RemoteCrypto {sessionCode, signatures, compression} s = do
+  let s'
+        | compression = LB.fromStrict $ Z1.compress 3 $ LB.toStrict s
+        | otherwise = 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
@@ -266,12 +274,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 rc@RemoteCrypto {sessionCode, signatures} hr HTTP2Body {bodyBuffer} = do
+parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, ByteString, Int -> IO ByteString)
+parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} 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)
@@ -320,3 +328,10 @@ 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
+      | compression = case Z1.decompress $ LB.toStrict s of
+          Z1.Error e -> throwError $ RPEInvalidBody e
+          Z1.Skip -> pure B.empty
+          Z1.Decompress s' -> pure s'
+      | otherwise = pure $ LB.toStrict s
@@ -21,7 +21,7 @@ import Data.Int (Int64)
 import Data.Text (Text)
 import Data.Word (Word16, Word32)
 import Simplex.Chat.Remote.AppVersion
-import Simplex.Chat.Types (verificationCode)
+import Simplex.Chat.Types (BoolDef, verificationCode)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
@@ -47,7 +47,8 @@ data RemoteCrypto = RemoteCrypto
    rcvCounter :: TVar Word32,
    chainKeys :: TSbChainKeys,
    skippedKeys :: TM.TMap Word32 (C.SbKeyNonce, C.SbKeyNonce),
-    signatures :: RemoteSignatures
+    signatures :: RemoteSignatures,
+    compression :: Bool
  }

 getRemoteSndKeys :: RemoteCrypto -> STM (Word32, C.SbKeyNonce, C.SbKeyNonce)
@@ -220,7 +221,8 @@ data RemoteFile = RemoteFile

 data CtrlAppInfo = CtrlAppInfo
  { appVersionRange :: AppVersionRange,
-    deviceName :: Text
+    deviceName :: Text,
+    compression :: BoolDef
  }
  deriving (Show)

@@ -228,7 +230,8 @@ data HostAppInfo = HostAppInfo
  { appVersion :: AppVersion,
    deviceName :: Text,
    encoding :: PlatformEncoding,
-    encryptFiles :: Bool -- if the host encrypts files in app storage
+    encryptFiles :: Bool, -- if the host encrypts files in app storage
+    compression :: BoolDef
  }

 $(J.deriveJSON defaultJSON ''RemoteFile)
@@ -273,8 +273,10 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
    [ (maybe "connecting new remote controller" (\RemoteCtrlInfo {remoteCtrlId} -> "connecting remote controller " <> sShow remoteCtrlId) remoteCtrl_ <> ": ")
        <> viewRemoteCtrl ctrlAppInfo appVersion True
    ]
-  CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} ->
-    ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName]
+  CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} compression ->
+    ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName <> " (" <> compressStr <> " compression)"]
+    where
+      compressStr = if compression then "with" else "no"
  CRSQLResult rows -> map plain rows
 #if !defined(dbPostgres)
  CRArchiveExported archiveErrs -> if null archiveErrs then ["ok"] else ["archive export errors: " <> plain (show archiveErrs)]
@@ -486,7 +488,9 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
      plain sessionCode
    ]
  CEvtNewRemoteHost RemoteHostInfo {remoteHostId = rhId, hostDeviceName} -> ["new remote host " <> sShow rhId <> " added: " <> plain hostDeviceName]
-  CEvtRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} -> ["remote host " <> sShow rhId <> " connected"]
+  CEvtRemoteHostConnected RemoteHostInfo {remoteHostId = rhId} compression -> ["remote host " <> sShow rhId <> " connected (" <> compressStr <> " compression)"]
+    where
+      compressStr = if compression then "with" else "no"
  CEvtRemoteHostStopped {remoteHostId_} ->
    [ maybe "new remote host" (mappend "remote host " . sShow) remoteHostId_ <> " stopped"
    ]
@@ -81,19 +81,19 @@ businessProfile = mkProfile "biz" "Biz Inc" Nothing
 mkProfile :: T.Text -> T.Text -> Maybe ImageData -> Profile
 mkProfile displayName descr image = Profile {displayName, fullName = "", shortDescr = Just descr, image, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs}

-it :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
+it :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
 it name test =
  Hspec.it name $ \tmp -> timeout t (test tmp) >>= maybe (error "test timed out") pure
  where
    t = 90 * 1000000

-xit' :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
+xit' :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
 xit' = if os == "linux" then xit else it

 xit'' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
 xit'' = ifCI xit Hspec.it

-xitMacCI :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
+xitMacCI :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
 xitMacCI = ifCI (if os == "darwin" then xit else it) it

 xdescribe'' :: HasCallStack => String -> SpecWith a -> SpecWith a
@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}

 module RemoteTests where

@@ -15,7 +16,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List (find, isPrefixOf)
 import qualified Data.Map.Strict as M
-import Simplex.Chat.Controller (versionNumber)
+import Simplex.Chat.Controller (ChatConfig (..), versionNumber)
 import qualified Simplex.Chat.Controller as Controller
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Remote (remoteFilesFolder)
@@ -31,6 +32,13 @@ import UnliftIO.Directory

 remoteTests :: SpecWith TestParams
 remoteTests = describe "Remote" $ do
+  xdescribe "No compression" $ aroundWith (. ((False, False),)) runRemoteTests
+  xdescribe "Mobile offers compression" $ aroundWith (. ((True, False),)) runRemoteTests
+  xdescribe "Desktop offers compression" $ aroundWith (. ((False, True),)) runRemoteTests
+  describe "With compression" $ aroundWith (. ((True, True),)) runRemoteTests
+
+runRemoteTests :: SpecWith ((Bool, Bool), TestParams)
+runRemoteTests = do
  describe "protocol handshake" $ do
    it "connects with new pairing (stops mobile)" $ remoteHandshakeTest False
    it "connects with new pairing (stops desktop)" $ remoteHandshakeTest True
@@ -48,14 +56,14 @@ remoteTests = describe "Remote" $ do

 -- * Chat commands

-remoteHandshakeTest :: HasCallStack => Bool -> TestParams -> IO ()
-remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
+remoteHandshakeTest :: HasCallStack => Bool -> ((Bool, Bool), TestParams) -> IO ()
+remoteHandshakeTest viaDesktop = testRemote $ \compress mobile desktop -> do
  desktop ##> "/list remote hosts"
  desktop <## "No remote hosts"
  mobile ##> "/list remote ctrls"
  mobile <## "No remote controllers"

-  startRemote mobile desktop
+  startRemote compress mobile desktop

  desktop ##> "/list remote hosts"
  desktop <## "Remote hosts:"
@@ -77,14 +85,14 @@ remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \m
  mobile ##> "/list remote ctrls"
  mobile <## "No remote controllers"

-remoteHandshakeStoredTest :: HasCallStack => TestParams -> IO ()
-remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
+remoteHandshakeStoredTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+remoteHandshakeStoredTest = testRemote $ \compress mobile desktop -> do
  logNote "Starting new session"
-  startRemote mobile desktop
+  startRemote compress mobile desktop
  stopMobile mobile desktop `catchAny` (logError . tshow)

  logNote "Starting stored session"
-  startRemoteStored mobile desktop
+  startRemoteStored compress mobile desktop
  stopDesktop mobile desktop `catchAny` (logError . tshow)

  desktop ##> "/list remote hosts"
@@ -95,23 +103,23 @@ remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile
  mobile <## "1. My desktop"

  logNote "Starting stored session again"
-  startRemoteStored mobile desktop
+  startRemoteStored compress mobile desktop
  stopMobile mobile desktop `catchAny` (logError . tshow)

-remoteHandshakeDiscoverTest :: HasCallStack => TestParams -> IO ()
-remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
+remoteHandshakeDiscoverTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+remoteHandshakeDiscoverTest = testRemote $ \compress mobile desktop -> do
  logNote "Preparing new session"
-  startRemote mobile desktop
+  startRemote compress mobile desktop
  stopMobile mobile desktop `catchAny` (logError . tshow)

  logNote "Starting stored session with multicast"
-  startRemoteDiscover mobile desktop
+  startRemoteDiscover compress mobile desktop
  stopMobile mobile desktop `catchAny` (logError . tshow)

-remoteHandshakeRejectTest :: HasCallStack => TestParams -> IO ()
-remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop mobileBob -> do
+remoteHandshakeRejectTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+remoteHandshakeRejectTest = testRemote3 $ \compress mobile desktop mobileBob -> do
  logNote "Starting new session"
-  startRemote mobile desktop
+  startRemote compress mobile desktop
  stopMobile mobile desktop

  mobileBob ##> "/set device name MobileBob"
@@ -135,12 +143,12 @@ remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfil
  mobile <## "Compare session code with controller and use:"
  mobile <## ("/verify remote ctrl " <> sessId)
  mobile ##> ("/verify remote ctrl " <> sessId)
-  mobile <## "remote controller 1 session started with My desktop"
-  desktop <## "remote host 1 connected"
+  mobile <## ("remote controller 1 session started with My desktop" <> compress)
+  desktop <## ("remote host 1 connected" <> compress)
  stopMobile mobile desktop

-storedBindingsTest :: HasCallStack => TestParams -> IO ()
-storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
+storedBindingsTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+storedBindingsTest = testRemote $ \compress mobile desktop -> do
  desktop ##> "/set device name My desktop"
  desktop <## "ok"
  mobile ##> "/set device name Mobile"
@@ -166,9 +174,9 @@ storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile deskto
  desktop <## "new remote host connecting"
  mobile <## "new remote controller connected"
  verifyRemoteCtrl mobile desktop
-  mobile <## "remote controller 1 session started with My desktop"
+  mobile <## ("remote controller 1 session started with My desktop" <> compress)
  desktop <## "new remote host 1 added: Mobile"
-  desktop <## "remote host 1 connected"
+  desktop <## ("remote host 1 connected" <> compress)

  desktop ##> "/list remote hosts"
  desktop <## "Remote hosts:"
@@ -180,9 +188,9 @@ storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile deskto

 -- TODO: more parser tests

-remoteMessageTest :: HasCallStack => TestParams -> IO ()
-remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
-  startRemote mobile desktop
+remoteMessageTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+remoteMessageTest = testRemote3 $ \compress mobile desktop bob -> do  
+  startRemote compress mobile desktop
  contactBob desktop bob

  logNote "sending messages"
@@ -206,9 +214,9 @@ remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
  threadDelay 1000000
  logNote "done"

-remoteStoreFileTest :: HasCallStack => TestParams -> IO ()
+remoteStoreFileTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
 remoteStoreFileTest =
-  testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob ->
+  testRemote3 $ \compress mobile desktop bob ->
    withXFTPServer $ do
      let mobileFiles = "./tests/tmp/mobile_files"
      mobile ##> ("/_files_folder " <> mobileFiles)
@@ -223,7 +231,7 @@ remoteStoreFileTest =
      bob ##> ("/_files_folder " <> bobFiles)
      bob <## "ok"

-      startRemote mobile desktop
+      startRemote compress mobile desktop
      contactBob desktop bob

      rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
@@ -336,8 +344,8 @@ remoteStoreFileTest =
      r `shouldStartWith` "remote host 1 error"
      r `shouldContain` err

-remoteCLIFileTest :: HasCallStack => TestParams -> IO ()
-remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
+remoteCLIFileTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+remoteCLIFileTest = testRemote3 $ \compress mobile desktop bob -> withXFTPServer $ do
  let mobileFiles = "./tests/tmp/mobile_files"
  mobile ##> ("/_files_folder " <> mobileFiles)
  mobile <## "ok"
@@ -347,7 +355,7 @@ remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
  desktop ##> ("/remote_hosts_folder " <> desktopHostFiles)
  desktop <## "ok"

-  startRemote mobile desktop
+  startRemote compress mobile desktop
  contactBob desktop bob

  rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop)
@@ -405,9 +413,9 @@ remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob

  stopMobile mobile desktop

-switchRemoteHostTest :: TestParams -> IO ()
-switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
-  startRemote mobile desktop
+switchRemoteHostTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+switchRemoteHostTest = testRemote3 $ \compress mobile desktop bob -> do
+  startRemote compress mobile desktop
  contactBob desktop bob

  desktop ##> "/contacts"
@@ -431,10 +439,10 @@ switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \
  desktop <## "remote host 1 error: RHEInactive"
  desktop ##> "/contacts"

-indicateRemoteHostTest :: TestParams -> IO ()
-indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
+indicateRemoteHostTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+indicateRemoteHostTest = testRemote4 $ \compress mobile desktop bob cath -> do
  connectUsers desktop cath
-  startRemote mobile desktop
+  startRemote compress mobile desktop
  contactBob desktop bob
  -- remote contact -> remote host
  bob #> "@alice hi"
@@ -455,8 +463,8 @@ indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile c
  desktop <##> cath
  cath <##> desktop

-multipleProfilesTest :: TestParams -> IO ()
-multipleProfilesTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
+multipleProfilesTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO ()
+multipleProfilesTest = testRemote4 $ \compress mobile desktop bob cath -> do
  connectUsers desktop cath

  desktop ##> "/create user desk_bottom"
@@ -466,7 +474,7 @@ multipleProfilesTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cat
  desktop <## "alice_desktop (Alice Desktop)"
  desktop <## "desk_bottom (active)"

-  startRemote mobile desktop
+  startRemote compress mobile desktop
  contactBob desktop bob
  desktop ##> "/users"
  desktop <## "alice (Alice) (active)"
@@ -502,8 +510,28 @@ multipleProfilesTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cat

 -- * Utils

-startRemote :: TestCC -> TestCC -> IO ()
-startRemote mobile desktop = do
+testRemote :: HasCallStack => (String -> TestCC -> TestCC -> IO()) -> ((Bool, Bool), TestParams) -> IO ()
+testRemote test ((mobileCompression, desktopCompression), ps) =
+  withNewTestChatCfg ps testCfg {remoteCompression = mobileCompression} "mobile" aliceProfile $ \mobile ->
+    withNewTestChatCfg ps testCfg {remoteCompression = desktopCompression} "desktop" aliceDesktopProfile $ \desktop ->
+      let compress = " (" <> (if mobileCompression && desktopCompression then "with" else "no") <> " compression)"
+       in test compress mobile desktop
+  
+
+testRemote3 :: HasCallStack => (String -> TestCC -> TestCC -> TestCC -> IO()) -> ((Bool, Bool), TestParams) -> IO ()
+testRemote3 test ps =
+  testRemote
+    (\compress mobile desktop -> withNewTestChat (snd ps) "bob" bobProfile $ test compress mobile desktop)
+    ps
+
+testRemote4 :: HasCallStack => (String -> TestCC -> TestCC -> TestCC -> TestCC -> IO()) -> ((Bool, Bool), TestParams) -> IO ()
+testRemote4 test ps =
+  testRemote3
+    (\compress mobile desktop bob -> withNewTestChat (snd ps) "cath" cathProfile $ test compress mobile desktop bob)
+    ps
+
+startRemote :: String -> TestCC -> TestCC -> IO ()
+startRemote compress mobile desktop = do
  desktop ##> "/set device name My desktop"
  desktop <## "ok"
  mobile ##> "/set device name Mobile"
@@ -518,12 +546,12 @@ startRemote mobile desktop = do
  desktop <## "new remote host connecting"
  mobile <## "new remote controller connected"
  verifyRemoteCtrl mobile desktop
-  mobile <## "remote controller 1 session started with My desktop"
+  mobile <## ("remote controller 1 session started with My desktop" <> compress)
  desktop <## "new remote host 1 added: Mobile"
-  desktop <## "remote host 1 connected"
+  desktop <## ("remote host 1 connected" <> compress)

-startRemoteStored :: TestCC -> TestCC -> IO ()
-startRemoteStored mobile desktop = do
+startRemoteStored :: String -> TestCC -> TestCC -> IO ()
+startRemoteStored compress mobile desktop = do
  desktop ##> "/start remote host 1"
  desktop <##. "remote host 1 started on "
  desktop <##. "other addresses: "
@@ -534,11 +562,11 @@ startRemoteStored mobile desktop = do
  desktop <## "remote host 1 connecting"
  mobile <## "remote controller 1 connected"
  verifyRemoteCtrl mobile desktop
-  mobile <## "remote controller 1 session started with My desktop"
-  desktop <## "remote host 1 connected"
+  mobile <## ("remote controller 1 session started with My desktop" <> compress)
+  desktop <## ("remote host 1 connected" <> compress)

-startRemoteDiscover :: TestCC -> TestCC -> IO ()
-startRemoteDiscover mobile desktop = do
+startRemoteDiscover :: String -> TestCC -> TestCC -> IO ()
+startRemoteDiscover compress mobile desktop = do
  desktop ##> "/start remote host 1 multicast=on"
  desktop <##. "remote host 1 started on "
  desktop <##. "other addresses: "
@@ -554,8 +582,8 @@ startRemoteDiscover mobile desktop = do
  desktop <## "remote host 1 connecting"
  mobile <## "remote controller 1 connected"
  verifyRemoteCtrl mobile desktop
-  mobile <## "remote controller 1 session started with My desktop"
-  desktop <## "remote host 1 connected"
+  mobile <## ("remote controller 1 session started with My desktop" <> compress)
+  desktop <## ("remote host 1 connected" <> compress)

 verifyRemoteCtrl :: TestCC -> TestCC -> IO ()
 verifyRemoteCtrl mobile desktop = do
@@ -55,7 +55,9 @@ main = do
            "src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql"
 #else
      describe "Schema dump" schemaDumpTest
+#if MIN_VERSION_base(4,18,0)
      describe "Bot API docs" apiDocsTest
+#endif
      around tmpBracket $ describe "WebRTC encryption" webRTCTests
 #endif
      describe "SimpleX chat markdown" markdownTests