From fa772af6c63fab8f04d9d32d8e8397d75d7d0391 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 15 Sep 2024 21:36:31 +0100 Subject: [PATCH] agent: support socks proxy without isolate-by-auth, with and without credentials (#1320) * agent: support socks proxy without isolate-by-auth, with and without credentials * add unit tests * make xftp use correct SOCKS credentials * rename * support ipv6 in brackets, test parsing * constant * textToHostMode * space --- simplexmq.cabal | 1 + src/Simplex/FileTransfer/Client.hs | 5 +- src/Simplex/Messaging/Client.hs | 33 ++++- .../Messaging/Notifications/Server/Main.hs | 5 +- src/Simplex/Messaging/Server/Main.hs | 10 +- src/Simplex/Messaging/Transport/Client.hs | 79 ++++++++--- .../Messaging/Transport/HTTP2/Client.hs | 14 +- tests/CoreTests/SOCKSSettings.hs | 127 ++++++++++++++++++ tests/Test.hs | 2 + 9 files changed, 229 insertions(+), 47 deletions(-) create mode 100644 tests/CoreTests/SOCKSSettings.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index 86eda28b4..c910e2ea3 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -610,6 +610,7 @@ test-suite simplexmq-test CoreTests.CryptoTests CoreTests.EncodingTests CoreTests.RetryIntervalTests + CoreTests.SOCKSSettings CoreTests.TRcvQueuesTests CoreTests.UtilTests CoreTests.VersionRangeTests diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs index 33e927265..6f3b467e8 100644 --- a/src/Simplex/FileTransfer/Client.hs +++ b/src/Simplex/FileTransfer/Client.hs @@ -38,6 +38,7 @@ import Simplex.Messaging.Client defaultNetworkConfig, proxyUsername, transportClientConfig, + clientSocksCredentials, unexpectedResponse, ) import qualified Simplex.Messaging.Crypto as C @@ -100,7 +101,7 @@ defaultXFTPClientConfig = getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient) getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} disconnected = runExceptT $ do - let username = proxyUsername transportSession + let socksCreds = clientSocksCredentials xftpNetworkConfig $ proxyUsername transportSession ProtocolServer _ host port keyHash = srv useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host let tcConfig = (transportClientConfig xftpNetworkConfig useHost) {alpn = clientALPN} @@ -108,7 +109,7 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, clientVar <- newTVarIO Nothing let usePort = if null port then "443" else port clientDisconnected = readTVarIO clientVar >>= mapM_ disconnected - http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client (Just username) useHost usePort (Just keyHash) Nothing http2Config clientDisconnected + http2Client <- liftError' xftpClientError $ getVerifiedHTTP2Client socksCreds useHost usePort (Just keyHash) Nothing http2Config clientDisconnected let HTTP2Client {sessionId, sessionALPN} = http2Client v = VersionXFTP 1 thServerVRange = versionToRange v diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index c0ce663ec..c255d7f69 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -80,10 +80,12 @@ module Simplex.Messaging.Client defaultSMPClientConfig, defaultNetworkConfig, transportClientConfig, + clientSocksCredentials, chooseTransportHost, proxyUsername, temporaryClientError, smpProxyError, + textToHostMode, ServerTransmissionBatch, ServerTransmission (..), ClientCommand, @@ -122,10 +124,13 @@ import Data.List (find) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import Data.Maybe (catMaybes, fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime) import qualified Data.X509 as X import qualified Data.X509.Validation as XV import Network.Socket (ServiceName) +import Network.Socks5 (SocksCredentials (..)) import Numeric.Natural import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding @@ -136,7 +141,7 @@ import Simplex.Messaging.Server.QueueStore.QueueInfo import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport -import Simplex.Messaging.Transport.Client (SocksProxy, TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient) +import Simplex.Messaging.Transport.Client (SocksAuth (..), SocksProxyWithAuth (..), TransportClientConfig (..), TransportHost (..), defaultTcpConnectTimeout, runTransportClient) import Simplex.Messaging.Transport.KeepAlive import Simplex.Messaging.Transport.WebSockets (WS) import Simplex.Messaging.Util (bshow, diffToMicroseconds, ifM, liftEitherWith, raceAny_, threadDelay', tshow, whenM) @@ -236,6 +241,12 @@ data HostMode HMPublic deriving (Eq, Show) +textToHostMode :: Text -> Either String HostMode +textToHostMode = \case + "public" -> Right HMPublic + "onion" -> Right HMOnionViaSocks + s -> Left $ T.unpack $ "Invalid host_mode: " <> s + data SocksMode = -- | always use SOCKS proxy when enabled SMAlways @@ -257,7 +268,7 @@ instance StrEncoding SocksMode where -- | network configuration for the client data NetworkConfig = NetworkConfig { -- | use SOCKS5 proxy - socksProxy :: Maybe SocksProxy, + socksProxy :: Maybe SocksProxyWithAuth, -- | when to use SOCKS proxy socksMode :: SocksMode, -- | determines critera which host is chosen from the list @@ -355,12 +366,22 @@ transportClientConfig :: NetworkConfig -> TransportHost -> TransportClientConfig transportClientConfig NetworkConfig {socksProxy, socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors} host = TransportClientConfig {socksProxy = useSocksProxy socksMode, tcpConnectTimeout, tcpKeepAlive, logTLSErrors, clientCredentials = Nothing, alpn = Nothing} where - useSocksProxy SMAlways = socksProxy + socksProxy' = (\(SocksProxyWithAuth _ proxy) -> proxy) <$> socksProxy + useSocksProxy SMAlways = socksProxy' useSocksProxy SMOnion = case host of - THOnionHost _ -> socksProxy + THOnionHost _ -> socksProxy' _ -> Nothing {-# INLINE transportClientConfig #-} +clientSocksCredentials :: NetworkConfig -> ByteString -> Maybe SocksCredentials +clientSocksCredentials NetworkConfig {socksProxy} sessionUsername = case socksProxy of + Just (SocksProxyWithAuth auth _) -> case auth of + SocksAuthUsername {username, password} -> Just $ SocksCredentials username password + SocksAuthNull -> Nothing + SocksIsolateByAuth -> Just $ SocksCredentials sessionUsername "" + Nothing -> Nothing +{-# INLINE clientSocksCredentials #-} + -- | protocol client configuration. data ProtocolClientConfig v = ProtocolClientConfig { -- | size of TBQueue to use for server commands and responses @@ -489,9 +510,9 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize runClient (port', ATransport t) useHost c = do cVar <- newEmptyTMVarIO let tcConfig = (transportClientConfig networkConfig useHost) {alpn = clientALPN} - username = proxyUsername transportSession + socksCreds = clientSocksCredentials networkConfig $ proxyUsername transportSession tId <- - runTransportClient tcConfig (Just username) useHost port' (Just $ keyHash srv) (client t c cVar) + runTransportClient tcConfig socksCreds useHost port' (Just $ keyHash srv) (client t c cVar) `forkFinally` \_ -> void (atomically . tryPutTMVar cVar $ Left PCENetworkError) c_ <- tcpConnectTimeout `timeout` atomically (takeTMVar cVar) case c_ of diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs index 5002d2d45..cd7135f5a 100644 --- a/src/Simplex/Messaging/Notifications/Server/Main.hs +++ b/src/Simplex/Messaging/Notifications/Server/Main.hs @@ -16,7 +16,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Network.Socket (HostName) import Options.Applicative -import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig) +import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode) import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Notifications.Server (runNtfServer) @@ -26,7 +26,6 @@ import Simplex.Messaging.Notifications.Transport (supportedNTFHandshakes, suppor import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer) import Simplex.Messaging.Server.CLI import Simplex.Messaging.Server.Expiration -import Simplex.Messaging.Server.Main (textToHostMode) import Simplex.Messaging.Transport (simplexMQVersion) import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig) @@ -139,7 +138,7 @@ ntfServerCLI cfgPath logPath = defaultNetworkConfig { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini, socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini, - hostMode = either (const HMPublic) textToHostMode $ lookupValue "SUBSCRIBER" "host_mode" ini, + hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "SUBSCRIBER" "host_mode" ini, requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini, smpPingInterval = 60_000_000 -- 1 minutes } diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 8a1ea0a60..94490bcb8 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -29,7 +29,7 @@ import qualified Data.Text.IO as T import Network.Socket (HostName) import Options.Applicative import Simplex.Messaging.Agent.Protocol (connReqUriP') -import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig) +import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig, textToHostMode) import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String @@ -307,7 +307,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath = defaultNetworkConfig { socksProxy = either error id <$!> strDecodeIni "PROXY" "socks_proxy" ini, socksMode = maybe SMOnion (either error id) $! strDecodeIni "PROXY" "socks_mode" ini, - hostMode = either (const HMPublic) textToHostMode $ lookupValue "PROXY" "host_mode" ini, + hostMode = either (const HMPublic) (either error id . textToHostMode) $ lookupValue "PROXY" "host_mode" ini, requiredHostMode = fromMaybe False $ iniOnOff "PROXY" "required_host_mode" ini } }, @@ -341,12 +341,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath = where isOnion = \case THOnionHost _ -> True; _ -> False -textToHostMode :: Text -> HostMode -textToHostMode = \case - "public" -> HMPublic - "onion" -> HMOnionViaSocks - s -> error . T.unpack $ "Invalid host_mode: " <> s - data EmbeddedWebParams = EmbeddedWebParams { webStaticPath :: FilePath, webHttpPort :: Maybe Int, diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs index da2c6c253..a23c68dd7 100644 --- a/src/Simplex/Messaging/Transport/Client.hs +++ b/src/Simplex/Messaging/Transport/Client.hs @@ -13,9 +13,13 @@ module Simplex.Messaging.Transport.Client defaultSMPPort, defaultTcpConnectTimeout, defaultTransportClientConfig, + defaultSocksProxyWithAuth, defaultSocksProxy, + defaultSocksHost, TransportClientConfig (..), - SocksProxy, + SocksProxy (..), + SocksProxyWithAuth (..), + SocksAuth (..), TransportHost (..), TransportHosts (..), TransportHosts_ (..), @@ -23,7 +27,7 @@ module Simplex.Messaging.Transport.Client ) where -import Control.Applicative (optional) +import Control.Applicative (optional, (<|>)) import Control.Logger.Simple (logError) import Control.Monad (when) import Data.Aeson (FromJSON (..), ToJSON (..)) @@ -79,7 +83,7 @@ instance StrEncoding TransportHost where strP = A.choice [ THIPv4 <$> ((,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal), - maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> A.takeWhile1 (\c -> isHexDigit c || c == ':'), + maybe (Left "bad IPv6") (Right . THIPv6 . fromIPv6w) . readMaybe . B.unpack <$?> ipv6StrP, THOnionHost <$> ((<>) <$> A.takeWhile (\c -> isAsciiLower c || isDigit c) <*> A.string ".onion"), THDomainName . B.unpack <$> (notOnion <$?> A.takeWhile1 (A.notInClass ":#,;/ \n\r\t")) ] @@ -87,6 +91,9 @@ instance StrEncoding TransportHost where ipNum = validIP <$?> (A.decimal <* A.char '.') validIP :: Int -> Either String Word8 validIP n = if 0 <= n && n <= 255 then Right $ fromIntegral n else Left "invalid IP address" + ipv6StrP = + A.char '[' *> A.takeWhile1 (/= ']') <* A.char ']' + <|> A.takeWhile1 (\c -> isHexDigit c || c == ':') notOnion s = if ".onion" `B.isSuffixOf` s then Left "invalid onion host" else Right s instance ToJSON TransportHost where @@ -134,16 +141,16 @@ clientTransportConfig TransportClientConfig {logTLSErrors} = TransportConfig {logTLSErrors, transportTimeout = Nothing} -- | Connect to passed TCP host:port and pass handle to the client. -runTransportClient :: Transport c => TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a +runTransportClient :: Transport c => TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a runTransportClient = runTLSTransportClient supportedParameters Nothing -runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a -runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} proxyUsername host port keyHash client = do +runTLSTransportClient :: Transport c => T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (c -> IO a) -> IO a +runTLSTransportClient tlsParams caStore_ cfg@TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} socksCreds host port keyHash client = do serverCert <- newEmptyTMVarIO let hostName = B.unpack $ strEncode host clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials alpn serverCert connectTCP = case socksProxy of - Just proxy -> connectSocksClient proxy proxyUsername (hostAddr host) + Just proxy -> connectSocksClient proxy socksCreds (hostAddr host) _ -> connectTCPClient hostName c <- do sock <- connectTCP port @@ -191,40 +198,70 @@ connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err defaultSMPPort :: PortNumber defaultSMPPort = 5223 -connectSocksClient :: SocksProxy -> Maybe ByteString -> SocksHostAddress -> ServiceName -> IO Socket -connectSocksClient (SocksProxy addr) proxyUsername hostAddr _port = do +connectSocksClient :: SocksProxy -> Maybe SocksCredentials -> SocksHostAddress -> ServiceName -> IO Socket +connectSocksClient (SocksProxy addr) socksCreds hostAddr _port = do let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port - fst <$> case proxyUsername of - Just username -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) (SocksCredentials username "") + fst <$> case socksCreds of + Just creds -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) creds _ -> socksConnect (defaultSocksConf addr) (SocksAddress hostAddr port) -defaultSocksHost :: HostAddress -defaultSocksHost = tupleToHostAddress (127, 0, 0, 1) +defaultSocksHost :: (Word8, Word8, Word8, Word8) +defaultSocksHost = (127, 0, 0, 1) + +defaultSocksProxyWithAuth :: SocksProxyWithAuth +defaultSocksProxyWithAuth = SocksProxyWithAuth SocksIsolateByAuth defaultSocksProxy defaultSocksProxy :: SocksProxy -defaultSocksProxy = SocksProxy $ SockAddrInet 9050 defaultSocksHost +defaultSocksProxy = SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress defaultSocksHost newtype SocksProxy = SocksProxy SockAddr deriving (Eq) +data SocksProxyWithAuth = SocksProxyWithAuth SocksAuth SocksProxy + deriving (Eq, Show) + +data SocksAuth + = SocksAuthUsername {username :: ByteString, password :: ByteString} + | SocksAuthNull + | SocksIsolateByAuth -- this is default + deriving (Eq, Show) + instance Show SocksProxy where show (SocksProxy addr) = show addr instance StrEncoding SocksProxy where strEncode = B.pack . show strP = do - host <- maybe defaultSocksHost tupleToHostAddress <$> optional ipv4P + host <- fromMaybe (THIPv4 defaultSocksHost) <$> optional strP port <- fromMaybe 9050 <$> optional (A.char ':' *> (fromInteger <$> A.decimal)) - pure . SocksProxy $ SockAddrInet port host + SocksProxy <$> socksAddr port host where - ipv4P = (,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal - ipNum = A.decimal <* A.char '.' + socksAddr port = \case + THIPv4 addr -> pure $ SockAddrInet port $ tupleToHostAddress addr + THIPv6 addr -> pure $ SockAddrInet6 port 0 addr 0 + _ -> fail "SOCKS5 host should be IPv4 or IPv6 address" -instance ToJSON SocksProxy where +instance StrEncoding SocksProxyWithAuth where + strEncode (SocksProxyWithAuth auth proxy) = strEncode auth <> strEncode proxy + strP = SocksProxyWithAuth <$> strP <*> strP + +instance ToJSON SocksProxyWithAuth where toJSON = strToJSON toEncoding = strToJEncoding -instance FromJSON SocksProxy where - parseJSON = strParseJSON "SocksProxy" +instance FromJSON SocksProxyWithAuth where + parseJSON = strParseJSON "SocksProxyWithAuth" + +instance StrEncoding SocksAuth where + strEncode = \case + SocksAuthUsername {username, password} -> username <> ":" <> password <> "@" + SocksAuthNull -> "@" + SocksIsolateByAuth -> "" + strP = usernameP <|> (SocksAuthNull <$ A.char '@') <|> pure SocksIsolateByAuth + where + usernameP = do + username <- A.takeTill (== ':') <* A.char ':' + password <- A.takeTill (== '@') <* A.char '@' + pure SocksAuthUsername {username, password} mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe (X.CertificateChain, T.PrivKey) -> Maybe [ALPN] -> TMVar X.CertificateChain -> T.ClientParams mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ alpn_ serverCerts = diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs index d8d3d495d..53f229f06 100644 --- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs +++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs @@ -11,7 +11,6 @@ import Control.Concurrent.Async import Control.Exception (IOException, try) import qualified Control.Exception as E import Control.Monad -import Data.ByteString.Char8 (ByteString) import Data.Functor (($>)) import Data.Time (UTCTime, getCurrentTime) import qualified Data.X509 as X @@ -20,6 +19,7 @@ import Network.HPACK (BufferSize) import Network.HTTP2.Client (ClientConfig (..), Request, Response) import qualified Network.HTTP2.Client as H import Network.Socket (HostName, ServiceName) +import Network.Socks5 (SocksCredentials) import qualified Network.TLS as T import Numeric.Natural (Natural) import qualified Simplex.Messaging.Crypto as C @@ -91,10 +91,10 @@ data HTTP2ClientError = HCResponseTimeout | HCNetworkError | HCIOError IOExcepti getHTTP2Client :: HostName -> ServiceName -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client) getHTTP2Client host port = getVerifiedHTTP2Client Nothing (THDomainName host) port Nothing -getVerifiedHTTP2Client :: Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client) -getVerifiedHTTP2Client proxyUsername host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup +getVerifiedHTTP2Client :: Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client) +getVerifiedHTTP2Client socksCreds host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup where - setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) proxyUsername host port keyHash + setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) socksCreds host port keyHash attachHTTP2Client :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> Int -> TLS -> IO (Either HTTP2ClientError HTTP2Client) attachHTTP2Client config host port disconnected bufferSize tls = getVerifiedHTTP2ClientWith config host port disconnected setup @@ -178,11 +178,11 @@ sendRequestDirect HTTP2Client {client_ = HClient {config, disconnected}, sendReq http2RequestTimeout :: HTTP2ClientConfig -> Maybe Int -> Int http2RequestTimeout HTTP2ClientConfig {connTimeout} = maybe connTimeout (connTimeout +) -runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (TLS -> H.Client a) -> IO a -runHTTP2Client tlsParams caStore tcConfig bufferSize proxyUsername host port keyHash = runHTTP2ClientWith bufferSize host setup +runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (TLS -> H.Client a) -> IO a +runHTTP2Client tlsParams caStore tcConfig bufferSize socksCreds host port keyHash = runHTTP2ClientWith bufferSize host setup where setup :: (TLS -> IO a) -> IO a - setup = runTLSTransportClient tlsParams caStore tcConfig proxyUsername host port keyHash + setup = runTLSTransportClient tlsParams caStore tcConfig socksCreds host port keyHash runHTTP2ClientWith :: forall a. BufferSize -> TransportHost -> ((TLS -> IO a) -> IO a) -> (TLS -> H.Client a) -> IO a runHTTP2ClientWith bufferSize host setup client = setup $ \tls -> withHTTP2 bufferSize (run tls) (pure ()) tls diff --git a/tests/CoreTests/SOCKSSettings.hs b/tests/CoreTests/SOCKSSettings.hs new file mode 100644 index 000000000..438be0949 --- /dev/null +++ b/tests/CoreTests/SOCKSSettings.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} + +module CoreTests.SOCKSSettings where + +import Network.Socket (SockAddr (..), tupleToHostAddress) +import Simplex.Messaging.Client +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Protocol (ErrorType) +import Simplex.Messaging.Transport.Client +import Test.Hspec + +socksSettingsTests :: Spec +socksSettingsTests = do + describe "hostMode and requiredHostMode settings" testHostMode + describe "socksMode setting, independent of hostMode setting" testSocksMode + describe "socks proxy address encoding" testSocksProxyEncoding + +testPublicHost :: TransportHost +testPublicHost = "smp.example.com" + +testOnionHost :: TransportHost +testOnionHost = "abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrst.onion" + +testHostMode :: Spec +testHostMode = do + describe "requiredHostMode = False (default)" $ do + it "without socks proxy, should choose onion host only with HMOnion" $ do + chooseTransportHost @ErrorType defaultNetworkConfig [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost + chooseHost HMOnionViaSocks Nothing [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost + chooseHost HMOnion Nothing [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost + chooseHost HMPublic Nothing [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost + it "with socks proxy, should choose onion host with HMOnionViaSocks (default) and HMOnion" $ do + chooseTransportHost @ErrorType defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost + chooseHost HMOnionViaSocks (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost + chooseHost HMOnion (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testOnionHost + chooseHost HMPublic (Just defaultSocksProxyWithAuth) [testPublicHost, testOnionHost] `shouldBe` Right testPublicHost + it "should choose any available host, if preferred not available" $ do + chooseHost HMOnionViaSocks Nothing [testOnionHost] `shouldBe` Right testOnionHost + chooseHost HMOnion Nothing [testPublicHost] `shouldBe` Right testPublicHost + chooseHost HMPublic Nothing [testOnionHost] `shouldBe` Right testOnionHost + chooseHost HMOnionViaSocks (Just defaultSocksProxyWithAuth) [testPublicHost] `shouldBe` Right testPublicHost + chooseHost HMOnion (Just defaultSocksProxyWithAuth) [testPublicHost] `shouldBe` Right testPublicHost + chooseHost HMPublic (Just defaultSocksProxyWithAuth) [testOnionHost] `shouldBe` Right testOnionHost + describe "requiredHostMode = True" $ do + it "should fail, if preferred host not available" $ do + testOnionHost `incompatible` (HMOnionViaSocks, Nothing) + testPublicHost `incompatible` (HMOnion, Nothing) + testOnionHost `incompatible` (HMPublic, Nothing) + testPublicHost `incompatible` (HMOnionViaSocks, Just defaultSocksProxyWithAuth) + testPublicHost `incompatible` (HMOnion, Just defaultSocksProxyWithAuth) + testOnionHost `incompatible` (HMPublic, Just defaultSocksProxyWithAuth) + it "should choose preferred host, if available" $ do + testPublicHost `compatible` (HMOnionViaSocks, Nothing) + testOnionHost `compatible` (HMOnion, Nothing) + testPublicHost `compatible` (HMPublic, Nothing) + testOnionHost `compatible` (HMOnionViaSocks, Just defaultSocksProxyWithAuth) + testOnionHost `compatible` (HMOnion, Just defaultSocksProxyWithAuth) + testPublicHost `compatible` (HMPublic, Just defaultSocksProxyWithAuth) + where + chooseHost = chooseHostCfg defaultNetworkConfig + host `incompatible` (hostMode, socksProxy) = + chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host] `shouldBe` Left PCEIncompatibleHost + host `compatible` (hostMode, socksProxy) = do + chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host] `shouldBe` Right host + chooseHostCfg defaultNetworkConfig {requiredHostMode = True} hostMode socksProxy [host, testPublicHost, testOnionHost] `shouldBe` Right host + chooseHostCfg cfg hostMode socksProxy = + chooseTransportHost @ErrorType cfg {hostMode, socksProxy} + +testSocksMode :: Spec +testSocksMode = do + it "should not use SOCKS proxy if not specified" $ do + transportSocksCfg defaultNetworkConfig testPublicHost `shouldBe` Nothing + transportSocksCfg defaultNetworkConfig testOnionHost `shouldBe` Nothing + transportSocks Nothing SMAlways testPublicHost `shouldBe` Nothing + transportSocks Nothing SMAlways testOnionHost `shouldBe` Nothing + transportSocks Nothing SMOnion testPublicHost `shouldBe` Nothing + transportSocks Nothing SMOnion testOnionHost `shouldBe` Nothing + it "should always use SOCKS proxy if specified and (socksMode = SMAlways or (socksMode = SMOnion and onion host))" $ do + transportSocksCfg defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} testPublicHost `shouldBe` Just defaultSocksProxy + transportSocksCfg defaultNetworkConfig {socksProxy = Just defaultSocksProxyWithAuth} testOnionHost `shouldBe` Just defaultSocksProxy + transportSocks (Just defaultSocksProxyWithAuth) SMAlways testPublicHost `shouldBe` Just defaultSocksProxy + transportSocks (Just defaultSocksProxyWithAuth) SMAlways testOnionHost `shouldBe` Just defaultSocksProxy + transportSocks (Just defaultSocksProxyWithAuth) SMOnion testPublicHost `shouldBe` Nothing + transportSocks (Just defaultSocksProxyWithAuth) SMOnion testOnionHost `shouldBe` Just defaultSocksProxy + where + transportSocks proxy socksMode = transportSocksCfg defaultNetworkConfig {socksProxy = proxy, socksMode} + transportSocksCfg cfg host = + let TransportClientConfig {socksProxy} = transportClientConfig cfg host + in socksProxy + +testSocksProxyEncoding :: Spec +testSocksProxyEncoding = do + it "should decode SOCKS proxy with isolate-by-auth mode" $ do + let authIsolate proxy = Right $ SocksProxyWithAuth SocksIsolateByAuth proxy + strDecode "" `shouldBe` authIsolate defaultSocksProxy + strDecode ":9050" `shouldBe` authIsolate defaultSocksProxy + strDecode ":8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 8080 $ tupleToHostAddress defaultSocksHost) + strDecode "127.0.0.1" `shouldBe` authIsolate defaultSocksProxy + strDecode "1.1.1.1" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1)) + strDecode "::1" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0) + strDecode "[fd12:3456:789a:1::1]" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0) + strDecode "127.0.0.1:9050" `shouldBe` authIsolate defaultSocksProxy + strDecode "127.0.0.1:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet 8080 $ tupleToHostAddress defaultSocksHost) + strDecode "[::1]:9050" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 9050 0 (0, 0, 0, 1) 0) + strDecode "[::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0, 0, 0, 1) 0) + strDecode "[fd12:3456:789a:1::1]:8080" `shouldBe` authIsolate (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0) + it "should decode SOCKS proxy without credentials" $ do + let authNull proxy = Right $ SocksProxyWithAuth SocksAuthNull proxy + strDecode "@" `shouldBe` authNull defaultSocksProxy + strDecode "@:9050" `shouldBe` authNull defaultSocksProxy + strDecode "@127.0.0.1" `shouldBe` authNull defaultSocksProxy + strDecode "@1.1.1.1" `shouldBe` authNull (SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress (1, 1, 1, 1)) + strDecode "@127.0.0.1:9050" `shouldBe` authNull defaultSocksProxy + strDecode "@[fd12:3456:789a:1::1]:8080" `shouldBe` authNull (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0) + it "should decode SOCKS proxy with credentials" $ do + let authUser proxy = Right $ SocksProxyWithAuth SocksAuthUsername {username = "user", password = "pass"} proxy + strDecode "user:pass@" `shouldBe` authUser defaultSocksProxy + strDecode "user:pass@:9050" `shouldBe` authUser defaultSocksProxy + strDecode "user:pass@127.0.0.1" `shouldBe` authUser defaultSocksProxy + strDecode "user:pass@127.0.0.1:9050" `shouldBe` authUser defaultSocksProxy + strDecode "user:pass@fd12:3456:789a:1::1" `shouldBe` authUser (SocksProxy $ SockAddrInet6 9050 0 (0xfd123456, 0x789a0001, 0, 1) 0) + strDecode "user:pass@[fd12:3456:789a:1::1]:8080" `shouldBe` authUser (SocksProxy $ SockAddrInet6 8080 0 (0xfd123456, 0x789a0001, 0, 1) 0) diff --git a/tests/Test.hs b/tests/Test.hs index 98d902163..ac95f8c06 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -12,6 +12,7 @@ import CoreTests.CryptoFileTests import CoreTests.CryptoTests import CoreTests.EncodingTests import CoreTests.RetryIntervalTests +import CoreTests.SOCKSSettings import CoreTests.TRcvQueuesTests import CoreTests.UtilTests import CoreTests.VersionRangeTests @@ -52,6 +53,7 @@ main = do describe "Encryption tests" cryptoTests describe "Encrypted files tests" cryptoFileTests describe "Retry interval tests" retryIntervalTests + describe "SOCKS settings tests" socksSettingsTests describe "TRcvQueues tests" tRcvQueuesTests describe "Util tests" utilTests describe "SMP server via TLS" $ serverTests (transport @TLS)