proxy: negotiate client-relay version, include it in PFWD commands and in encrypted forwarded transmissions (#1144)

* proxy: negotiate client-relay version, include it in PFWD commands and in encrypted forwarded transmissions * rename * inline * comment * use correct server version when encoding forwarded commands
2026-03-30 16:26:02 +00:00 · 2024-05-11 17:11:28 +01:00
parent 9f72b249b4
commit 8516b0dd5b
5 changed files with 65 additions and 44 deletions
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -819,11 +819,10 @@ proxySMPMessage ::
  MsgFlags ->
  MsgBody ->
  ExceptT SMPClientError IO (Either ProxyClientError ())
-- TODO use version
-proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g}} (ProxiedRelay sessionId _v serverKey) spKey sId flags msg = do
+proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {clientCorrId = g}} (ProxiedRelay sessionId v serverKey) spKey sId flags msg = do
  -- prepare params
  let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
-      serverThParams = proxyThParams {sessionId, thAuth = serverThAuth}
+      serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
  (cmdPubKey, cmdPrivKey) <- liftIO . atomically $ C.generateKeyPair @'C.X25519 g
  let cmdSecret = C.dh' serverKey cmdPrivKey
  nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
@@ -837,13 +836,13 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
    TBTransmissions s _ _ : _ -> pure s
  et <- liftEitherWith PCECryptoError $ EncTransmission <$> C.cbEncrypt cmdSecret nonce b paddedProxiedMsgLength
  -- proxy interaction errors are wrapped
-  tryE (sendProtocolCommand_ c (Just nonce) Nothing sessionId (Cmd SProxiedClient (PFWD cmdPubKey et))) >>= \case
+  tryE (sendProtocolCommand_ c (Just nonce) Nothing sessionId (Cmd SProxiedClient (PFWD v cmdPubKey et))) >>= \case
    Right r -> case r of
      PRES (EncResponse er) -> do
        -- server interaction errors are thrown directly
        t' <- liftEitherWith PCECryptoError $ C.cbDecrypt cmdSecret (C.reverseNonce nonce) er
-        case tParse proxyThParams t' of
-          t'' :| [] -> case tDecodeParseValidate proxyThParams t'' of
+        case tParse serverThParams t' of
+          t'' :| [] -> case tDecodeParseValidate serverThParams t'' of
            (_auth, _signed, (_c, _e, cmd)) -> case cmd of
              Right OK -> pure $ Right ()
              Right (ERR e) -> throwE $ PCEProtocolError e -- this is the error from the destination relay
@@ -862,15 +861,15 @@ proxySMPMessage c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
 -- sends RFWD :: EncFwdTransmission -> Command Sender
 -- receives RRES :: EncFwdResponse -> BrokerMsg
 -- proxy should send PRES to the client with EncResponse
-forwardSMPMessage :: SMPClient -> CorrId -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
-forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdKey fwdTransmission = do
+forwardSMPMessage :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO EncResponse
+forwardSMPMessage c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
  -- prepare params
  sessSecret <- case thAuth thParams of
    Nothing -> throwError $ PCETransportError TENoServerAuth
    Just THAuthClient {sessSecret} -> maybe (throwError $ PCETransportError TENoServerAuth) pure sessSecret
  nonce <- liftIO . atomically $ C.randomCbNonce g
  -- wrap
-  let fwdT = FwdTransmission {fwdCorrId, fwdKey, fwdTransmission}
+  let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
      eft = EncFwdTransmission $ C.cbEncryptNoPad sessSecret nonce (smpEncode fwdT)
  -- send
  sendProtocolCommand_ c (Just nonce) Nothing "" (Cmd SSender (RFWD eft)) >>= \case
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -251,7 +251,7 @@ maxMessageLength v
  | otherwise = 16088 -- 16064 - always use this size to determine allowed ranges

 paddedProxiedMsgLength :: Int
-paddedProxiedMsgLength = 16244 -- 16241 .. 16245
+paddedProxiedMsgLength = 16242 -- 16241 .. 16243

 -- TODO v6.0 change to 16064
 type MaxMessageLen = 16088
@@ -399,7 +399,7 @@ data Command (p :: Party) where
  -- - corrId: also used as a nonce to encrypt transmission to relay, corrId + 1 - from relay
  -- - key (1st param in the command) is used to agree DH secret for this particular transmission and its response
  -- Encrypted transmission should include session ID (tlsunique) from proxy-relay connection.
-  PFWD :: C.PublicKeyX25519 -> EncTransmission -> Command ProxiedClient -- use CorrId as CbNonce, client to proxy
+  PFWD :: VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> Command ProxiedClient -- use CorrId as CbNonce, client to proxy
  -- Transmission forwarded to relay:
  -- - entity ID: empty
  -- - corrId: unique correlation ID between proxy and relay, also used as a nonce to encrypt forwarded transmission
@@ -434,16 +434,17 @@ newtype EncTransmission = EncTransmission ByteString

 data FwdTransmission = FwdTransmission
  { fwdCorrId :: CorrId,
+    fwdVersion :: VersionSMP,
    fwdKey :: C.PublicKeyX25519,
    fwdTransmission :: EncTransmission
  }

 instance Encoding FwdTransmission where
-  smpEncode FwdTransmission {fwdCorrId = CorrId corrId, fwdKey, fwdTransmission = EncTransmission t} =
-    smpEncode (corrId, fwdKey, Tail t)
+  smpEncode FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t} =
+    smpEncode (corrId, fwdVersion, fwdKey, Tail t)
  smpP = do
-    (corrId, fwdKey, Tail t) <- smpP
-    pure FwdTransmission {fwdCorrId = CorrId corrId, fwdKey, fwdTransmission = EncTransmission t}
+    (corrId, fwdVersion, fwdKey, Tail t) <- smpP
+    pure FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t}

 newtype EncFwdTransmission = EncFwdTransmission ByteString
  deriving (Show)
@@ -1278,7 +1279,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
    PING -> e PING_
    NSUB -> e NSUB_
    PRXY host auth_ -> e (PRXY_, ' ', host, auth_)
-    PFWD pubKey (EncTransmission s) -> e (PFWD_, ' ', pubKey, Tail s)
+    PFWD fwdV pubKey (EncTransmission s) -> e (PFWD_, ' ', fwdV, pubKey, Tail s)
    RFWD (EncFwdTransmission s) -> e (RFWD_, ' ', Tail s)
    where
      e :: Encoding a => a -> ByteString
@@ -1346,7 +1347,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
        RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
    CT SProxiedClient tag ->
      Cmd SProxiedClient <$> case tag of
-        PFWD_ -> PFWD <$> _smpP <*> (EncTransmission . unTail <$> smpP)
+        PFWD_ -> PFWD <$> _smpP <*> smpP <*> (EncTransmission . unTail <$> smpP)
        PRXY_ -> PRXY <$> _smpP <*> smpP
    CT SNotifier NSUB_ -> pure $ Cmd SNotifier NSUB

--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -89,6 +89,7 @@ import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
+import Simplex.Messaging.Version
 import System.Exit (exitFailure)
 import System.IO (hPrint, hPutStrLn, hSetNewlineMode, universalNewlineMode)
 import System.Mem.Weak (deRefWeak)
@@ -650,20 +651,21 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
              proxyResp = \case
                Left err -> ERR $ smpProxyError err
                Right smp ->
-                  let THandleParams {sessionId = srvSessId, thVersion, thAuth} = thParams smp
-                      vr = supportedServerSMPRelayVRange -- TODO this should be destination relay version range
-                   in if thVersion >= sendingProxySMPVersion
-                        then case thAuth of
+                  let THandleParams {sessionId = srvSessId, thVersion, thServerVRange, thAuth} = thParams smp
+                   in case compatibleVRange thServerVRange proxiedSMPRelayVRange of
+                        -- Cap the destination relay version range to prevent client version fingerprinting.
+                        -- See comment for proxiedSMPRelayVersion.
+                        Just (Compatible vr) | thVersion >= sendingProxySMPVersion -> case thAuth of
                          Just THAuthClient {serverCertKey} -> PKEY srvSessId vr serverCertKey
                          Nothing -> ERR $ transportErr TENoServerAuth
-                        else ERR $ transportErr TEVersion
-      PFWD pubKey encBlock -> do
+                        _ -> ERR $ transportErr TEVersion                    
+      PFWD fwdV pubKey encBlock -> do
        ProxyAgent {smpAgent} <- asks proxyAgent
        atomically (lookupSMPServerClient smpAgent sessId) >>= \case
          Just smp
            | v >= sendingProxySMPVersion ->
                liftIO $ either (ERR . smpProxyError) PRES <$>
-                   runExceptT (forwardSMPMessage smp corrId pubKey encBlock) `catchError` (pure . Left . PCEIOError)
+                   runExceptT (forwardSMPMessage smp corrId fwdV pubKey encBlock) `catchError` (pure . Left . PCEIOError)
            | otherwise -> pure . ERR $ transportErr TEVersion
            where
              THandleParams {thVersion = v} = thParams smp
@@ -952,13 +954,14 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
          sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
          let proxyNonce = C.cbNonce $ bs corrId
          s' <- liftEitherWith (const CRYPTO) $ C.cbDecryptNoPad sessSecret proxyNonce s
-          FwdTransmission {fwdCorrId, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s'
+          FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s'
          let clientSecret = C.dh' fwdKey serverPrivKey
              clientNonce = C.cbNonce $ bs fwdCorrId
          b <- liftEitherWith (const CRYPTO) $ C.cbDecrypt clientSecret clientNonce et
+          let clntTHParams = smpTHParamsSetVersion fwdVersion thParams'
          -- only allowing single forwarded transactions
-          t' <- case tParse thParams' b of
-            t :| [] -> pure $ tDecodeParseValidate thParams' t
+          t' <- case tParse clntTHParams b of
+            t :| [] -> pure $ tDecodeParseValidate clntTHParams t
            _ -> throwE BLOCK
          let clntThAuth = Just $ THAuthServer {serverPrivKey, sessSecret' = Just clientSecret}
          -- process forwarded SEND
@@ -972,7 +975,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                _ ->
                  pure (corrId', entId', ERR $ CMD PROHIBITED)
          -- encode response
-          r' <- case batchTransmissions (batch thParams') (blockSize thParams') [Right (Nothing, encodeTransmission thParams' r)] of
+          r' <- case batchTransmissions (batch clntTHParams) (blockSize clntTHParams) [Right (Nothing, encodeTransmission clntTHParams r)] of
            [] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
            TBError _ _ : _ -> throwE BLOCK
            TBTransmission b' _ : _ -> pure b'
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -146,8 +146,7 @@ data Client = Client
    connected :: TVar Bool,
    createdAt :: SystemTime,
    rcvActiveAt :: TVar SystemTime,
-    sndActiveAt :: TVar SystemTime,
-    proxyClient_ :: TVar (Maybe C.DhSecretX25519) -- this client is actually an SMP proxy
+    sndActiveAt :: TVar SystemTime
  }

 data SubscriptionThread = NoSub | SubPending | SubThread (Weak ThreadId) | ProhibitSub
@@ -179,8 +178,7 @@ newClient nextClientId qSize thVersion sessionId createdAt = do
  connected <- newTVar True
  rcvActiveAt <- newTVar createdAt
  sndActiveAt <- newTVar createdAt
-  proxyClient_ <- newTVar Nothing
-  return Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, msgQ, endThreads, endThreadSeq, thVersion, sessionId, connected, createdAt, rcvActiveAt, sndActiveAt, proxyClient_}
+  return Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, msgQ, endThreads, endThreadSeq, thVersion, sessionId, connected, createdAt, rcvActiveAt, sndActiveAt}

 newSubscription :: SubscriptionThread -> STM Sub
 newSubscription subThread = do
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -36,6 +36,7 @@ module Simplex.Messaging.Transport
    supportedSMPHandshakes,
    supportedClientSMPRelayVRange,
    supportedServerSMPRelayVRange,
+    proxiedSMPRelayVRange,
    legacyServerSMPRelayVRange,
    currentClientSMPRelayVersion,
    legacyServerSMPRelayVersion,
@@ -77,6 +78,7 @@ module Simplex.Messaging.Transport
    tGetBlock,
    sendHandshake,
    getHandshake,
+    smpTHParamsSetVersion,
  )
 where

@@ -155,13 +157,21 @@ sendingProxySMPVersion :: VersionSMP
 sendingProxySMPVersion = VersionSMP 8

 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 7
+currentClientSMPRelayVersion = VersionSMP 8

 legacyServerSMPRelayVersion :: VersionSMP
 legacyServerSMPRelayVersion = VersionSMP 6

 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 7
+currentServerSMPRelayVersion = VersionSMP 8
+
+-- Max SMP protocol version to be used in e2e encrypted
+-- connection between client and server, as defined by SMP proxy.
+-- SMP proxy sets it to lower than its current version
+-- to prevent client version fingerprinting by the
+-- destination relays when clients upgrade at different times.
+proxiedSMPRelayVersion :: VersionSMP
+proxiedSMPRelayVersion = VersionSMP 8

 -- minimal supported protocol version is 4
 -- TODO remove code that supports sending commands without batching
@@ -174,6 +184,10 @@ legacyServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion legacyServerSMPR
 supportedServerSMPRelayVRange :: VersionRangeSMP
 supportedServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion currentServerSMPRelayVersion

+-- This range initially allows only version 8 - see the comment above.
+proxiedSMPRelayVRange :: VersionRangeSMP
+proxiedSMPRelayVRange = mkVersionRange sendingProxySMPVersion proxiedSMPRelayVersion
+
 supportedSMPHandshakes :: [ALPN]
 supportedSMPHandshakes = ["smp/1"]

@@ -497,7 +511,7 @@ smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do
          throwE $ TEHandshake IDENTITY
      | otherwise ->
          case compatibleVRange' smpVersionRange v of
-            Just (Compatible vr) -> pure $ smpThHandleServer th v vr pk k'
+            Just (Compatible vr) -> pure $ smpTHandleServer th v vr pk k'
            Nothing -> throwE TEVersion

 -- | Client SMP transport handshake.
@@ -521,25 +535,31 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do
            (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey)
        let v = maxVersion vr
        sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_}
-        pure $ smpThHandleClient th v vr (snd <$> ks_) ck_
+        pure $ smpTHandleClient th v vr (snd <$> ks_) ck_
      Nothing -> throwE TEVersion

-smpThHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer
-smpThHandleServer th v vr pk k_ =
+smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer
+smpTHandleServer th v vr pk k_ =
  let thAuth = THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$> k_}
-   in smpThHandle_ th v vr (Just thAuth)
+   in smpTHandle_ th v vr (Just thAuth)

-smpThHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleSMP c 'TClient
-smpThHandleClient th v vr pk_ ck_ =
+smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> THandleSMP c 'TClient
+smpTHandleClient th v vr pk_ ck_ =
  let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = ck, sessSecret = C.dh' k <$> pk_}) <$> ck_
-   in smpThHandle_ th v vr thAuth
+   in smpTHandle_ th v vr thAuth

-smpThHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> THandleSMP c p
-smpThHandle_ th@THandle {params} v vr thAuth =
+smpTHandle_ :: forall c p. THandleSMP c p -> VersionSMP -> VersionRangeSMP -> Maybe (THandleAuth p) -> THandleSMP c p
+smpTHandle_ th@THandle {params} v vr thAuth =
  -- TODO drop SMP v6: make thAuth non-optional
  let params' = params {thVersion = v, thServerVRange = vr, thAuth, implySessId = v >= authCmdsSMPVersion}
   in (th :: THandleSMP c p) {params = params'}

+-- This function is only used with v >= 8, so currently it's a simple record update.
+-- It may require some parameters update in the future, to be consistent with smpTHandle_.
+smpTHParamsSetVersion :: VersionSMP -> THandleParams SMPVersion p -> THandleParams SMPVersion p
+smpTHParamsSetVersion v params = params {thVersion = v}
+{-# INLINE smpTHParamsSetVersion #-}
+
 sendHandshake :: (Transport c, Encoding smp) => THandle v c p -> smp -> ExceptT TransportError IO ()
 sendHandshake th = ExceptT . tPutBlock th . smpEncode