From d788c3ca95f74d7ec2d737f3ef3ad8dc69d32abc Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 23 Jul 2022 13:57:10 +0100 Subject: [PATCH] access servers via SOCKS proxy (#482) * access servers via SOCKS proxy * config to pass tcp timeout and option SOCKS5 proxy to the agent --- apps/smp-agent/Main.hs | 4 +- package.yaml | 1 + rfcs/2022-07-22-access-via-tor.md | 26 ++++++++++++ rfcs/{ => done}/2022-06-13-db-sync.md | 0 rfcs/{ => done}/2022-06-13-db-sync.mmd | 0 simplexmq.cabal | 5 +++ src/Simplex/Messaging/Agent/Client.hs | 21 +++++++--- src/Simplex/Messaging/Agent/Env/SQLite.hs | 8 +++- src/Simplex/Messaging/Client.hs | 8 +++- src/Simplex/Messaging/Protocol.hs | 2 +- src/Simplex/Messaging/Transport/Client.hs | 40 +++++++++++++------ .../Messaging/Transport/HTTP2/Client.hs | 2 +- tests/NtfClient.hs | 2 +- tests/SMPAgentClient.hs | 6 ++- tests/SMPClient.hs | 2 +- 15 files changed, 99 insertions(+), 28 deletions(-) create mode 100644 rfcs/2022-07-22-access-via-tor.md rename rfcs/{ => done}/2022-06-13-db-sync.md (100%) rename rfcs/{ => done}/2022-06-13-db-sync.mmd (100%) diff --git a/apps/smp-agent/Main.hs b/apps/smp-agent/Main.hs index 72ca7f0..0824fb7 100644 --- a/apps/smp-agent/Main.hs +++ b/apps/smp-agent/Main.hs @@ -17,7 +17,9 @@ servers :: InitialAgentServers servers = InitialAgentServers { smp = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"], - ntf = [] + ntf = [], + socksProxy = Nothing, + tcpTimeout = 5000000 } logCfg :: LogConfig diff --git a/package.yaml b/package.yaml index a5b4240..4922e8a 100644 --- a/package.yaml +++ b/package.yaml @@ -55,6 +55,7 @@ dependencies: - process == 1.6.* - random >= 1.1 && < 1.3 - simple-logger == 0.1.* + - socks == 0.6.* - sqlite-simple == 0.4.* - stm == 2.5.* - template-haskell == 2.16.* diff --git a/rfcs/2022-07-22-access-via-tor.md b/rfcs/2022-07-22-access-via-tor.md new file mode 100644 index 0000000..b4517d4 --- /dev/null +++ b/rfcs/2022-07-22-access-via-tor.md @@ -0,0 +1,26 @@ +# Accessing SMP servers via Tor + +## Problem + +While SMP protocol is focussed on minimizing application-level meta-data by using pair-wise identifiers instead of user profile identifiers, it is important for many users to protect their IP addresses. + +Further, even if IP addresses are hidden by onion routing, clients should be able to choose to use a separate TCP connection to subscribe to each queue, even though it increases traffic and battery consumption, as otherwise the servers can observe multiple queues accessed by the same client. + +## Solution and requirements + +While some users may want to access SMP servers via tor, some other users (even their contacts) may want the opposite - e.g., if they use the network when accessing Tor would be suspicious (or blocked). + +Therefore we need to support the connections when one of the user accesses the same server via Tor (and, possibly, via onion address), while another user accesses this server without Tor. + +At the same time the user accessing the server via Tor may not want that their contacts access this server without Tor, and it also may be possible that the server is not available under a normal (not .onion) address. + +The proposed options for connecting via Tor are: + +1. Access servers via Socks proxy: no/yes (specify port?) +2. Use .onion addresses: no/when available/warn/always +3. Require senders to use .onion addresses: yes/no +4. Use separate TCP connection for each queue + +While it should be possible for SMP servers to have two addresses (with and without Tor), the queues should only use one server address - if the queue started being accessed via .onion address it should not be possible to access it via a normal address. Queue addresses in connection invitations should support dual server addresses (when senders are not required ot use .onion address). + +At the same time, the queue with the normal addresses can be accessed with and without Tor, depending on the current device settings. diff --git a/rfcs/2022-06-13-db-sync.md b/rfcs/done/2022-06-13-db-sync.md similarity index 100% rename from rfcs/2022-06-13-db-sync.md rename to rfcs/done/2022-06-13-db-sync.md diff --git a/rfcs/2022-06-13-db-sync.mmd b/rfcs/done/2022-06-13-db-sync.mmd similarity index 100% rename from rfcs/2022-06-13-db-sync.mmd rename to rfcs/done/2022-06-13-db-sync.mmd diff --git a/simplexmq.cabal b/simplexmq.cabal index ad848dc..a2f633e 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -127,6 +127,7 @@ library , process ==1.6.* , random >=1.1 && <1.3 , simple-logger ==0.1.* + , socks ==0.6.* , sqlite-simple ==0.4.* , stm ==2.5.* , template-haskell ==2.16.* @@ -188,6 +189,7 @@ executable ntf-server , random >=1.1 && <1.3 , simple-logger ==0.1.* , simplexmq + , socks ==0.6.* , sqlite-simple ==0.4.* , stm ==2.5.* , template-haskell ==2.16.* @@ -249,6 +251,7 @@ executable smp-agent , random >=1.1 && <1.3 , simple-logger ==0.1.* , simplexmq + , socks ==0.6.* , sqlite-simple ==0.4.* , stm ==2.5.* , template-haskell ==2.16.* @@ -310,6 +313,7 @@ executable smp-server , random >=1.1 && <1.3 , simple-logger ==0.1.* , simplexmq + , socks ==0.6.* , sqlite-simple ==0.4.* , stm ==2.5.* , template-haskell ==2.16.* @@ -390,6 +394,7 @@ test-suite smp-server-test , random >=1.1 && <1.3 , simple-logger ==0.1.* , simplexmq + , socks ==0.6.* , sqlite-simple ==0.4.* , stm ==2.5.* , template-haskell ==2.16.* diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 451a478..e7dd74a 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -91,6 +91,7 @@ import Data.Text.Encoding import Data.Tuple (swap) import Data.Word (Word16) import qualified Database.SQLite.Simple as DB +import Network.Socks5 (SocksConf) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.RetryInterval @@ -130,6 +131,8 @@ data AgentClient = AgentClient smpClients :: TMap SMPServer SMPClientVar, ntfServers :: TVar [NtfServer], ntfClients :: TMap NtfServer NtfClientVar, + useSocksProxy :: TVar (Maybe SocksConf), + useTcpTimeout :: TVar (Int), subscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue), pendingSubscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue), subscrConns :: TMap ConnId SMPServer, @@ -170,7 +173,7 @@ data AgentState = ASActive | ASSuspending | ASSuspended deriving (Eq, Show) newAgentClient :: InitialAgentServers -> Env -> STM AgentClient -newAgentClient InitialAgentServers {smp, ntf} agentEnv = do +newAgentClient InitialAgentServers {smp, ntf, socksProxy, tcpTimeout} agentEnv = do let qSize = tbqSize $ config agentEnv active <- newTVar True rcvQ <- newTBQueue qSize @@ -180,6 +183,8 @@ newAgentClient InitialAgentServers {smp, ntf} agentEnv = do smpClients <- TM.empty ntfServers <- newTVar ntf ntfClients <- TM.empty + useSocksProxy <- newTVar socksProxy + useTcpTimeout <- newTVar tcpTimeout subscrSrvrs <- TM.empty pendingSubscrSrvrs <- TM.empty subscrConns <- TM.empty @@ -197,7 +202,7 @@ newAgentClient InitialAgentServers {smp, ntf} agentEnv = do asyncClients <- newTVar [] clientId <- stateTVar (clientCounter agentEnv) $ \i -> let i' = i + 1 in (i', i') lock <- newTMVar () - return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, reconnections, asyncClients, clientId, agentEnv, lock} + return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, useSocksProxy, useTcpTimeout, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, reconnections, asyncClients, clientId, agentEnv, lock} agentDbPath :: AgentClient -> FilePath agentDbPath AgentClient {agentEnv = Env {store = SQLiteStore {dbFilePath}}} = dbFilePath @@ -224,7 +229,7 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do where connectClient :: m SMPClient connectClient = do - cfg <- asks $ smpCfg . config + cfg <- atomically . updateClientConfig c =<< asks (smpCfg . config) u <- askUnliftIO liftEitherError (protocolClientError SMP) (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u) @@ -296,7 +301,7 @@ getNtfServerClient c@AgentClient {active, ntfClients} srv = do where connectClient :: m NtfClient connectClient = do - cfg <- asks $ ntfCfg . config + cfg <- atomically . updateClientConfig c =<< asks (ntfCfg . config) liftEitherError (protocolClientError NTF) (getProtocolClient srv cfg Nothing clientDisconnected) clientDisconnected :: IO () @@ -357,6 +362,12 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon ri <- asks $ reconnectInterval . config withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop +updateClientConfig :: AgentClient -> ProtocolClientConfig -> STM ProtocolClientConfig +updateClientConfig AgentClient {useSocksProxy, useTcpTimeout} cfg = do + socksProxy <- readTVar useSocksProxy + tcpTimeout <- readTVar useTcpTimeout + pure (cfg :: ProtocolClientConfig) {socksProxy, tcpTimeout} + closeAgentClient :: MonadIO m => AgentClient -> m () closeAgentClient c = liftIO $ do atomically $ writeTVar (active c) False @@ -372,7 +383,7 @@ closeAgentClient c = liftIO $ do clear smpQueueMsgQueues clear getMsgLocks where - clientTimeout sel = tcpTimeout . sel . config $ agentEnv c + clientTimeout sel = (tcpTimeout :: ProtocolClientConfig -> Int) . sel . config $ agentEnv c clear :: (AgentClient -> TMap k a) -> IO () clear sel = atomically $ writeTVar (sel c) M.empty diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 4dd7cad..708ea36 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -30,6 +30,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.Time.Clock (NominalDiffTime, nominalDay) import Data.Word (Word16) import Network.Socket +import Network.Socks5 (SocksConf) import Numeric.Natural import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.RetryInterval @@ -43,6 +44,7 @@ import Simplex.Messaging.Protocol (NtfServer) import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport (TLS, Transport (..)) +import Simplex.Messaging.Transport.Client (defaultSMPPort) import Simplex.Messaging.Version import System.Random (StdGen, newStdGen) import UnliftIO (Async) @@ -53,7 +55,9 @@ type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorTy data InitialAgentServers = InitialAgentServers { smp :: NonEmpty SMPServer, - ntf :: [NtfServer] + ntf :: [NtfServer], + socksProxy :: Maybe SocksConf, + tcpTimeout :: Int } data AgentConfig = AgentConfig @@ -98,7 +102,7 @@ defaultAgentConfig = tbqSize = 64, dbFile = "smp-agent.db", yesToMigrations = False, - smpCfg = defaultClientConfig {defaultTransport = ("5223", transport @TLS)}, + smpCfg = defaultClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)}, ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)}, reconnectInterval = defaultReconnectInterval, helloTimeout = 2 * nominalDay, diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index ee7f2b6..e7c8930 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -70,6 +70,7 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L import Data.Maybe (fromMaybe) import Network.Socket (ServiceName) +import Network.Socks5 (SocksConf) import Numeric.Natural import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol as SMP @@ -118,6 +119,8 @@ data ProtocolClientConfig = ProtocolClientConfig tcpTimeout :: Int, -- | TCP keep-alive options, Nothing to skip enabling keep-alive tcpKeepAlive :: Maybe KeepAliveOpts, + -- | use SOCKS5 proxy + socksProxy :: Maybe SocksConf, -- | period for SMP ping commands (microseconds) smpPing :: Int, -- | SMP client-server protocol version range @@ -132,6 +135,7 @@ defaultClientConfig = defaultTransport = ("443", transport @TLS), tcpTimeout = 5_000_000, tcpKeepAlive = Just defaultKeepAliveOpts, + socksProxy = Nothing, smpPing = 600_000_000, -- 10min smpServerVRange = supportedSMPServerVRange } @@ -149,7 +153,7 @@ type Response msg = Either ProtocolClientError msg -- A single queue can be used for multiple 'SMPClient' instances, -- as 'SMPServerTransmission' includes server information. getProtocolClient :: forall msg. Protocol msg => ProtoServer msg -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg)) -getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing, smpServerVRange} msgQ disconnected = +getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, socksProxy, smpPing, smpServerVRange} msgQ disconnected = (atomically mkProtocolClient >>= runClient useTransport) `catch` \(e :: IOException) -> pure . Left $ PCEIOError e where @@ -180,7 +184,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc thVar <- newEmptyTMVarIO action <- async $ - runTransportClient (host protocolServer) port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar) + runTransportClient socksProxy (host protocolServer) port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar) `finally` atomically (putTMVar thVar $ Left PCENetworkError) th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar) pure $ case th_ of diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index c167d19..0fe2d0d 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -667,7 +667,7 @@ instance StrEncoding SrvLoc where strP = SrvLoc <$> host <*> (port <|> pure "") where host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ") - port = B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit) + port = show <$> (A.char ':' *> (A.decimal :: Parser Int)) -- | Transmission correlation ID. newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show) diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs index d708742..73d1d29 100644 --- a/src/Simplex/Messaging/Transport/Client.hs +++ b/src/Simplex/Messaging/Transport/Client.hs @@ -4,6 +4,7 @@ module Simplex.Messaging.Transport.Client ( runTransportClient, runTLSTransportClient, smpClientHandshake, + defaultSMPPort, ) where @@ -12,32 +13,43 @@ import Control.Monad.IO.Unlift import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Default (def) +import Data.Maybe (fromMaybe) import qualified Data.X509 as X import qualified Data.X509.CertificateStore as XS import Data.X509.Validation (Fingerprint (..)) import qualified Data.X509.Validation as XV import GHC.IO.Exception (IOErrorType (..)) import Network.Socket +import Network.Socks5 import qualified Network.TLS as T import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Transport import Simplex.Messaging.Transport.KeepAlive import System.IO.Error +import Text.Read (readMaybe) import UnliftIO.Exception (IOException) import qualified UnliftIO.Exception as E -- | Connect to passed TCP host:port and pass handle to the client. -runTransportClient :: (Transport c, MonadUnliftIO m) => HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a +runTransportClient :: (Transport c, MonadUnliftIO m) => Maybe SocksConf -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a runTransportClient = runTLSTransportClient supportedParameters Nothing -runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a -runTLSTransportClient tlsParams caStore_ host port keyHash keepAliveOpts client = do +runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> Maybe SocksConf -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a +runTLSTransportClient tlsParams caStore_ socksConf_ host port keyHash keepAliveOpts client = do let clientParams = mkTLSClientParams tlsParams caStore_ host port keyHash - c <- liftIO $ startTCPClient host port clientParams keepAliveOpts + connectTCP = maybe connectTCPClient connectSocksClient socksConf_ + c <- liftIO $ connectTLSClient connectTCP host port clientParams keepAliveOpts client c `E.finally` liftIO (closeConnection c) -startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c -startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>= tryOpen err +connectTLSClient :: forall c. Transport c => (HostName -> ServiceName -> IO Socket) -> HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c +connectTLSClient tcpClient host port clientParams keepAliveOpts = do + sock <- tcpClient host port + mapM_ (setSocketKeepAlive sock) keepAliveOpts + ctx <- connectTLS clientParams sock + getClientConnection ctx + +connectTCPClient :: HostName -> ServiceName -> IO Socket +connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err where err :: IOException err = mkIOError NoSuchThing "no address" Nothing Nothing @@ -47,20 +59,24 @@ startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >> let hints = defaultHints {addrSocketType = Stream} in getAddrInfo (Just hints) (Just host) (Just port) - tryOpen :: IOException -> [AddrInfo] -> IO c + tryOpen :: IOException -> [AddrInfo] -> IO Socket tryOpen e [] = E.throwIO e tryOpen _ (addr : as) = E.try (open addr) >>= either (`tryOpen` as) pure - open :: AddrInfo -> IO c + open :: AddrInfo -> IO Socket open addr = do sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) connect sock $ addrAddress addr - mapM_ (setSocketKeepAlive sock) keepAliveOpts - ctx <- connectTLS clientParams sock - getClientConnection ctx + pure sock --- readCertificateStore :: FilePath -> IO (Maybe CertificateStore) +defaultSMPPort :: PortNumber +defaultSMPPort = 5223 + +connectSocksClient :: SocksConf -> HostName -> ServiceName -> IO Socket +connectSocksClient socksProxy host _port = do + let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port + fst <$> socksConnect socksProxy (SocksAddress (SocksAddrDomainName $ B.pack host) port) mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams mkTLSClientParams supported caStore_ host port keyHash_ = do diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs index a79368a..9551572 100644 --- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs +++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs @@ -122,7 +122,7 @@ sendRequest HTTP2Client {reqQ, config} req = do runHTTP2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO () runHTTP2Client tlsParams caStore host port keepAliveOpts client = - runTLSTransportClient tlsParams caStore host port Nothing keepAliveOpts $ \c -> + runTLSTransportClient tlsParams caStore Nothing host port Nothing keepAliveOpts $ \c -> withTlsConfig c 16384 (`run` client) where run = H.run $ ClientConfig "https" (B.pack host) 20 diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index 97818aa..70fe9b0 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -68,7 +68,7 @@ ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log" testNtfClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a testNtfClient client = - runTransportClient testHost ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> + runTransportClient Nothing testHost ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> liftIO (runExceptT $ ntfClientHandshake h testKeyHash supportedNTFServerVRange) >>= \case Right th -> client th Left e -> error $ show e diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index ccadf15..9b3210b 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -165,7 +165,9 @@ initAgentServers :: InitialAgentServers initAgentServers = InitialAgentServers { smp = L.fromList [testSMPServer], - ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"] + ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"], + socksProxy = Nothing, + tcpTimeout = 5000000 } initAgentServers2 :: InitialAgentServers @@ -215,7 +217,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB) testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a testSMPAgentClientOn port' client = do - runTransportClient agentTestHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do + runTransportClient Nothing agentTestHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do line <- liftIO $ getLn h if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion then client h diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 104a8c8..c3af444 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -56,7 +56,7 @@ testServerStatsBackupFile = "tests/tmp/smp-server-stats.log" testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a testSMPClient client = - runTransportClient testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> + runTransportClient Nothing testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> liftIO (runExceptT $ smpClientHandshake h testKeyHash supportedSMPServerVRange) >>= \case Right th -> client th Left e -> error $ show e