From b8830242e570e6b6600fe4c874789994891354a5 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sat, 18 Jan 2025 21:42:04 +0000 Subject: [PATCH] cap proxy version for previous destination server --- src/Simplex/FileTransfer/Transport.hs | 4 +- src/Simplex/Messaging/Client.hs | 7 +- .../Messaging/Notifications/Transport.hs | 4 +- src/Simplex/Messaging/Protocol.hs | 4 +- src/Simplex/Messaging/Server/Main.hs | 1 + src/Simplex/Messaging/Transport.hs | 111 ++++++++++-------- tests/CLITests.hs | 2 +- tests/NtfClient.hs | 2 +- tests/SMPClient.hs | 4 +- tests/SMPProxyTests.hs | 65 +++++----- 10 files changed, 114 insertions(+), 90 deletions(-) diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs index 7f90b2879..3d80949d0 100644 --- a/src/Simplex/FileTransfer/Transport.hs +++ b/src/Simplex/FileTransfer/Transport.hs @@ -102,8 +102,8 @@ supportedFileServerVRange :: VersionRangeXFTP supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion -- XFTP protocol does not use this handshake method -xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient) -xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion +xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> Bool -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient) +xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer = throwE TEVersion supportedXFTPhandshakes :: [ALPN] supportedXFTPhandshakes = ["xftp/1"] diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index be359b71b..386e22c23 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -406,6 +406,8 @@ data ProtocolClientConfig v = ProtocolClientConfig serverVRange :: VersionRange v, -- | agree shared session secret (used in SMP proxy for additional encryption layer) agreeSecret :: Bool, + -- | Whether connecting client is a proxy server. See comment in ClientHandshake + proxyServer :: Bool, -- | send SNI to server, False for SMP useSNI :: Bool } @@ -420,6 +422,7 @@ defaultClientConfig clientALPN useSNI serverVRange = clientALPN, serverVRange, agreeSecret = False, + proxyServer = False, useSNI } {-# INLINE defaultClientConfig #-} @@ -489,7 +492,7 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe ByteString) -- A single queue can be used for multiple 'SMPClient' instances, -- as 'SMPServerTransmission' includes server information. getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg)) -getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret, useSNI} msgQ proxySessTs disconnected = do +getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret, proxyServer, useSNI} msgQ proxySessTs disconnected = do case chooseTransportHost networkConfig (host srv) of Right useHost -> (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost) @@ -548,7 +551,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize client :: forall c. Transport c => TProxy c -> PClient v err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient v err msg)) -> c -> IO () client _ c cVar h = do ks <- if agreeSecret then Just <$> atomically (C.generateKeyPair g) else pure Nothing - runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange) >>= \case + runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer) >>= \case Left e -> atomically . putTMVar cVar . Left $ PCETransportError e Right th@THandle {params} -> do sessionTs <- getCurrentTime diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs index 836b6b1e7..fc928535d 100644 --- a/src/Simplex/Messaging/Notifications/Transport.hs +++ b/src/Simplex/Messaging/Notifications/Transport.hs @@ -123,8 +123,8 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do Nothing -> throwE TEVersion -- | Notifcations server client transport handshake. -ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TClient) -ntfClientHandshake c keyHash ntfVRange = do +ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> Bool -> ExceptT TransportError IO (THandleNTF c 'TClient) +ntfClientHandshake c keyHash ntfVRange _proxyServer = do let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey = sk'} <- getHandshake th if sessionId /= sessId diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 5741cbb66..2d54629b4 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -1344,7 +1344,7 @@ transmissionP THandleParams {sessionId, implySessId} = do class (ProtocolTypeI (ProtoType msg), ProtocolEncoding v err msg, ProtocolEncoding v err (ProtoCommand msg), Show err, Show msg) => Protocol v err msg | msg -> v, msg -> err where type ProtoCommand msg = cmd | cmd -> msg type ProtoType msg = (sch :: ProtocolType) | sch -> msg - protocolClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> ExceptT TransportError IO (THandle v c 'TClient) + protocolClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> Bool -> ExceptT TransportError IO (THandle v c 'TClient) protocolPing :: ProtoCommand msg protocolError :: msg -> Maybe err @@ -1492,7 +1492,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where INFO info -> e (INFO_, ' ', info) OK -> e OK_ ERR err -> case err of - BLOCKED _ | v < blockedEntityErrorSMPVersion -> e (ERR_, ' ', AUTH) + BLOCKED _ | v < blockedEntitySMPVersion -> e (ERR_, ' ', AUTH) _ -> e (ERR_, ' ', err) PONG -> e PONG_ where diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 1ceb64d6e..1d21ffa6a 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -448,6 +448,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath = (smpCfg defaultSMPClientAgentConfig) { serverVRange = supportedProxyClientSMPRelayVRange, agreeSecret = True, + proxyServer = True, networkConfig = defaultNetworkConfig { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini, diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 62f42a17d..d537b45c2 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} @@ -14,6 +15,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} -- | -- Module : Simplex.Messaging.Transport @@ -49,7 +51,7 @@ module Simplex.Messaging.Transport sndAuthKeySMPVersion, deletedEventSMPVersion, encryptedBlockSMPVersion, - blockedEntityErrorSMPVersion, + blockedEntitySMPVersion, simplexMQVersion, smpBlockSize, TransportConfig (..), @@ -90,7 +92,7 @@ where import Control.Applicative (optional) import Control.Concurrent.STM -import Control.Monad (forM, (<$!>)) +import Control.Monad (forM, when, (<$!>)) import Control.Monad.Except import Control.Monad.IO.Class import Control.Monad.Trans.Except (throwE) @@ -139,11 +141,11 @@ smpBlockSize = 16384 -- 5 - basic auth for SMP servers (11/12/2022) -- 6 - allow creating queues without subscribing (9/10/2023) -- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024) --- 8 - SMP proxy for sender commands --- 9 - faster handshake: SKEY command for sender to secure queue --- 10 - DELD event to subscriber when queue is deleted via another connnection --- 11 - additional encryption of transport blocks with forward secrecy (9/14/2024) --- 12 - BLOCKED error for blocked queues (1/11/2025) +-- 8 - SMP proxy for sender commands (6/03/2024) +-- 9 - faster handshake: SKEY command for sender to secure queue (6/30/2024) +-- 10 - DELD event to subscriber when queue is deleted via another connnection (9/11/2024) +-- 11 - additional encryption of transport blocks with forward secrecy (10/06/2024) +-- 12 - BLOCKED error for blocked queues, handshake property to disable transport encryption between server and proxy (1/11/2025) data SMPVersion @@ -174,8 +176,8 @@ deletedEventSMPVersion = VersionSMP 10 encryptedBlockSMPVersion :: VersionSMP encryptedBlockSMPVersion = VersionSMP 11 -blockedEntityErrorSMPVersion :: VersionSMP -blockedEntityErrorSMPVersion = VersionSMP 12 +blockedEntitySMPVersion :: VersionSMP +blockedEntitySMPVersion = VersionSMP 12 minClientSMPRelayVersion :: VersionSMP minClientSMPRelayVersion = VersionSMP 6 @@ -200,7 +202,7 @@ currentServerSMPRelayVersion = VersionSMP 12 proxiedSMPRelayVersion :: VersionSMP proxiedSMPRelayVersion = VersionSMP 12 --- minimal supported protocol version is 4 +-- minimal supported protocol version is 6 -- TODO remove code that supports sending commands without batching supportedClientSMPRelayVRange :: VersionRangeSMP supportedClientSMPRelayVRange = mkVersionRange minClientSMPRelayVersion currentClientSMPRelayVersion @@ -416,7 +418,7 @@ data THandleParams v p = THandleParams -- | do NOT send session ID in transmission, but include it into signed message -- based on protocol version implySessId :: Bool, - -- -- | additional block encryption + -- | keys for additional transport encryption encryptBlock :: Maybe TSbChainKeys, -- | send multiple transmissions in a single block -- based on protocol version @@ -457,18 +459,28 @@ data ClientHandshake = ClientHandshake smpVersion :: VersionSMP, -- | server identity - CA certificate fingerprint keyHash :: C.KeyHash, - -- pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys. - authPubKey :: Maybe C.PublicKeyX25519 + -- | pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys. + authPubKey :: Maybe C.PublicKeyX25519, + -- | Whether connecting client is a proxy server (send from SMP v12). + -- This property, if True, disables additional transport encrytion inside TLS. + -- (Proxy server connection already has additional encryption, so this layer is not needed there). + proxyServer :: Bool } instance Encoding ClientHandshake where - smpEncode ClientHandshake {smpVersion, keyHash, authPubKey} = - smpEncode (smpVersion, keyHash) <> encodeAuthEncryptCmds smpVersion authPubKey + smpEncode ClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer} = + smpEncode (v, keyHash) + <> encodeAuthEncryptCmds v authPubKey + <> ifHasProxy v (smpEncode proxyServer) "" smpP = do - (smpVersion, keyHash) <- smpP + (v, keyHash) <- smpP -- TODO drop SMP v6: remove special parser and make key non-optional - authPubKey <- authEncryptCmdsP smpVersion smpP - pure ClientHandshake {smpVersion, keyHash, authPubKey} + authPubKey <- authEncryptCmdsP v smpP + proxyServer <- ifHasProxy v smpP (pure False) + pure ClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer} + +ifHasProxy :: VersionSMP -> a -> a -> a +ifHasProxy v a b = if v >= blockedEntitySMPVersion then a else b instance Encoding ServerHandshake where smpEncode ServerHandshake {smpVersionRange, sessionId, authPubKey} = @@ -576,54 +588,57 @@ smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do smpVersionRange = maybe legacyServerSMPRelayVRange (const smpVRange) $ getSessionALPN c sendHandshake th $ ServerHandshake {sessionId, smpVersionRange, authPubKey = Just (certChain, sk)} getHandshake th >>= \case - ClientHandshake {smpVersion = v, keyHash, authPubKey = k'} + ClientHandshake {smpVersion = v, keyHash, authPubKey = k', proxyServer} | keyHash /= kh -> throwE $ TEHandshake IDENTITY | otherwise -> case compatibleVRange' smpVersionRange v of - Just (Compatible vr) -> liftIO $ smpTHandleServer th v vr pk k' + Just (Compatible vr) -> liftIO $ smpTHandleServer th v vr pk k' proxyServer Nothing -> throwE TEVersion -- | Client SMP transport handshake. -- -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a -smpClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> ExceptT TransportError IO (THandleSMP c 'TClient) -smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do +smpClientHandshake :: forall c. Transport c => c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> ExceptT TransportError IO (THandleSMP c 'TClient) +smpClientHandshake c ks_ keyHash@(C.KeyHash kh) vRange proxyServer = do let th@THandle {params = THandleParams {sessionId}} = smpTHandle c ServerHandshake {sessionId = sessId, smpVersionRange, authPubKey} <- getHandshake th - if sessionId /= sessId - then throwE TEBadSession - else case smpVersionRange `compatibleVRange` smpVRange of - Just (Compatible vr) -> do - ck_ <- forM authPubKey $ \certKey@(X.CertificateChain cert, exact) -> - liftEitherWith (const $ TEHandshake BAD_AUTH) $ do - case cert of - [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure () - _ -> throwError "bad certificate" - serverKey <- getServerVerifyKey c - pubKey <- C.verifyX509 serverKey exact - (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey) - let v = maxVersion vr - sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_} - liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ - Nothing -> throwE TEVersion - -smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> IO (THandleSMP c 'TServer) -smpTHandleServer th v vr pk k_ = do + when (sessionId /= sessId) $ throwE TEBadSession + let smpVRange = + if proxyServer && maxVersion smpVersionRange < blockedEntitySMPVersion + then vRange {maxVersion = max (minVersion vRange) deletedEventSMPVersion} + else vRange + case smpVersionRange `compatibleVRange` smpVRange of + Just (Compatible vr) -> do + ck_ <- forM authPubKey $ \certKey@(X.CertificateChain cert, exact) -> + liftEitherWith (const $ TEHandshake BAD_AUTH) $ do + case cert of + [_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure () + _ -> throwError "bad certificate" + serverKey <- getServerVerifyKey c + pubKey <- C.verifyX509 serverKey exact + (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey) + let v = maxVersion vr + sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer} + liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck_ proxyServer + Nothing -> throwE TEVersion + +smpTHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> VersionRangeSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> Bool -> IO (THandleSMP c 'TServer) +smpTHandleServer th v vr pk k_ proxyServer = do let thAuth = Just THAuthServer {serverPrivKey = pk, sessSecret' = (`C.dh'` pk) <$!> k_} - be <- blockEncryption th v thAuth + be <- blockEncryption th v proxyServer thAuth pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys <$> be -smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> IO (THandleSMP c 'TClient) -smpTHandleClient th v vr pk_ ck_ = do +smpTHandleClient :: forall c. THandleSMP c 'TClient -> VersionSMP -> VersionRangeSMP -> Maybe C.PrivateKeyX25519 -> Maybe (C.PublicKeyX25519, (X.CertificateChain, X.SignedExact X.PubKey)) -> Bool -> IO (THandleSMP c 'TClient) +smpTHandleClient th v vr pk_ ck_ proxyServer = do let thAuth = (\(k, ck) -> THAuthClient {serverPeerPubKey = k, serverCertKey = forceCertChain ck, sessSecret = C.dh' k <$!> pk_}) <$!> ck_ - be <- blockEncryption th v thAuth + be <- blockEncryption th v proxyServer thAuth -- swap is needed to use client's sndKey as server's rcvKey and vice versa pure $ smpTHandle_ th v vr thAuth $ uncurry TSbChainKeys . swap <$> be -blockEncryption :: THandleSMP c p -> VersionSMP -> Maybe (THandleAuth p) -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey)) -blockEncryption THandle {params = THandleParams {sessionId}} v = \case - Just thAuth | v >= encryptedBlockSMPVersion -> case thAuth of +blockEncryption :: THandleSMP c p -> VersionSMP -> Bool -> Maybe (THandleAuth p) -> IO (Maybe (TVar C.SbChainKey, TVar C.SbChainKey)) +blockEncryption THandle {params = THandleParams {sessionId}} v proxyServer = \case + Just thAuth | not proxyServer && v >= encryptedBlockSMPVersion -> case thAuth of THAuthClient {sessSecret} -> be sessSecret THAuthServer {sessSecret'} -> be sessSecret' _ -> pure Nothing diff --git a/tests/CLITests.hs b/tests/CLITests.hs index 01b68653d..10ec33f4c 100644 --- a/tests/CLITests.hs +++ b/tests/CLITests.hs @@ -174,7 +174,7 @@ smpServerTestStatic = do X.Certificate {X.certPubKey = X.PubKeyEd25519 _k} : _ca -> print _ca -- pure () leaf : _ -> error $ "Unexpected leaf cert: " <> show leaf [] -> error "Empty chain" - runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange + runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange False logDebug "Combined SMP works" where getCerts :: TLS -> [X.Certificate] diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index e8c263e89..190815832 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -82,7 +82,7 @@ testNtfClient :: Transport c => (THandleNTF c 'TClient -> IO a) -> IO a testNtfClient client = do Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost runTransportClient defaultTransportClientConfig Nothing host ntfTestPort (Just testKeyHash) $ \h -> - runExceptT (ntfClientHandshake h testKeyHash supportedClientNTFVRange) >>= \case + runExceptT (ntfClientHandshake h testKeyHash supportedClientNTFVRange False) >>= \case Right th -> client th Left e -> error $ show e diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index a92b9e132..53d7a2fdc 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -105,7 +105,7 @@ testSMPClient_ :: Transport c => TransportHost -> ServiceName -> VersionRangeSMP testSMPClient_ host port vr client = do let tcConfig = defaultTransportClientConfig {Client.alpn = clientALPN} runTransportClient tcConfig Nothing host port (Just testKeyHash) $ \h -> - runExceptT (smpClientHandshake h Nothing testKeyHash vr) >>= \case + runExceptT (smpClientHandshake h Nothing testKeyHash vr False) >>= \case Right th -> client th Left e -> error $ show e where @@ -185,7 +185,7 @@ proxyCfg :: ServerConfig proxyCfg = cfg { allowSMPProxy = True, - smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True, serverVRange = supportedProxyClientSMPRelayVRange}} + smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True, proxyServer = True, serverVRange = supportedProxyClientSMPRelayVRange}} } where smpAgentCfg' = smpAgentCfg cfg diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 929ab9e42..bc5091119 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -86,34 +86,36 @@ smpProxyTests = do deliverMessageViaProxy proxyServ relayServ C.SEd25519 msg1 msg2 it "max message size, X25519 keys" . twoServersFirstProxy $ deliverMessageViaProxy proxyServ relayServ C.SX25519 msg1 msg2 - -- describe "new server and old proxy" $ do - -- let proxyServ = srv1 - -- relayServ = srv2 - -- (msg1, msg2) <- runIO $ do - -- g <- C.newRandom - -- atomically $ (,) <$> C.randomBytes maxLen g <*> C.randomBytes maxLen g - -- it "deliver via proxy" . twoServers_ proxyCfgV62 proxyCfg $ - -- deliverMessageViaProxy proxyServ relayServ C.SEd448 "hello 1" "hello 2" - -- it "max message size, Ed448 keys" . twoServers_ proxyCfgV62 proxyCfg $ - -- deliverMessageViaProxy proxyServ relayServ C.SEd448 msg1 msg2 - -- it "max message size, Ed25519 keys" . twoServers_ proxyCfgV62 proxyCfg $ - -- deliverMessageViaProxy proxyServ relayServ C.SEd25519 msg1 msg2 - -- it "max message size, X25519 keys" . twoServers_ proxyCfgV62 proxyCfg $ - -- deliverMessageViaProxy proxyServ relayServ C.SX25519 msg1 msg2 - -- describe "old server and new proxy" $ do - -- let proxyServ = srv1 - -- relayServ = srv2 - -- (msg1, msg2) <- runIO $ do - -- g <- C.newRandom - -- atomically $ (,) <$> C.randomBytes maxLen g <*> C.randomBytes maxLen g - -- it "deliver via proxy" . twoServers_ proxyCfg proxyCfgV62 $ - -- deliverMessageViaProxy proxyServ relayServ C.SEd448 "hello 1" "hello 2" - -- it "max message size, Ed448 keys" . twoServers_ proxyCfg proxyCfgV62 $ - -- deliverMessageViaProxy proxyServ relayServ C.SEd448 msg1 msg2 - -- it "max message size, Ed25519 keys" . twoServers_ proxyCfg proxyCfgV62 $ - -- deliverMessageViaProxy proxyServ relayServ C.SEd25519 msg1 msg2 - -- it "max message size, X25519 keys" . twoServers_ proxyCfg proxyCfgV62 $ - -- deliverMessageViaProxy proxyServ relayServ C.SX25519 msg1 msg2 + xdescribe "client without block encryption, server v6.2 and proxy v6.3 (fails)" $ do + let proxyServ = srv1 + relayServ = srv2 + maxLen' = maxMessageLength deletedEventSMPVersion + (msg1, msg2) <- runIO $ do + g <- C.newRandom + atomically $ (,) <$> C.randomBytes maxLen' g <*> C.randomBytes maxLen' g + it "deliver via proxy" . twoServers_ proxyCfg proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SEd448 ["hello 1"] ["hello 2"] + it "max message size, Ed448 keys" . twoServers_ proxyCfg proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SEd448 [msg1] [msg2] + it "max message size, Ed25519 keys" . twoServers_ proxyCfg proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SEd25519 [msg1] [msg2] + it "max message size, X25519 keys" . twoServers_ proxyCfg proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SX25519 [msg1] [msg2] + xdescribe "client without block encryption, server v6.2 and proxy v6.2 (works)" $ do + let proxyServ = srv1 + relayServ = srv2 + maxLen' = maxMessageLength deletedEventSMPVersion + (msg1, msg2) <- runIO $ do + g <- C.newRandom + atomically $ (,) <$> C.randomBytes maxLen' g <*> C.randomBytes maxLen' g + it "deliver via proxy" . twoServers_ proxyCfgV62 proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SEd448 ["hello 1"] ["hello 2"] + it "max message size, Ed448 keys" . twoServers_ proxyCfgV62 proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SEd448 [msg1] [msg2] + it "max message size, Ed25519 keys" . twoServers_ proxyCfgV62 proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SEd25519 [msg1] [msg2] + it "max message size, X25519 keys" . twoServers_ proxyCfgV62 proxyCfgV62 $ + deliverMessagesViaProxyVersion deletedEventSMPVersion proxyServ relayServ C.SX25519 [msg1] [msg2] describe "stress test 1k" $ do let deliver n = deliverMessagesViaProxy srv1 srv2 C.SEd448 [] (map bshow [1 :: Int .. n]) it "1x1000" . twoServersFirstProxy $ deliver 1000 @@ -186,11 +188,14 @@ deliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SM deliverMessageViaProxy proxyServ relayServ alg msg msg' = deliverMessagesViaProxy proxyServ relayServ alg [msg] [msg'] deliverMessagesViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => SMPServer -> SMPServer -> C.SAlgorithm a -> [ByteString] -> [ByteString] -> IO () -deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do +deliverMessagesViaProxy = deliverMessagesViaProxyVersion currentClientSMPRelayVersion + +deliverMessagesViaProxyVersion :: (C.AlgorithmI a, C.AuthAlgorithm a) => VersionSMP -> SMPServer -> SMPServer -> C.SAlgorithm a -> [ByteString] -> [ByteString] -> IO () +deliverMessagesViaProxyVersion maxProxyClientVersion proxyServ relayServ alg unsecuredMsgs securedMsgs = do g <- C.newRandom -- set up proxy ts <- getCurrentTime - pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion sendingProxySMPVersion} Nothing ts (\_ -> pure ()) + pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion maxProxyClientVersion} Nothing ts (\_ -> pure ()) pc <- either (fail . show) pure pc' THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc -- set up relay