From 6a9075141f5b802488c312052558e664e0709a9a Mon Sep 17 00:00:00 2001 From: Evgeny Date: Mon, 20 Jan 2025 13:45:49 +0000 Subject: [PATCH] xftp server: use recipient ID in control port to delete and block files, smp server: fix version negotiation (#1434) * xftp server: use recipient ID in control port to delete and block files * cap smp proxy agent version at 10 * version * fix prometheus * fix * remove old version support * log connection parameter on error * tests * log sent command tag * log error and client version * cap proxy version for previous destination server * comment, test * remove logging tag * remove logs * version * SMP version 14 * version * remove comments * version --- src/Simplex/FileTransfer/Server.hs | 16 +- src/Simplex/FileTransfer/Transport.hs | 4 +- src/Simplex/Messaging/Client.hs | 22 ++- .../Messaging/Notifications/Transport.hs | 4 +- src/Simplex/Messaging/Protocol.hs | 14 +- src/Simplex/Messaging/Server/Main.hs | 6 +- src/Simplex/Messaging/Server/Prometheus.hs | 4 +- src/Simplex/Messaging/Transport.hs | 164 +++++++++++------- tests/AgentTests/FunctionalAPITests.hs | 20 +-- tests/CLITests.hs | 2 +- tests/CoreTests/BatchingTests.hs | 6 +- tests/NtfClient.hs | 2 +- tests/SMPClient.hs | 10 +- tests/SMPProxyTests.hs | 6 +- tests/ServerTests.hs | 2 +- 15 files changed, 154 insertions(+), 128 deletions(-) diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index 935afe2f9..407b65a70 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -287,13 +287,13 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira CPDelete fileId -> withUserRole $ unliftIO u $ do fs <- asks store r <- runExceptT $ do - (fr, _) <- ExceptT $ atomically $ getFile fs SFSender fileId + (fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId ExceptT $ deleteServerFile_ fr liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r CPBlock fileId info -> withUserRole $ unliftIO u $ do fs <- asks store r <- runExceptT $ do - (fr, _) <- ExceptT $ atomically $ getFile fs SFSender fileId + (fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId ExceptT $ blockServerFile fr info liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit" @@ -540,12 +540,12 @@ blockServerFile fr@FileRec {senderId} info = do deleteOrBlockServerFile_ :: FileRec -> (FileServerStats -> IORef Int) -> (FileStore -> STM (Either XFTPErrorType ())) -> M (Either XFTPErrorType ()) deleteOrBlockServerFile_ FileRec {filePath, fileInfo} stat storeAction = runExceptT $ do - path <- readTVarIO filePath - stats <- asks serverStats - ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats)) - st <- asks store - void $ atomically $ storeAction st - lift $ incFileStat stat + path <- readTVarIO filePath + stats <- asks serverStats + ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats)) + st <- asks store + void $ atomically $ storeAction st + lift $ incFileStat stat where deletedStats stats = do liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1) 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 9a030d4a5..bde663b32 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -171,7 +171,7 @@ data PClient v err msg = PClient timeoutErrorCount :: TVar Int, clientCorrId :: TVar ChaChaDRG, sentCommands :: TMap CorrId (Request err msg), - sndQ :: TBQueue (Maybe (TVar Bool), ByteString), + sndQ :: TBQueue (Maybe (Request err msg), ByteString), rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)), msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg)) } @@ -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 @@ -563,9 +566,12 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize send :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO () send ProtocolClient {client_ = PClient {sndQ}} h = forever $ atomically (readTBQueue sndQ) >>= sendPending where - sendPending (Nothing, s) = send_ s - sendPending (Just pending, s) = whenM (readTVarIO pending) $ send_ s - send_ = void . tPutLog h + sendPending (r, s) = case r of + Nothing -> void $ tPutLog h s + Just Request {pending, responseVar} -> + whenM (readTVarIO pending) $ tPutLog h s >>= either responseErr pure + where + responseErr = atomically . putTMVar responseVar . Left . PCETransportError receive :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO () receive ProtocolClient {client_ = PClient {rcvQ, lastReceived, timeoutErrorCount}} h = forever $ do @@ -1101,12 +1107,12 @@ sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THan where -- two separate "atomically" needed to avoid blocking sendRecv :: Either TransportError SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg) - sendRecv t_ r@Request {pending} = case t_ of + sendRecv t_ r = case t_ of Left e -> pure . Left $ PCETransportError e Right t | B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg | otherwise -> do - atomically $ writeTBQueue sndQ (Just pending, s) + atomically $ writeTBQueue sndQ (Just r, s) response <$> getResponse c tOut r where s 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 2a76faa05..679f077b7 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -260,7 +260,7 @@ supportedSMPClientVRange = mkVersionRange initialSMPClientVersion currentSMPClie -- TODO v6.0 remove dependency on version maxMessageLength :: VersionSMP -> Int maxMessageLength v - | v >= encryptedBlockSMPVersion = 16048 -- max 16051 + | v >= encryptedBlockSMPVersion = 16048 -- max 16048 | v >= sendingProxySMPVersion = 16064 -- max 16067 | otherwise = 16088 -- 16048 - always use this size to determine allowed ranges @@ -1343,7 +1343,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 @@ -1370,9 +1370,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where encodeProtocol v = \case NEW rKey dhKey auth_ subMode sndSecure | v >= sndAuthKeySMPVersion -> new <> e (auth_, subMode, sndSecure) - | v >= subModeSMPVersion -> new <> auth <> e subMode - | v == basicAuthSMPVersion -> new <> auth - | otherwise -> new + | otherwise -> new <> auth <> e subMode where new = e (NEW_, ' ', rKey, dhKey) auth = maybe "" (e . ('A',)) auth_ @@ -1441,9 +1439,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where Cmd SRecipient <$> case tag of NEW_ | v >= sndAuthKeySMPVersion -> new <*> smpP <*> smpP <*> smpP - | v >= subModeSMPVersion -> new <*> auth <*> smpP <*> pure False - | v == basicAuthSMPVersion -> new <*> auth <*> pure SMSubscribe <*> pure False - | otherwise -> new <*> pure Nothing <*> pure SMSubscribe <*> pure False + | otherwise -> new <*> auth <*> smpP <*> pure False where new = NEW <$> _smpP <*> smpP auth = optional (A.char 'A' *> smpP) @@ -1495,7 +1491,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 0ecc5cf94..1d21ffa6a 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -47,11 +47,10 @@ import Simplex.Messaging.Server.Information import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..)) import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..), newMsgStore) import Simplex.Messaging.Server.QueueStore.STM (readQueueStore) -import Simplex.Messaging.Transport (batchCmdsSMPVersion, currentServerSMPRelayVersion, simplexMQVersion, supportedServerSMPRelayVRange) +import Simplex.Messaging.Transport (simplexMQVersion, supportedProxyClientSMPRelayVRange, supportedServerSMPRelayVRange) import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy) import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig) import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8, tshow) -import Simplex.Messaging.Version (mkVersionRange) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist) import System.Exit (exitFailure) import System.FilePath (combine) @@ -447,8 +446,9 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath = defaultSMPClientAgentConfig { smpCfg = (smpCfg defaultSMPClientAgentConfig) - { serverVRange = mkVersionRange batchCmdsSMPVersion currentServerSMPRelayVersion, + { serverVRange = supportedProxyClientSMPRelayVRange, agreeSecret = True, + proxyServer = True, networkConfig = defaultNetworkConfig { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini, diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs index cb9c68d04..3f5c3f87e 100644 --- a/src/Simplex/Messaging/Server/Prometheus.hs +++ b/src/Simplex/Messaging/Server/Prometheus.hs @@ -124,8 +124,8 @@ prometheusMetrics sm rtm ts = \simplex_smp_queues_deleted{type=\"new\"} " <> mshow _qDeletedNew <> "\n# qDeletedNew\n\ \simplex_smp_queues_deleted{type=\"secured\"} " <> mshow _qDeletedSecured <> "\n# qDeletedSecured\n\ \\n\ - \# HELP simplex_smp_queues_deleted Deleted queues\n\ - \# TYPE simplex_smp_queues_deleted counter\n\ + \# HELP simplex_smp_queues_blocked Deleted queues\n\ + \# TYPE simplex_smp_queues_blocked counter\n\ \simplex_smp_queues_blocked " <> mshow _qBlocked <> "\n# qBlocked\n\ \\n\ \# HELP simplex_smp_queues_deleted_batch Batched requests to delete queues\n\ diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index d4601d569..67cb83d01 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 @@ -36,20 +38,20 @@ module Simplex.Messaging.Transport supportedSMPHandshakes, supportedClientSMPRelayVRange, supportedServerSMPRelayVRange, + supportedProxyClientSMPRelayVRange, proxiedSMPRelayVRange, + minClientSMPRelayVersion, + minServerSMPRelayVersion, legacyServerSMPRelayVRange, currentClientSMPRelayVersion, legacyServerSMPRelayVersion, currentServerSMPRelayVersion, - batchCmdsSMPVersion, - basicAuthSMPVersion, - subModeSMPVersion, authCmdsSMPVersion, sendingProxySMPVersion, 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,12 @@ 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) +-- 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 (1/11/2025) +-- 14 - proxyServer handshake property to disable transport encryption between server and proxy (1/19/2025) data SMPVersion @@ -156,14 +159,8 @@ type VersionRangeSMP = VersionRange SMPVersion pattern VersionSMP :: Word16 -> VersionSMP pattern VersionSMP v = Version v -batchCmdsSMPVersion :: VersionSMP -batchCmdsSMPVersion = VersionSMP 4 - -basicAuthSMPVersion :: VersionSMP -basicAuthSMPVersion = VersionSMP 5 - -subModeSMPVersion :: VersionSMP -subModeSMPVersion = VersionSMP 6 +_subModeSMPVersion :: VersionSMP +_subModeSMPVersion = VersionSMP 6 authCmdsSMPVersion :: VersionSMP authCmdsSMPVersion = VersionSMP 7 @@ -180,17 +177,26 @@ deletedEventSMPVersion = VersionSMP 10 encryptedBlockSMPVersion :: VersionSMP encryptedBlockSMPVersion = VersionSMP 11 -blockedEntityErrorSMPVersion :: VersionSMP -blockedEntityErrorSMPVersion = VersionSMP 12 +blockedEntitySMPVersion :: VersionSMP +blockedEntitySMPVersion = VersionSMP 12 + +proxyServerHandshakeSMPVersion :: VersionSMP +proxyServerHandshakeSMPVersion = VersionSMP 14 + +minClientSMPRelayVersion :: VersionSMP +minClientSMPRelayVersion = VersionSMP 6 + +minServerSMPRelayVersion :: VersionSMP +minServerSMPRelayVersion = VersionSMP 6 currentClientSMPRelayVersion :: VersionSMP -currentClientSMPRelayVersion = VersionSMP 12 +currentClientSMPRelayVersion = VersionSMP 14 legacyServerSMPRelayVersion :: VersionSMP legacyServerSMPRelayVersion = VersionSMP 6 currentServerSMPRelayVersion :: VersionSMP -currentServerSMPRelayVersion = VersionSMP 12 +currentServerSMPRelayVersion = VersionSMP 14 -- Max SMP protocol version to be used in e2e encrypted -- connection between client and server, as defined by SMP proxy. @@ -198,20 +204,22 @@ currentServerSMPRelayVersion = VersionSMP 12 -- to prevent client version fingerprinting by the -- destination relays when clients upgrade at different times. proxiedSMPRelayVersion :: VersionSMP -proxiedSMPRelayVersion = VersionSMP 12 +proxiedSMPRelayVersion = VersionSMP 14 --- 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 batchCmdsSMPVersion currentClientSMPRelayVersion +supportedClientSMPRelayVRange = mkVersionRange minClientSMPRelayVersion currentClientSMPRelayVersion legacyServerSMPRelayVRange :: VersionRangeSMP -legacyServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion legacyServerSMPRelayVersion +legacyServerSMPRelayVRange = mkVersionRange minServerSMPRelayVersion legacyServerSMPRelayVersion supportedServerSMPRelayVRange :: VersionRangeSMP -supportedServerSMPRelayVRange = mkVersionRange batchCmdsSMPVersion currentServerSMPRelayVersion +supportedServerSMPRelayVRange = mkVersionRange minServerSMPRelayVersion currentServerSMPRelayVersion + +supportedProxyClientSMPRelayVRange :: VersionRangeSMP +supportedProxyClientSMPRelayVRange = mkVersionRange minServerSMPRelayVersion currentServerSMPRelayVersion --- This range initially allows only version 8 - see the comment above. proxiedSMPRelayVRange :: VersionRangeSMP proxiedSMPRelayVRange = mkVersionRange sendingProxySMPVersion proxiedSMPRelayVersion @@ -412,7 +420,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 @@ -453,18 +461,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 >= proxyServerHandshakeSMPVersion then a else b instance Encoding ServerHandshake where smpEncode ServerHandshake {smpVersionRange, sessionId, authPubKey} = @@ -572,54 +590,70 @@ 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 + -- Below logic downgrades version range in case the "client" is SMP proxy server and it is + -- connected to the destination server of the version 11 or older. + -- It disables transport encryption between SMP proxy and destination relay. + -- + -- Prior to version v6.3 the version between proxy and destination was capped at 8, + -- by mistake, which also disables transport encryption and the latest features. + -- + -- Transport encryption between proxy and destination breaks clients with version 10 or earlier, + -- because of a larger message size (see maxMessageLength). + -- + -- To summarize: + -- - proxy and relay version 12: the agreed version is 12, transport encryption disabled (see blockEncryption with proxyServer == True). + -- - proxy is v 12, relay is 11: the agreed version is 10, because of this logic, transport encryption is disabled. + let smpVRange = + if proxyServer && maxVersion smpVersionRange < proxyServerHandshakeSMPVersion + 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/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 602b74edc..12bea5c90 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -100,7 +100,7 @@ import Simplex.Messaging.Server.Env.STM (ServerConfig (..)) import Simplex.Messaging.Server.Expiration import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..)) import Simplex.Messaging.Server.QueueStore.QueueInfo -import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes) +import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, currentServerSMPRelayVersion, minClientSMPRelayVersion, minServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes) import Simplex.Messaging.Util (bshow, diffToMicroseconds) import Simplex.Messaging.Version (VersionRange (..)) import qualified Simplex.Messaging.Version as V @@ -426,7 +426,6 @@ functionalAPITests t = do describe "should switch two connections simultaneously, abort one" $ testServerMatrix2 t testSwitch2ConnectionsAbort1 describe "SMP basic auth" $ do - let v4 = prevVersion basicAuthSMPVersion forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do let baseId = if v >= sndAuthKeySMPVersion then 1 else 3 sqSecured = if v >= sndAuthKeySMPVersion then True else False @@ -436,20 +435,12 @@ functionalAPITests t = do it "disabled " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 it "NEW fail, no auth " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 it "NEW fail, bad auth " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 - it "NEW fail, version " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 it "JOIN fail, no auth " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 1 it "JOIN fail, bad auth " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) sqSecured baseId `shouldReturn` 1 - it "JOIN fail, version " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) sqSecured baseId `shouldReturn` 1 describe ("v" <> show v <> ": no server auth") $ do it "success " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 2 it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 0 - it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) False 3 `shouldReturn` 2 - it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) False baseId `shouldReturn` 2 - it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) sqSecured 3 `shouldReturn` 2 - it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2 - it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2 it "auth fst " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 2 - it "auth fst 2 " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) False 3 `shouldReturn` 2 it "auth snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2 it "auth both " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2 it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 @@ -482,7 +473,7 @@ functionalAPITests t = do testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured baseId = do - let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion} + let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange minServerSMPRelayVersion srvVersion} canCreate1 = canCreateQueue allowNewQueues srv clnt1 canCreate2 = canCreateQueue allowNewQueues srv clnt2 expected @@ -494,9 +485,8 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured b pure created canCreateQueue :: Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> Bool -canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) = - let v = basicAuthSMPVersion - in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth)) +canCreateQueue allowNew (srvAuth, _) (clntAuth, _) = + allowNew && (isNothing srvAuth || srvAuth == clntAuth) testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec testMatrix2 t runTest = do @@ -2890,7 +2880,7 @@ testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do getClient clientId (clntAuth, clntVersion) db = let servers = initAgentServers {smp = userServers' [ProtoServerWithAuth testSMPServer clntAuth]} alpn_ = if clntVersion >= authCmdsSMPVersion then Just supportedSMPHandshakes else Nothing - smpCfg = defaultClientConfig alpn_ False $ V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion + smpCfg = defaultClientConfig alpn_ False $ V.mkVersionRange minClientSMPRelayVersion clntVersion sndAuthAlg = if srvVersion >= authCmdsSMPVersion && clntVersion >= authCmdsSMPVersion then C.AuthAlg C.SX25519 else C.AuthAlg C.SEd25519 in getSMPAgentClient' clientId agentCfg {smpCfg, sndAuthAlg} servers db 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/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs index 41b1a6a38..3e6a3fa40 100644 --- a/tests/CoreTests/BatchingTests.hs +++ b/tests/CoreTests/BatchingTests.hs @@ -296,7 +296,7 @@ testClientStubV6 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg) testClientStubV6 = do g <- C.newRandom sessId <- atomically $ C.randomBytes 32 g - smpClientStub g sessId subModeSMPVersion Nothing + smpClientStub g sessId minServerSMPRelayVersion Nothing testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg) testClientStub = do @@ -307,7 +307,7 @@ testClientStub = do smpClientStub g sessId currentClientSMPRelayVersion thAuth_ randomSUBv6 :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) -randomSUBv6 = randomSUB_ C.SEd25519 subModeSMPVersion +randomSUBv6 = randomSUB_ C.SEd25519 minServerSMPRelayVersion randomSUB :: ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) randomSUB = randomSUB_ C.SEd25519 currentClientSMPRelayVersion @@ -354,7 +354,7 @@ randomNMSGCmd ts = do pure (CorrId "", EntityId nId, NMSG nonce encNMsgMeta) randomSENDv6 :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) -randomSENDv6 = randomSEND_ C.SEd25519 subModeSMPVersion +randomSENDv6 = randomSEND_ C.SEd25519 minServerSMPRelayVersion randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString)) randomSEND = randomSEND_ C.SX25519 currentClientSMPRelayVersion 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 5f7935cd9..5ce0eb7f6 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 @@ -167,10 +167,10 @@ cfgMS msType = } cfgV7 :: ServerConfig -cfgV7 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} +cfgV7 = cfg {smpServerVRange = mkVersionRange minServerSMPRelayVersion authCmdsSMPVersion} cfgV8 :: ServerConfig -cfgV8 = cfg {smpServerVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} +cfgV8 = cfg {smpServerVRange = mkVersionRange minServerSMPRelayVersion sendingProxySMPVersion} cfgVPrev :: ServerConfig cfgVPrev = cfg {smpServerVRange = prevRange $ smpServerVRange cfg} @@ -185,13 +185,13 @@ proxyCfg :: ServerConfig proxyCfg = cfg { allowSMPProxy = True, - smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True}} + smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True, proxyServer = True, serverVRange = supportedProxyClientSMPRelayVRange}} } where smpAgentCfg' = smpAgentCfg cfg proxyVRangeV8 :: VersionRangeSMP -proxyVRangeV8 = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion +proxyVRangeV8 = mkVersionRange minServerSMPRelayVersion sendingProxySMPVersion withSmpServerStoreMsgLogOn :: HasCallStack => ATransport -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a withSmpServerStoreMsgLogOn = (`withSmpServerStoreMsgLogOnMS` AMSType SMSJournal) diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index cbdc7a3f5..61b7c1670 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -162,12 +162,12 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do g <- C.newRandom -- set up proxy ts <- getCurrentTime - pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing ts (\_ -> pure ()) + pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion currentClientSMPRelayVersion} Nothing ts (\_ -> pure ()) pc <- either (fail . show) pure pc' THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc -- set up relay msgQ <- newTBQueueIO 1024 - rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} (Just msgQ) ts (\_ -> pure ()) + rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion authCmdsSMPVersion} (Just msgQ) ts (\_ -> pure ()) rc <- either (fail . show) pure rc' -- prepare receiving queue (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g @@ -205,7 +205,7 @@ proxyConnectDeadRelay n d proxyServ = do g <- C.newRandom -- set up proxy ts <- getCurrentTime - pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion sendingProxySMPVersion} Nothing ts (\_ -> pure ()) + pc' <- getProtocolClient g (1, proxyServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion sendingProxySMPVersion} Nothing ts (\_ -> pure ()) pc <- either (fail . show) pure pc' THAuthClient {} <- maybe (fail "getProtocolClient returned no thAuth") pure $ thAuth $ thParams pc -- get proxy session diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 9cde80286..088a7b977 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -851,7 +851,7 @@ testTiming = describe "should have similar time for auth error, whether queue exists or not, for all key types" $ forM_ timingTests $ \tst -> it (testName tst) $ \(ATransport t, msType) -> - smpTest2Cfg (cfgMS msType) (mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion) t $ \rh sh -> + smpTest2Cfg (cfgMS msType) (mkVersionRange minServerSMPRelayVersion authCmdsSMPVersion) t $ \rh sh -> testSameTiming rh sh tst where testName :: (C.AuthAlg, C.AuthAlg, Int) -> String