@@ -13,17 +13,21 @@ module Simplex.Messaging.Transport.Client
1313 defaultSMPPort ,
1414 defaultTcpConnectTimeout ,
1515 defaultTransportClientConfig ,
16+ defaultSocksProxyWithAuth ,
1617 defaultSocksProxy ,
18+ defaultSocksHost ,
1719 TransportClientConfig (.. ),
18- SocksProxy ,
20+ SocksProxy (.. ),
21+ SocksProxyWithAuth (.. ),
22+ SocksAuth (.. ),
1923 TransportHost (.. ),
2024 TransportHosts (.. ),
2125 TransportHosts_ (.. ),
2226 validateCertificateChain ,
2327 )
2428where
2529
26- import Control.Applicative (optional )
30+ import Control.Applicative (optional , (<|>) )
2731import Control.Logger.Simple (logError )
2832import Control.Monad (when )
2933import Data.Aeson (FromJSON (.. ), ToJSON (.. ))
@@ -79,14 +83,17 @@ instance StrEncoding TransportHost where
7983 strP =
8084 A. choice
8185 [ THIPv4 <$> ((,,,) <$> ipNum <*> ipNum <*> ipNum <*> A. decimal),
82- maybe (Left " bad IPv6" Right . THIPv6 . fromIPv6w) . readMaybe . B. unpack <$?> A. takeWhile1 ( \ c -> isHexDigit c || c == ' : ' ) ,
86+ maybe (Left " bad IPv6" Right . THIPv6 . fromIPv6w) . readMaybe . B. unpack <$?> ipv6StrP ,
8387 THOnionHost <$> ((<>) <$> A. takeWhile (\ c -> isAsciiLower c || isDigit c) <*> A. string " .onion"
8488 THDomainName . B. unpack <$> (notOnion <$?> A. takeWhile1 (A. notInClass " :#,;/ \n\r\t "
8589 ]
8690 where
8791 ipNum = validIP <$?> (A. decimal <* A. char ' .'
8892 validIP :: Int -> Either String Word8
8993 validIP n = if 0 <= n && n <= 255 then Right $ fromIntegral n else Left " invalid IP address"
94+ ipv6StrP =
95+ A. char ' [' *> A. takeWhile1 (/= ' ]' <* A. char ' ]'
96+ <|> A. takeWhile1 (\ c -> isHexDigit c || c == ' :'
9097 notOnion s = if " .onion" `B.isSuffixOf` s then Left " invalid onion host" else Right
9198
9299instance ToJSON TransportHost where
@@ -134,16 +141,16 @@ clientTransportConfig TransportClientConfig {logTLSErrors} =
134141 TransportConfig {logTLSErrors, transportTimeout = Nothing }
135142
136143-- | Connect to passed TCP host:port and pass handle to the client.
137- runTransportClient :: Transport c => TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C. KeyHash-> (c -> IO a ) -> IO a
144+ runTransportClient :: Transport c => TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C. KeyHash-> (c -> IO a ) -> IO a
138145runTransportClient = runTLSTransportClient supportedParameters Nothing
139146
140- runTLSTransportClient :: Transport c => T. Supported-> Maybe XS. CertificateStore-> TransportClientConfig -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C. KeyHash-> (c -> IO a ) -> IO a
141- runTLSTransportClient tlsParams caStore_ cfg@ TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} proxyUsername host port keyHash client = do
147+ runTLSTransportClient :: Transport c => T. Supported-> Maybe XS. CertificateStore-> TransportClientConfig -> Maybe SocksCredentials -> TransportHost -> ServiceName -> Maybe C. KeyHash-> (c -> IO a ) -> IO a
148+ runTLSTransportClient tlsParams caStore_ cfg@ TransportClientConfig {socksProxy, tcpKeepAlive, clientCredentials, alpn} socksCreds host port keyHash client = do
142149 serverCert <- newEmptyTMVarIO
143150 let hostName = B. unpack $ strEncode host
144151 clientParams = mkTLSClientParams tlsParams caStore_ hostName port keyHash clientCredentials alpn serverCert
145152 connectTCP = case socksProxy of
146- Just proxy -> connectSocksClient proxy proxyUsername (hostAddr host)
153+ Just proxy -> connectSocksClient proxy socksCreds (hostAddr host)
147154 _ -> connectTCPClient hostName
148155 c <- do
149156 sock <- connectTCP port
@@ -191,40 +198,70 @@ connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
191198defaultSMPPort :: PortNumber
192199defaultSMPPort = 5223
193200
194- connectSocksClient :: SocksProxy -> Maybe ByteString -> SocksHostAddress -> ServiceName -> IO Socket
195- connectSocksClient (SocksProxy addr) proxyUsername hostAddr _port = do
201+ connectSocksClient :: SocksProxy -> Maybe SocksCredentials -> SocksHostAddress -> ServiceName -> IO Socket
202+ connectSocksClient (SocksProxy addr) socksCreds hostAddr _port = do
196203 let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port
197- fst <$> case proxyUsername of
198- Just username -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) ( SocksCredentials username " " )
204+ fst <$> case socksCreds of
205+ Just creds -> socksConnectAuth (defaultSocksConf addr) (SocksAddress hostAddr port) creds
199206 _ -> socksConnect (defaultSocksConf addr) (SocksAddress hostAddr port)
200207
201- defaultSocksHost :: HostAddress
202- defaultSocksHost = tupleToHostAddress (127 , 0 , 0 , 1 )
208+ defaultSocksHost :: (Word8 , Word8 , Word8 , Word8 )
209+ defaultSocksHost = (127 , 0 , 0 , 1 )
210+
211+ defaultSocksProxyWithAuth :: SocksProxyWithAuth
212+ defaultSocksProxyWithAuth = SocksProxyWithAuth SocksIsolateByAuth defaultSocksProxy
203213
204214defaultSocksProxy :: SocksProxy
205- defaultSocksProxy = SocksProxy $ SockAddrInet 9050 defaultSocksHost
215+ defaultSocksProxy = SocksProxy $ SockAddrInet 9050 $ tupleToHostAddress defaultSocksHost
206216
207217newtype SocksProxy = SocksProxy SockAddr
208218 deriving (Eq )
209219
220+ data SocksProxyWithAuth = SocksProxyWithAuth SocksAuth SocksProxy
221+ deriving (Eq , Show )
222+
223+ data SocksAuth
224+ = SocksAuthUsername { username :: ByteString , password :: ByteString }
225+ | SocksAuthNull
226+ | SocksIsolateByAuth -- this is default
227+ deriving (Eq , Show )
228+
210229instance Show SocksProxy where show (SocksProxy addr) = show addr
211230
212231instance StrEncoding SocksProxy where
213232 strEncode = B. pack . show
214233 strP = do
215- host <- maybe defaultSocksHost tupleToHostAddress <$> optional ipv4P
234+ host <- fromMaybe ( THIPv4 defaultSocksHost) <$> optional strP
216235 port <- fromMaybe 9050 <$> optional (A. char ' :' *> (fromInteger <$> A. decimal))
217- pure . SocksProxy $ SockAddrInet port host
236+ SocksProxy <$> socksAddr port host
218237 where
219- ipv4P = (,,,) <$> ipNum <*> ipNum <*> ipNum <*> A. decimal
220- ipNum = A. decimal <* A. char ' .'
238+ socksAddr port = \ case
239+ THIPv4 addr -> pure $ SockAddrInet port $ tupleToHostAddress addr
240+ THIPv6 addr -> pure $ SockAddrInet6 port 0 addr 0
241+ _ -> fail " SOCKS5 host should be IPv4 or IPv6 address"
221242
222- instance ToJSON SocksProxy where
243+ instance StrEncoding SocksProxyWithAuth where
244+ strEncode (SocksProxyWithAuth auth proxy) = strEncode auth <> strEncode proxy
245+ strP = SocksProxyWithAuth <$> strP <*> strP
246+
247+ instance ToJSON SocksProxyWithAuth where
223248 toJSON = strToJSON
224249 toEncoding = strToJEncoding
225250
226- instance FromJSON SocksProxy where
227- parseJSON = strParseJSON " SocksProxy"
251+ instance FromJSON SocksProxyWithAuth where
252+ parseJSON = strParseJSON " SocksProxyWithAuth"
253+
254+ instance StrEncoding SocksAuth where
255+ strEncode = \ case
256+ SocksAuthUsername {username, password} -> username <> " :" <> password <> " @"
257+ SocksAuthNull -> " @"
258+ SocksIsolateByAuth -> " "
259+ strP = usernameP <|> (SocksAuthNull <$ A. char ' @' <|> pure SocksIsolateByAuth
260+ where
261+ usernameP = do
262+ username <- A. takeTill (== ' :' <* A. char ' :'
263+ password <- A. takeTill (== ' @' <* A. char ' @'
264+ pure SocksAuthUsername {username, password}
228265
229266mkTLSClientParams :: T. Supported-> Maybe XS. CertificateStore-> HostName -> ServiceName -> Maybe C. KeyHash-> Maybe X. CertificateChainT. PrivKey-> Maybe ALPN ] -> TMVar X. CertificateChain-> T. ClientParams
230267mkTLSClientParams supported caStore_ host port cafp_ clientCreds_ alpn_ serverCerts =
0 commit comments