From 8516b0dd5b8bdee600fdcfca43d6e15b97bbf1c0 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 11 May 2024 17:11:28 +0100 Subject: [PATCH] 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 --- src/Simplex/Messaging/Client.hs | 17 +++++----- src/Simplex/Messaging/Protocol.hs | 17 +++++----- src/Simplex/Messaging/Server.hs | 25 +++++++------- src/Simplex/Messaging/Server/Env/STM.hs | 6 ++-- src/Simplex/Messaging/Transport.hs | 44 ++++++++++++++++++------- 5 files changed, 65 insertions(+), 44 deletions(-) diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index c931aefc2..92dd4047b 100644 --- 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 diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 250c76fcf..1812dce37 100644 --- 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 diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 156f5da18..85a9073bc 100644 --- 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' diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 845d483b1..f23192aeb 100644 --- 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 diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index f12168840..561e9c4de 100644 --- 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