From a70f492f4dbb9ec997b39ab3ea89c2858b5dde73 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Tue, 7 May 2024 13:37:40 +0100 Subject: [PATCH] proxy: fallback to direct connection if destination relay does not support proxy protocol (#1132) * proxy: fallback to direct connection if destination relay does not support proxy protocol * move version to TransportError, refactor --- src/Simplex/FileTransfer/Client.hs | 4 +- src/Simplex/FileTransfer/Transport.hs | 5 +- src/Simplex/Messaging/Agent/Client.hs | 61 +++++++++----- src/Simplex/Messaging/Agent/Protocol.hs | 83 +++++++++++-------- src/Simplex/Messaging/Client.hs | 30 +++++-- .../Messaging/Notifications/Transport.hs | 5 +- src/Simplex/Messaging/Protocol.hs | 22 +++-- src/Simplex/Messaging/Server.hs | 27 ++++-- src/Simplex/Messaging/Transport.hs | 46 +++++----- tests/AgentTests/FunctionalAPITests.hs | 6 +- tests/CoreTests/ProtocolErrorTests.hs | 17 ++-- tests/SMPAgentClient.hs | 7 +- tests/SMPClient.hs | 5 +- tests/SMPProxyTests.hs | 20 ++++- tests/Test.hs | 2 +- 15 files changed, 212 insertions(+), 128 deletions(-) diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs index a788e39c2..4efff9388 100644 --- a/src/Simplex/FileTransfer/Client.hs +++ b/src/Simplex/FileTransfer/Client.hs @@ -51,7 +51,7 @@ import Simplex.Messaging.Protocol RecipientId, SenderId, ) -import Simplex.Messaging.Transport (ALPN, HandshakeError (VERSION), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters) +import Simplex.Messaging.Transport (ALPN, THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), supportedParameters) import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn) import Simplex.Messaging.Transport.HTTP2 import Simplex.Messaging.Transport.HTTP2.Client @@ -114,7 +114,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, thParams@THandleParams {thVersion} <- case sessionALPN of Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0 Nothing -> pure thParams0 - _ -> throwError $ PCETransportError (TEHandshake VERSION) + _ -> throwError $ PCETransportError TEVersion logDebug $ "Client negotiated protocol: " <> tshow thVersion let c = XFTPClient {http2Client, thParams, transportSession, config} atomically $ writeTVar clientVar $ Just c diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs index 27f1b8b95..244e00972 100644 --- a/src/Simplex/FileTransfer/Transport.hs +++ b/src/Simplex/FileTransfer/Transport.hs @@ -37,6 +37,7 @@ import qualified Control.Exception as E import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class +import Control.Monad.Trans.Except import qualified Data.Aeson.TH as J import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Bifunctor (bimap, first) @@ -53,7 +54,7 @@ import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers import Simplex.Messaging.Protocol (CommandError) -import Simplex.Messaging.Transport (HandshakeError (..), SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..)) +import Simplex.Messaging.Transport (SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..)) import Simplex.Messaging.Transport.HTTP2.File import Simplex.Messaging.Util (bshow) import Simplex.Messaging.Version @@ -95,7 +96,7 @@ 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 = throwError $ TEHandshake VERSION +xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion data XFTPServerHandshake = XFTPServerHandshake { xftpVersionRange :: VersionRangeXFTP, diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 35015af5a..ab9f3eb5f 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -147,6 +147,7 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift import Control.Monad.Reader +import Control.Monad.Trans.Except import Crypto.Random (ChaChaDRG) import qualified Data.Aeson as J import qualified Data.Aeson.TH as J @@ -231,7 +232,7 @@ import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Session import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM -import Simplex.Messaging.Transport (SMPVersion) +import Simplex.Messaging.Transport (SMPVersion, TransportError (..)) import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Util import Simplex.Messaging.Version @@ -577,7 +578,7 @@ getSMPServerClient c@AgentClient {active, smpClients, workerSeq} tSess = do prs <- atomically TM.empty smpConnectClient c tSess prs v -getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClient, ProxiedRelay) +getSMPProxyClient :: AgentClient -> SMPTransportSession -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay) getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq} destSess@(userId, destSrv, qId) = do unlessM (readTVarIO active) . throwError $ INACTIVE proxySrv <- getNextServer c userId [destSrv] @@ -589,7 +590,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq ProtoServerWithAuth srv auth <- TM.lookup destSess smpProxiedRelays >>= maybe (TM.insert destSess proxySrv smpProxiedRelays $> proxySrv) pure let tSess = (userId, srv, qId) (tSess,auth,) <$> getSessVar workerSeq tSess smpClients - newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, ProxiedRelay) + newProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay) newProxyClient tSess auth v = do (prs, rv) <- atomically $ do prs <- TM.empty @@ -598,32 +599,33 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq (prs,) . either id id <$> getSessVar workerSeq destSrv prs clnt <- smpConnectClient c tSess prs v (clnt,) <$> newProxiedRelay clnt auth rv - waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, ProxiedRelay) + waitForProxyClient :: SMPTransportSession -> Maybe SMP.BasicAuth -> SMPClientVar -> AM (SMPConnectedClient, Either AgentErrorType ProxiedRelay) waitForProxyClient tSess auth v = do clnt@(SMPConnectedClient _ prs) <- waitForProtocolClient c tSess v sess <- atomically (getSessVar workerSeq destSrv prs) >>= either (newProxiedRelay clnt auth) (waitForProxiedRelay tSess) pure (clnt, sess) - newProxiedRelay :: SMPConnectedClient -> Maybe SMP.BasicAuth -> ProxiedRelayVar -> AM ProxiedRelay + newProxiedRelay :: SMPConnectedClient -> Maybe SMP.BasicAuth -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay) newProxiedRelay clnt@(SMPConnectedClient smp prs) proxyAuth rv = tryAgentError (liftClient SMP (clientServer smp) $ connectSMPProxiedRelay smp destSrv proxyAuth) >>= \case Right sess -> do atomically $ putTMVar (sessionVar rv) (Right sess) liftIO $ incClientStat c userId clnt "PROXY" "OK" - pure sess + pure $ Right sess Left e -> do liftIO $ incClientStat c userId clnt "PROXY" $ strEncode e atomically $ do - removeSessVar rv destSrv prs - TM.delete destSess smpProxiedRelays + unless (persistentProxyError e) $ do + removeSessVar rv destSrv prs + TM.delete destSess smpProxiedRelays putTMVar (sessionVar rv) (Left e) - throwError e -- signal error to caller - waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM ProxiedRelay + pure $ Left e + waitForProxiedRelay :: SMPTransportSession -> ProxiedRelayVar -> AM (Either AgentErrorType ProxiedRelay) waitForProxiedRelay (_, srv, _) rv = do NetworkConfig {tcpConnectTimeout} <- atomically $ getNetworkConfig c sess_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar $ sessionVar rv) - liftEither $ case sess_ of + pure $ case sess_ of Just (Right sess) -> Right sess Just (Left e) -> Left e Nothing -> Left $ BROKER (B.unpack $ strEncode srv) TIMEOUT @@ -874,6 +876,7 @@ closeAgentClient c = do closeProtocolServerClients c smpClients closeProtocolServerClients c ntfClients closeProtocolServerClients c xftpClients + atomically $ writeTVar (smpProxiedRelays c) M.empty atomically (swapTVar (smpSubWorkers c) M.empty) >>= mapM_ cancelReconnect clearWorkers smpDeliveryWorkers >>= mapM_ (cancelWorker . fst) clearWorkers asyncCmdWorkers >>= mapM_ cancelWorker @@ -981,11 +984,14 @@ withClient_ c tSess@(userId, srv, _) statCmd action = do withProxySession :: AgentClient -> SMPTransportSession -> SMP.SenderId -> ByteString -> ((SMPConnectedClient, ProxiedRelay) -> AM a) -> AM a withProxySession c destSess@(userId, destSrv, _) entId cmdStr action = do - cp@(cl, _) <- getSMPProxyClient c destSess + (cl, sess_) <- getSMPProxyClient c destSess logServer ("--> " <> proxySrv cl <> " >") c destSrv entId cmdStr - r <- (action cp <* stat cl "OK") `catchAgentError` logServerError cl - logServer ("<-- " <> proxySrv cl <> " <") c destSrv entId "OK" - pure r + case sess_ of + Right sess -> do + r <- (action (cl, sess) <* stat cl "OK") `catchAgentError` logServerError cl + logServer ("<-- " <> proxySrv cl <> " <") c destSrv entId "OK" + pure r + Left e -> logServerError cl e where stat cl = liftIO . incClientStat c userId cl cmdStr proxySrv = showServer . protocolClientServer' . protocolClient @@ -1029,18 +1035,29 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do | ipAddressProtected cfg destSrv -> pure False | otherwise -> unknownServer SPMNever -> pure False + directAllowed = do + cfg <- getNetworkConfig c + pure $ case smpProxyFallback cfg of + SPFAllow -> True + SPFAllowProtected -> ipAddressProtected cfg destSrv + SPFProhibit -> False unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c) - sendViaProxy destSess = - withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do + sendViaProxy destSess = do + r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do liftClient SMP (clientServer smp) (proxySMPMessage smp proxySess spKey_ senderId msgFlags msg) >>= \case Right () -> pure . Just $ protocolClientServer' smp Left proxyErr -> - throwError + throwE PROXY { proxyServer = protocolClientServer smp, relayServer = B.unpack $ strEncode destSrv, proxyErr } + case r of + Right r' -> pure r' + Left e + | persistentProxyError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e) + | otherwise -> throwE e sendDirectly tSess = withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> liftClient SMP (clientServer smp) $ sendSMPMessage smp spKey_ senderId msgFlags msg @@ -1280,7 +1297,6 @@ temporaryAgentError = \case NETWORK -> True TIMEOUT -> True _ -> False -{-# INLINE temporaryAgentError #-} temporaryOrHostError :: AgentErrorType -> Bool temporaryOrHostError = \case @@ -1288,7 +1304,12 @@ temporaryOrHostError = \case SMP (SMP.PROXY (SMP.BROKER HOST)) -> True PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER HOST))) -> True e -> temporaryAgentError e -{-# INLINE temporaryOrHostError #-} + +persistentProxyError :: AgentErrorType -> Bool +persistentProxyError = \case + BROKER _ (SMP.TRANSPORT TEVersion) -> True + SMP (SMP.PROXY (SMP.BROKER (SMP.TRANSPORT TEVersion))) -> True + _ -> False -- | Subscribe to queues. The list of results can have a different order. subscribeQueues :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())] diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 61ab2400b..5cfd7af03 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -235,7 +235,7 @@ import Simplex.Messaging.Protocol ) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.ServiceScheme -import Simplex.Messaging.Transport (Transport (..), serializeTransportError, transportErrorP) +import Simplex.Messaging.Transport (Transport (..)) import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..)) import Simplex.Messaging.Util import Simplex.Messaging.Version @@ -1554,12 +1554,14 @@ data AgentCryptoError instance StrEncoding AgentCryptoError where strP = - "DECRYPT_AES" $> DECRYPT_AES - <|> "DECRYPT_CB" $> DECRYPT_CB - <|> "RATCHET_HEADER" $> RATCHET_HEADER - <|> "RATCHET_EARLIER " *> (RATCHET_EARLIER <$> strP) - <|> "RATCHET_SKIPPED " *> (RATCHET_SKIPPED <$> strP) - <|> "RATCHET_SYNC" $> RATCHET_SYNC + A.takeTill (== ' ') >>= \case + "DECRYPT_AES" -> pure DECRYPT_AES + "DECRYPT_CB" -> pure DECRYPT_CB + "RATCHET_HEADER" -> pure RATCHET_HEADER + "RATCHET_EARLIER" -> RATCHET_EARLIER <$> _strP + "RATCHET_SKIPPED" -> RATCHET_SKIPPED <$> _strP + "RATCHET_SYNC" -> pure RATCHET_SYNC + _ -> fail "AgentCryptoError" strEncode = \case DECRYPT_AES -> "DECRYPT_AES" DECRYPT_CB -> "DECRYPT_CB" @@ -1570,25 +1572,24 @@ instance StrEncoding AgentCryptoError where instance StrEncoding AgentErrorType where strP = - "CMD " *> (CMD <$> parseRead1) - <|> "CONN " *> (CONN <$> parseRead1) - <|> "SMP " *> (SMP <$> strP) - <|> "NTF " *> (NTF <$> strP) - <|> "XFTP " *> (XFTP <$> strP) - <|> "PROXY " *> (PROXY <$> textP <* A.space <*> textP <*> _strP) - <|> "RCP " *> (RCP <$> strP) - <|> "BROKER " *> (BROKER <$> textP <* " RESPONSE " <*> (RESPONSE <$> textP)) - <|> "BROKER " *> (BROKER <$> textP <* " UNEXPECTED " <*> (UNEXPECTED <$> textP)) - <|> "BROKER " *> (BROKER <$> textP <* " TRANSPORT " <*> (TRANSPORT <$> transportErrorP)) - <|> "BROKER " *> (BROKER <$> textP <* A.space <*> parseRead1) - <|> "AGENT CRYPTO " *> (AGENT . A_CRYPTO <$> parseRead A.takeByteString) - <|> "AGENT QUEUE " *> (AGENT . A_QUEUE <$> parseRead A.takeByteString) - <|> "AGENT " *> (AGENT <$> parseRead1) - <|> "INTERNAL " *> (INTERNAL <$> parseRead A.takeByteString) - <|> "CRITICAL " *> (CRITICAL <$> parseRead1 <* A.space <*> parseRead A.takeByteString) - <|> "INACTIVE" $> INACTIVE + A.takeTill (== ' ') + >>= \case + "CMD" -> CMD <$> (A.space *> parseRead1) + "CONN" -> CONN <$> (A.space *> parseRead1) + "SMP" -> SMP <$> _strP + "NTF" -> NTF <$> _strP + "XFTP" -> XFTP <$> _strP + "PROXY" -> PROXY <$> (A.space *> srvP) <* A.space <*> srvP <*> _strP + "RCP" -> RCP <$> _strP + "BROKER" -> BROKER <$> (A.space *> srvP) <*> _strP + "AGENT" -> AGENT <$> _strP + "INTERNAL" -> INTERNAL <$> (A.space *> textP) + "CRITICAL" -> CRITICAL <$> (A.space *> parseRead1) <*> (A.space *> textP) + "INACTIVE" -> pure INACTIVE + _ -> fail "bad AgentErrorType" where - textP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ') + srvP = T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ') + textP = T.unpack . safeDecodeUtf8 <$> A.takeByteString strEncode = \case CMD e -> "CMD " <> bshow e CONN e -> "CONN " <> bshow e @@ -1597,19 +1598,33 @@ instance StrEncoding AgentErrorType where XFTP e -> "XFTP " <> strEncode e PROXY pxy srv e -> B.unwords ["PROXY", text pxy, text srv, strEncode e] RCP e -> "RCP " <> strEncode e - BROKER srv (RESPONSE e) -> "BROKER " <> text srv <> " RESPONSE " <> text e - BROKER srv (UNEXPECTED e) -> "BROKER " <> text srv <> " UNEXPECTED " <> text e - BROKER srv (TRANSPORT e) -> "BROKER " <> text srv <> " TRANSPORT " <> serializeTransportError e - BROKER srv e -> "BROKER " <> text srv <> " " <> bshow e - AGENT (A_CRYPTO e) -> "AGENT CRYPTO " <> bshow e - AGENT (A_QUEUE e) -> "AGENT QUEUE " <> bshow e - AGENT e -> "AGENT " <> bshow e - INTERNAL e -> "INTERNAL " <> bshow e - CRITICAL restart e -> "CRITICAL " <> bshow restart <> " " <> bshow e + BROKER srv e -> B.unwords ["BROKER", text srv, strEncode e] + AGENT e -> "AGENT " <> strEncode e + INTERNAL e -> "INTERNAL " <> encodeUtf8 (T.pack e) + CRITICAL restart e -> "CRITICAL " <> bshow restart <> " " <> encodeUtf8 (T.pack e) INACTIVE -> "INACTIVE" where text = encodeUtf8 . T.pack +instance StrEncoding SMPAgentError where + strP = + A.takeTill (== ' ') + >>= \case + "MESSAGE" -> pure A_MESSAGE + "PROHIBITED" -> pure A_PROHIBITED + "VERSION" -> pure A_VERSION + "CRYPTO" -> A_CRYPTO <$> _strP + "DUPLICATE" -> pure A_DUPLICATE + "QUEUE" -> A_QUEUE . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString) + _ -> fail "bad SMPAgentError" + strEncode = \case + A_MESSAGE -> "MESSAGE" + A_PROHIBITED -> "PROHIBITED" + A_VERSION -> "VERSION" + A_CRYPTO e -> "CRYPTO " <> strEncode e + A_DUPLICATE -> "DUPLICATE" + A_QUEUE e -> "QUEUE " <> encodeUtf8 (T.pack e) + cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState cryptoErrToSyncState = \case DECRYPT_AES -> RSAllowed diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 8a1349089..c38e56810 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -70,6 +70,7 @@ module Simplex.Messaging.Client TransportSessionMode (..), HostMode (..), SMPProxyMode (..), + SMPProxyFallback (..), defaultClientConfig, defaultSMPClientConfig, defaultNetworkConfig, @@ -224,6 +225,8 @@ data NetworkConfig = NetworkConfig sessionMode :: TransportSessionMode, -- | SMP proxy mode smpProxyMode :: SMPProxyMode, + -- | Fallback to direct connection when destination SMP relay does not support SMP proxy protocol extensions + smpProxyFallback :: SMPProxyFallback, -- | timeout for the initial client TCP/TLS connection (microseconds) tcpConnectTimeout :: Int, -- | timeout of protocol commands (microseconds) @@ -253,6 +256,12 @@ data SMPProxyMode | SPMNever deriving (Eq, Show) +data SMPProxyFallback + = SPFAllow -- connect directly when chosen proxy or destination relay do not support proxy protocol. + | SPFAllowProtected -- connect directly only when IP address is protected (SOCKS proxy or .onion address is used). + | SPFProhibit -- prohibit direct connection to destination relay. + deriving (Eq, Show) + defaultNetworkConfig :: NetworkConfig defaultNetworkConfig = NetworkConfig @@ -261,6 +270,7 @@ defaultNetworkConfig = requiredHostMode = False, sessionMode = TSMUser, smpProxyMode = SPMNever, + smpProxyFallback = SPFAllow, tcpConnectTimeout = defaultTcpConnectTimeout, tcpTimeout = 15_000_000, tcpTimeoutPerKb = 5_000, @@ -705,15 +715,17 @@ deleteSMPQueues = okSMPCommands DEL -- send PRXY :: SMPServer -> Maybe BasicAuth -> Command Sender -- receives PKEY :: SessionId -> X.CertificateChain -> X.SignedExact X.PubKey -> BrokerMsg connectSMPProxiedRelay :: SMPClient -> SMPServer -> Maybe BasicAuth -> ExceptT SMPClientError IO ProxiedRelay -connectSMPProxiedRelay c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth = - sendSMPCommand c Nothing "" (PRXY relayServ proxyAuth) >>= \case - PKEY sId vr (chain, key) -> - case supportedClientSMPRelayVRange `compatibleVersion` vr of - Nothing -> throwE $ relayErr VERSION - Just (Compatible v) -> liftEitherWith (const $ relayErr IDENTITY) $ ProxiedRelay sId v <$> validateRelay chain key - r -> throwE . PCEUnexpectedResponse $ bshow r +connectSMPProxiedRelay c relayServ@ProtocolServer {keyHash = C.KeyHash kh} proxyAuth + | thVersion (thParams c) >= sendingProxySMPVersion = + sendSMPCommand c Nothing "" (PRXY relayServ proxyAuth) >>= \case + PKEY sId vr (chain, key) -> + case supportedClientSMPRelayVRange `compatibleVersion` vr of + Nothing -> throwE $ transportErr TEVersion + Just (Compatible v) -> liftEitherWith (const $ transportErr $ TEHandshake IDENTITY) $ ProxiedRelay sId v <$> validateRelay chain key + r -> throwE . PCEUnexpectedResponse $ bshow r + | otherwise = throwE $ PCETransportError TEVersion where - relayErr = PCEProtocolError . PROXY . BROKER . TRANSPORT . TEHandshake + transportErr = PCEProtocolError . PROXY . BROKER . TRANSPORT validateRelay :: X.CertificateChain -> X.SignedExact X.PubKey -> Either String C.PublicKeyX25519 validateRelay (X.CertificateChain cert) exact = do serverKey <- case cert of @@ -983,6 +995,8 @@ $(J.deriveJSON (enumJSON $ dropPrefix "TSM") ''TransportSessionMode) $(J.deriveJSON (enumJSON $ dropPrefix "SPM") ''SMPProxyMode) +$(J.deriveJSON (enumJSON $ dropPrefix "SPF") ''SMPProxyFallback) + $(J.deriveJSON defaultJSON ''NetworkConfig) $(J.deriveJSON (enumJSON $ dropPrefix "Proxy") ''ProxyClientError) diff --git a/src/Simplex/Messaging/Notifications/Transport.hs b/src/Simplex/Messaging/Notifications/Transport.hs index e2c287437..564b0c0df 100644 --- a/src/Simplex/Messaging/Notifications/Transport.hs +++ b/src/Simplex/Messaging/Notifications/Transport.hs @@ -11,6 +11,7 @@ module Simplex.Messaging.Notifications.Transport where import Control.Monad (forM) import Control.Monad.Except +import Control.Monad.Trans.Except import Data.Attoparsec.ByteString.Char8 (Parser) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -111,7 +112,7 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVRange = do throwError $ TEHandshake IDENTITY | v `isCompatible` ntfVRange -> pure $ ntfThHandleServer th v pk - | otherwise -> throwError $ TEHandshake VERSION + | otherwise -> throwE TEVersion -- | Notifcations server client transport handshake. ntfClientHandshake :: forall c. Transport c => c -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TClient) @@ -128,7 +129,7 @@ ntfClientHandshake c keyHash ntfVRange = do (,(getServerCerts c, signedKey)) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey) sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash} pure $ ntfThHandleClient th v ck_ - Nothing -> throwError $ TEHandshake VERSION + Nothing -> throwE TEVersion ntfThHandleServer :: forall c. THandleNTF c 'TServer -> VersionNTF -> C.PrivateKeyX25519 -> THandleNTF c 'TServer ntfThHandleServer th v pk = diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index d86d65251..250c76fcf 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -196,6 +196,8 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import Data.Maybe (isJust, isNothing) import Data.String +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock.System (SystemTime (..)) import Data.Type.Equality import Data.Word (Word16) @@ -211,7 +213,7 @@ import Simplex.Messaging.Parsers import Simplex.Messaging.ServiceScheme import Simplex.Messaging.Transport import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..)) -import Simplex.Messaging.Util (bshow, eitherToMaybe, (<$?>)) +import Simplex.Messaging.Util (bshow, eitherToMaybe, safeDecodeUtf8, (<$?>)) import Simplex.Messaging.Version import Simplex.Messaging.Version.Internal @@ -1513,7 +1515,7 @@ instance Encoding BrokerErrorType where smpEncode = \case RESPONSE e -> "RESPONSE " <> smpEncode e UNEXPECTED e -> "UNEXPECTED " <> smpEncode e - TRANSPORT e -> "TRANSPORT " <> serializeTransportError e + TRANSPORT e -> "TRANSPORT " <> smpEncode e NETWORK -> "NETWORK" TIMEOUT -> "TIMEOUT" HOST -> "HOST" @@ -1521,7 +1523,7 @@ instance Encoding BrokerErrorType where A.takeTill (== ' ') >>= \case "RESPONSE" -> RESPONSE <$> _smpP "UNEXPECTED" -> UNEXPECTED <$> _smpP - "TRANSPORT" -> TRANSPORT <$> (A.space *> transportErrorP) + "TRANSPORT" -> TRANSPORT <$> _smpP "NETWORK" -> pure NETWORK "TIMEOUT" -> pure TIMEOUT "HOST" -> pure HOST @@ -1529,21 +1531,23 @@ instance Encoding BrokerErrorType where instance StrEncoding BrokerErrorType where strEncode = \case - RESPONSE e -> "RESPONSE " <> strEncode e - UNEXPECTED e -> "UNEXPECTED " <> strEncode e - TRANSPORT e -> "TRANSPORT " <> serializeTransportError e + RESPONSE e -> "RESPONSE " <> encodeUtf8 (T.pack e) + UNEXPECTED e -> "UNEXPECTED " <> encodeUtf8 (T.pack e) + TRANSPORT e -> "TRANSPORT " <> smpEncode e NETWORK -> "NETWORK" TIMEOUT -> "TIMEOUT" HOST -> "HOST" strP = A.takeTill (== ' ') >>= \case - "RESPONSE" -> RESPONSE <$> _strP - "UNEXPECTED" -> UNEXPECTED <$> _strP - "TRANSPORT" -> TRANSPORT <$> (A.space *> transportErrorP) + "RESPONSE" -> RESPONSE <$> _textP + "UNEXPECTED" -> UNEXPECTED <$> _textP + "TRANSPORT" -> TRANSPORT <$> _smpP "NETWORK" -> pure NETWORK "TIMEOUT" -> pure TIMEOUT "HOST" -> pure HOST _ -> fail "bad BrokerErrorType" + where + _textP = A.space *> (T.unpack . safeDecodeUtf8 <$> A.takeByteString) -- | Send signed SMP transmission to TCP transport. tPut :: Transport c => THandle v c p -> NonEmpty (Either TransportError SentRawTransmission) -> IO [Either TransportError ()] diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 0c0426958..4195bffba 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -628,16 +628,26 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi proxyResp = \case Left err -> ERR $ smpProxyError err Right smp -> - let THandleParams {sessionId = srvSessId, thAuth} = thParams smp - vr = supportedServerSMPRelayVRange - in case thAuth of - Just THAuthClient {serverCertKey} -> PKEY srvSessId vr serverCertKey - Nothing -> ERR . PROXY . BROKER $ TRANSPORT TENoServerAuth + 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 + Just THAuthClient {serverCertKey} -> PKEY srvSessId vr serverCertKey + Nothing -> ERR $ transportErr TENoServerAuth + else ERR $ transportErr TEVersion PFWD pubKey encBlock -> do ProxyAgent {smpAgent} <- asks proxyAgent atomically (lookupSMPServerClient smpAgent sessId) >>= \case - Just smp -> liftIO $ either (ERR . smpProxyError) PRES <$> runExceptT (forwardSMPMessage smp corrId pubKey encBlock) `catchError` (pure . Left . PCEIOError) + Just smp + | v >= sendingProxySMPVersion -> + liftIO $ either (ERR . smpProxyError) PRES <$> + runExceptT (forwardSMPMessage smp corrId pubKey encBlock) `catchError` (pure . Left . PCEIOError) + | otherwise -> pure . ERR $ transportErr TEVersion + where + THandleParams {thVersion = v} = thParams smp Nothing -> pure $ ERR $ PROXY NO_SESSION + transportErr :: TransportError -> ErrorType + transportErr = PROXY . BROKER . TRANSPORT processCommand :: (Maybe QueueRec, Transmission Cmd) -> M (Either (Transmission (Command 'ProxiedClient)) (Transmission BrokerMsg)) processCommand (qr_, (corrId, queueId, cmd)) = do st <- asks queueStore @@ -916,8 +926,8 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi processForwardedCommand :: EncFwdTransmission -> M BrokerMsg processForwardedCommand (EncFwdTransmission s) = fmap (either ERR id) . runExceptT $ do - THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE noRelayAuth) pure (thAuth thParams') - sessSecret <- maybe (throwE noRelayAuth) pure sessSecret' + THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams') + 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' @@ -952,7 +962,6 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr) pure $ RRES r3 where - noRelayAuth = PROXY $ BROKER $ TRANSPORT TENoServerAuth rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd)) rejectOrVerify clntThAuth (tAuth, authorized, (corrId', entId', cmdOrError)) = case cmdOrError of diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 6f0f04ff7..6d1f05852 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -72,14 +72,12 @@ module Simplex.Messaging.Transport smpClientHandshake, tPutBlock, tGetBlock, - serializeTransportError, - transportErrorP, sendHandshake, getHandshake, ) where -import Control.Applicative (optional, (<|>)) +import Control.Applicative (optional) import Control.Monad (forM) import Control.Monad.Except import Control.Monad.Trans.Except (throwE) @@ -410,6 +408,8 @@ authEncryptCmdsP v p = if v >= authCmdsSMPVersion then optional p else pure Noth data TransportError = -- | error parsing transport block TEBadBlock + | -- | incompatible client or server version + TEVersion | -- | message does not fit in transport block TELargeMsg | -- | incorrect session ID @@ -425,31 +425,29 @@ data TransportError data HandshakeError = -- | parsing error PARSE - | -- | incompatible peer version - VERSION | -- | incorrect server identity IDENTITY | -- | v7 authentication failed BAD_AUTH deriving (Eq, Read, Show, Exception) --- | SMP encrypted transport error parser. -transportErrorP :: Parser TransportError -transportErrorP = - "BLOCK" $> TEBadBlock - <|> "LARGE_MSG" $> TELargeMsg - <|> "SESSION" $> TEBadSession - <|> "NO_AUTH" $> TENoServerAuth - <|> "HANDSHAKE " *> (TEHandshake <$> parseRead1) - --- | Serialize SMP encrypted transport error. -serializeTransportError :: TransportError -> ByteString -serializeTransportError = \case - TEBadBlock -> "BLOCK" - TELargeMsg -> "LARGE_MSG" - TEBadSession -> "SESSION" - TENoServerAuth -> "NO_AUTH" - TEHandshake e -> "HANDSHAKE " <> bshow e +instance Encoding TransportError where + smpP = + A.takeTill (== ' ') >>= \case + "BLOCK" -> pure TEBadBlock + "VERSION" -> pure TEVersion + "LARGE_MSG" -> pure TELargeMsg + "SESSION" -> pure TEBadSession + "NO_AUTH" -> pure TENoServerAuth + "HANDSHAKE" -> TEHandshake <$> (A.space *> parseRead1) + _ -> fail "bad TransportError" + smpEncode = \case + TEBadBlock -> "BLOCK" + TEVersion -> "VERSION" + TELargeMsg -> "LARGE_MSG" + TEBadSession -> "SESSION" + TENoServerAuth -> "NO_AUTH" + TEHandshake e -> "HANDSHAKE " <> bshow e -- | Pad and send block to SMP transport. tPutBlock :: Transport c => THandle v c p -> ByteString -> IO (Either TransportError ()) @@ -480,7 +478,7 @@ smpServerHandshake serverSignKey c (k, pk) kh smpVRange = do throwE $ TEHandshake IDENTITY | v `isCompatible` smpVRange -> pure $ smpThHandleServer th v pk k' - | otherwise -> throwE $ TEHandshake VERSION + | otherwise -> throwE TEVersion -- | Client SMP transport handshake. -- @@ -503,7 +501,7 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange = do (,certKey) <$> (C.x509ToPublic (pubKey, []) >>= C.pubKey) sendHandshake th $ ClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_} pure $ smpThHandleClient th v (snd <$> ks_) ck_ - Nothing -> throwE $ TEHandshake VERSION + Nothing -> throwE TEVersion smpThHandleServer :: forall c. THandleSMP c 'TServer -> VersionSMP -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandleSMP c 'TServer smpThHandleServer th v pk k_ = diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 05c461f6e..64447da23 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -81,7 +81,7 @@ import qualified Simplex.Messaging.Agent.Protocol as A import Simplex.Messaging.Agent.RetryInterval (RetryInterval (..)) import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore (dbNew)) import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction') -import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyMode (..), TransportSessionMode (TSMEntity, TSMUser), defaultSMPClientConfig) +import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), TransportSessionMode (TSMEntity, TSMUser), defaultSMPClientConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR @@ -454,7 +454,7 @@ canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) = testMatrix2 :: ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testMatrix2 t runTest = do - it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways) 3 $ runTest PQSupportOn True + it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True it "v7" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn False it "v7 to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 $ runTest PQSupportOn False it "current to v7" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 $ runTest PQSupportOn False @@ -466,7 +466,7 @@ testMatrix2 t runTest = do testRatchetMatrix2 :: ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testRatchetMatrix2 t runTest = do - it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways) 3 $ runTest PQSupportOn True + it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfg agentProxyCfg (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True it "ratchet next" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfgV7 3 $ runTest PQSupportOn False it "ratchet next to current" $ withSmpServerV7 t $ runTestCfg2 agentCfgV7 agentCfg 3 $ runTest PQSupportOn False it "ratchet current to next" $ withSmpServerV7 t $ runTestCfg2 agentCfg agentCfgV7 3 $ runTest PQSupportOn False diff --git a/tests/CoreTests/ProtocolErrorTests.hs b/tests/CoreTests/ProtocolErrorTests.hs index 0bf60afdd..af13ba030 100644 --- a/tests/CoreTests/ProtocolErrorTests.hs +++ b/tests/CoreTests/ProtocolErrorTests.hs @@ -35,21 +35,22 @@ protocolErrorTests = modifyMaxSuccess (const 1000) $ do possibleAgentErrorType :: Gen AgentErrorType possibleAgentErrorType = arbitrary >>= \case - BROKER srv _ | skip srv -> discard - BROKER _ (RESPONSE e) | skip e -> discard - BROKER _ (UNEXPECTED e) | skip e -> discard + BROKER srv _ | hasSpaces srv -> discard SMP e | skipErrorType e -> discard NTF e | skipErrorType e -> discard - Agent.PROXY pxy srv _ | skip pxy || skip srv -> discard + Agent.PROXY pxy srv _ | hasSpaces pxy || hasSpaces srv -> discard Agent.PROXY _ _ (ProxyProtocolError e) | skipErrorType e -> discard - Agent.PROXY _ _ (ProxyUnexpectedResponse e) | skip e -> discard + Agent.PROXY _ _ (ProxyUnexpectedResponse e) | hasUnicode e -> discard Agent.PROXY _ _ (ProxyResponseError e) | skipErrorType e -> discard ok -> pure ok - skip s = null s || any (\c -> c <= ' ' || c >= '\255') s + hasSpaces :: String -> Bool + hasSpaces = any (== ' ') + hasUnicode :: String -> Bool + hasUnicode = any (>= '\255') skipErrorType = \case SMP.PROXY (SMP.PROTOCOL e) -> skipErrorType e - SMP.PROXY (SMP.BROKER (UNEXPECTED s)) -> skip s - SMP.PROXY (SMP.BROKER (RESPONSE s)) -> skip s + SMP.PROXY (SMP.BROKER (UNEXPECTED s)) -> hasUnicode s + SMP.PROXY (SMP.BROKER (RESPONSE s)) -> hasUnicode s _ -> False deriving instance Generic AgentErrorType diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index b18b264e1..3cf09e5db 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -35,7 +35,7 @@ import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Agent.Server (runSMPAgentBlocking) import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore (dbNew)) import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction') -import Simplex.Messaging.Client (ProtocolClientConfig (..), SMPProxyMode, chooseTransportHost, defaultNetworkConfig, defaultSMPClientConfig) +import Simplex.Messaging.Client (ProtocolClientConfig (..), SMPProxyFallback, SMPProxyMode, chooseTransportHost, defaultNetworkConfig, defaultSMPClientConfig) import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig) import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth) @@ -199,8 +199,9 @@ initAgentServers = initAgentServers2 :: InitialAgentServers initAgentServers2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer, noAuthSrv testSMPServer2]} -initAgentServersProxy :: SMPProxyMode -> InitialAgentServers -initAgentServersProxy smpProxyMode = initAgentServers {netCfg = (netCfg initAgentServers) {smpProxyMode}} +initAgentServersProxy :: SMPProxyMode -> SMPProxyFallback -> InitialAgentServers +initAgentServersProxy smpProxyMode smpProxyFallback = + initAgentServers {netCfg = (netCfg initAgentServers) {smpProxyMode, smpProxyFallback}} agentCfg :: AgentConfig agentCfg = diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index e27970608..3d9d77033 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -118,10 +118,13 @@ cfg = cfgV7 :: ServerConfig cfgV7 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} +cfgV8 :: ServerConfig +cfgV8 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} + proxyCfg :: ServerConfig proxyCfg = cfgV7 - { allowSMPProxy = True, + { allowSMPProxy = True, smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion, smpAgentCfg = defaultSMPClientAgentConfig {smpCfg = (smpCfg defaultSMPClientAgentConfig) {serverVRange = proxyVRange, agreeSecret = True}} } diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 52145a992..a9c0c5fb1 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -14,6 +14,7 @@ module SMPProxyTests where import AgentTests.FunctionalAPITests +import Control.Monad.Trans.Except (runExceptT) import Data.ByteString.Char8 (ByteString) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L @@ -87,10 +88,14 @@ smpProxyTests = do agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" it "first via proxy for unknown" . twoServers $ agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv1, srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" + it "without proxy with fallback" . twoServers_ proxyCfg cfgV7 $ + agentDeliverMessageViaProxy ([srv1], SPMUnknown, False) ([srv2], SPMUnknown, False) C.SEd448 "hello 1" "hello 2" + it "fails when fallback is prohibited" . twoServers_ proxyCfg cfgV7 $ + agentViaProxyVersionError where oneServer = withSmpServerConfigOn (transport @TLS) proxyCfg testPort . const twoServers = twoServers_ proxyCfg proxyCfg - twoServersFirstProxy = twoServers_ proxyCfg cfgV7 + twoServersFirstProxy = twoServers_ proxyCfg cfgV8 twoServers_ cfg1 cfg2 runTest = withSmpServerConfigOn (transport @TLS) cfg1 testPort $ \_ -> withSmpServerConfigOn (transport @TLS) cfg2 testPort2 $ const runTest @@ -164,7 +169,18 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b baseId = 3 msgId = subtract baseId . fst aCfg = agentProxyCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg} - servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode) {smp = userServers $ L.map noAuthSrv srvs} + servers (srvs, smpProxyMode, _) = (initAgentServersProxy smpProxyMode SPFAllow) {smp = userServers $ L.map noAuthSrv srvs} + +agentViaProxyVersionError :: IO () +agentViaProxyVersionError = + withAgent 1 agentProxyCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do + Left (A.BROKER _ (TRANSPORT TEVersion)) <- + withAgent 2 agentProxyCfg (servers [SMPServer testHost testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do + (_bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + pure () + where + servers srvs = (initAgentServersProxy SPMUnknown SPFProhibit) {smp = userServers $ L.map noAuthSrv srvs} testNoProxy :: IO () testNoProxy = do diff --git a/tests/Test.hs b/tests/Test.hs index cd2b0d8c3..f9fb2a2c0 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -47,7 +47,7 @@ main = do $ do describe "Agent SQLite schema dump" schemaDumpTest describe "Core tests" $ do - xdescribe "Batching tests" batchingTests + describe "Batching tests" batchingTests describe "Encoding tests" encodingTests describe "Protocol error tests" protocolErrorTests describe "Version range" versionRangeTests