socks5 (empty) → 0.6.0.0
raw patch · 10 files changed
+1540/−0 lines, 10 filesdep +asyncdep +basedep +binary
Dependencies added: async, base, binary, bytestring, data-default, hspec, iproute, mtl, network, network-run, optparse-applicative, socks5, text, tls
Files
- CHANGELOG.md +25/−0
- LICENSE +29/−0
- Network/SOCKS5/Client.hs +274/−0
- Network/SOCKS5/Internal.hs +423/−0
- Network/SOCKS5/Server.hs +246/−0
- Network/SOCKS5/Types.hs +123/−0
- example/Main.hs +23/−0
- server/Main.hs +105/−0
- socks5.cabal +96/−0
- tests/Spec.hs +196/−0
+ CHANGELOG.md view
@@ -0,0 +1,25 @@+# Revision history for socks5++## 0.1.0.0 -- 2025-06-30++- First version. Released on an unsuspecting world.++## 0.2.0.0 -- 2025-07-06++- TLS version API and server executable's CLI args added.++## 0.3.0.0 -- 2025-07-07++- Adjusted the order of argument for client side API.++## 0.4.0.0 -- 2025-07-07++- UserPass authentication added, adjusted server API and CLI.++## 0.5.0.0 -- 2025-07-07++- Moved some types to separate file. Haddock documentation added. Default server port changed to 1080.++## 0.6.0.0 -- 2025-07-08++- Removed a record from client config. Rename test directory to tests. Added tests for TLS and UserPass authentication.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2025, Shi Rao+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/SOCKS5/Client.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Functions to start connection using SOCKS5 proxy.+--+-- Here is an minimal example of how to use the library to connect to a remote server through a SOCKS5 proxy:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import qualified Data.ByteString.Char8 as C8+-- > import Network.SOCKS5.Client+-- > import Network.SOCKS5.Types+-- > import Network.Socket.ByteString (recv, sendAll)+-- >+-- > main :: IO ()+-- > main = do+-- > let proxyConfig =+-- > ClientConfig+-- > { proxyHost = "127.0.0.1",+-- > proxyPort = "11451",+-- > userPass = Nothing+-- > }+-- > let destAddr = AddressDomain "example.com"+-- > let destPort = "80"+-- >+-- > runTCPConnect destAddr destPort proxyConfig $ \sock -> do+-- > putStrLn "Connected to example.com through SOCKS5 proxy!"+-- > sendAll sock "GET / HTTP/1.1\r\nHost: example.com\r\nConnection: close\r\n\r\n"+-- > response <- recv sock 4096+-- > C8.putStrLn response+module Network.SOCKS5.Client+ ( ClientConfig (..),++ -- * SOCKS5+ runTCPConnect,+ runTCPBind,+ runUDPAssociate,++ -- * SOCKS5 with TLS+ runTCPConnectTLS,+ runTCPBindTLS,+ runUDPAssociateTLS,+ )+where++import Control.Exception+import Control.Monad.State+import Data.Binary (Binary, decode)+import Data.ByteString qualified as B+import Data.Text.Lazy qualified as LT+import Network.Run.TCP+import Network.Run.UDP+import Network.SOCKS5.Internal+import Network.SOCKS5.Types+import Network.Socket+import Network.Socket.ByteString qualified as SB+import Network.TLS+import Text.Read (readMaybe)++data ClientConfig = ClientConfig+ { -- | Hostname or IP address of the SOCKS5 proxy server+ proxyHost :: HostName,+ -- | Port number of the SOCKS5 proxy server+ proxyPort :: ServiceName,+ -- | Username and password for UserPass authentication, `Nothing` will then use `NoAuth`+ userPass :: Maybe (LT.Text, LT.Text)+ }++type StateIO a = StateT B.ByteString IO a++-- | Run a TCP connection to target address and port through proxy.+runTCPConnect ::+ -- | Destination address+ Address ->+ -- | Destination port+ ServiceName ->+ -- | Proxy configuration+ ClientConfig ->+ -- | Client function to run with the connected socket+ (Socket -> IO a) ->+ IO a+runTCPConnect destAddr destPort config client = do+ runTCPClient (proxyHost config) (proxyPort config) $ \sock -> do+ startConnect destAddr destPort config sock client++-- | Run a TCP connection to target address and port through proxy with TLS.+runTCPConnectTLS ::+ -- | Destination address+ Address ->+ -- | Destination port+ ServiceName ->+ -- | Proxy configuration+ ClientConfig ->+ -- | TLS parameters for the connection+ ClientParams ->+ -- | Client function to run with the connected TLS context+ (Context -> IO a) ->+ IO a+runTCPConnectTLS destAddr destPort config params client = do+ runTCPClient (proxyHost config) (proxyPort config) $ \sock -> do+ ctx <- contextNew sock params+ handshake ctx+ res <- startConnect destAddr destPort config ctx client+ bye ctx+ return res++startConnect ::+ (Connection c) =>+ Address ->+ ServiceName ->+ ClientConfig ->+ c ->+ (c -> IO a) ->+ IO a+startConnect destAddr destPort config conn client =+ flip evalStateT B.empty $ do+ performAuth config conn+ portNum <- resolvePort destPort+ encodeAndSend conn $ Request Connect destAddr portNum+ reply <- recv' conn+ case reply of+ Reply Succeeded _ _ -> liftIO $ client conn+ _ -> liftIO $ throwIO $ HandshakeFail reply++-- | run a TCP connection to target by making proxy listen on a port and bind to it.+runTCPBind ::+ -- | Destination address+ Address ->+ -- | Destination port+ ServiceName ->+ -- | Proxy configuration+ ClientConfig ->+ -- | Function to call when the bind is successful, receives the proxy's listening address and port+ (Address -> PortNumber -> IO ()) ->+ -- | Client function to run with the bound socket, receives the connected peer's address and port+ (Address -> PortNumber -> Socket -> IO a) ->+ IO a+runTCPBind destAddr destPort config notify client = do+ runTCPClient (proxyHost config) (proxyPort config) $ \sock -> do+ startBind destAddr destPort config sock notify client++-- | run a TCP connection to target by making proxy listen on a port and bind to it with TLS.+runTCPBindTLS ::+ -- | Destination address+ Address ->+ -- | Destination port+ ServiceName ->+ -- | Proxy configuration+ ClientConfig ->+ -- | TLS parameters for the connection+ ClientParams ->+ -- | Function to call when the bind is successful, receives the proxy's listening address and port+ (Address -> PortNumber -> IO ()) ->+ -- | Client function to run with the bound TLS context, receives the connected peer's address and port+ (Address -> PortNumber -> Context -> IO a) ->+ IO a+runTCPBindTLS destAddr destPort config params notify client = do+ runTCPClient (proxyHost config) (proxyPort config) $ \sock -> do+ ctx <- contextNew sock params+ handshake ctx+ res <- startBind destAddr destPort config ctx notify client+ bye ctx+ return res++startBind ::+ (Connection c) =>+ Address ->+ ServiceName ->+ ClientConfig ->+ c ->+ (Address -> PortNumber -> IO ()) ->+ (Address -> PortNumber -> c -> IO a) ->+ IO a+startBind destAddr destPort config conn notify client =+ flip evalStateT B.empty $ do+ performAuth config conn+ portNum <- resolvePort destPort+ encodeAndSend conn $ Request Bind destAddr portNum+ reply1 <- recv' conn+ case reply1 of+ Reply Succeeded listenAddr listenPort -> do+ liftIO $ notify listenAddr listenPort+ reply2 <- recv' conn+ case reply2 of+ Reply Succeeded hostAddr hostPort ->+ liftIO $ client hostAddr hostPort conn+ _ -> liftIO $ throwIO $ HandshakeFail reply2+ _ -> liftIO $ throwIO $ HandshakeFail reply1++-- | Start a UDP relay on proxy server and run a client function with the connected UDP socket.+runUDPAssociate ::+ -- | Proxy configuration+ ClientConfig ->+ -- | Client function to run with the connected UDP socket, receives a function to send data and a function to receive data+ ((B.ByteString -> SockAddr -> IO ()) -> IO (B.ByteString, SockAddr) -> IO a) ->+ IO a+runUDPAssociate config client = do+ runTCPClient (proxyHost config) (proxyPort config) $ \sockTCP -> do+ startUDPAssociate config sockTCP client++-- | Start a UDP relay on proxy server with TLS and run a client function with the connected UDP socket. Note that the UDP socket is not encrypted, only the initial connection to the proxy is secured.+runUDPAssociateTLS ::+ -- | Proxy configuration+ ClientConfig ->+ -- | TLS parameters for the connection+ ClientParams ->+ -- | Client function to run with the connected UDP socket, receives a function to send data and a function to receive data+ ((B.ByteString -> SockAddr -> IO ()) -> IO (B.ByteString, SockAddr) -> IO a) ->+ IO a+runUDPAssociateTLS config params client = do+ runTCPClient (proxyHost config) (proxyPort config) $ \sockTCP -> do+ ctx <- contextNew sockTCP params+ handshake ctx+ res <- startUDPAssociate config ctx client+ bye ctx+ return res++startUDPAssociate ::+ (Connection c) =>+ ClientConfig ->+ c ->+ ((B.ByteString -> SockAddr -> IO ()) -> IO (B.ByteString, SockAddr) -> IO a) ->+ IO a+startUDPAssociate config conn client =+ flip evalStateT B.empty $ do+ performAuth config conn+ encodeAndSend conn $ Request UDPAssociate (AddressIPv4 "0.0.0.0") 0+ reply <- recv' conn+ case reply of+ Reply Succeeded relayAddr relayPort -> liftIO $ do+ runUDPClient (show relayAddr) (show relayPort) $ \sockUDP proxySockAddr -> do+ let sendDataTo :: B.ByteString -> SockAddr -> IO ()+ sendDataTo userData destination = do+ let (dstAddr, dstPort) = fromSockAddr_ destination+ sendUDPRequestTo sockUDP 0 dstAddr dstPort (B.fromStrict userData) proxySockAddr+ recvDataFrom :: IO (B.ByteString, SockAddr)+ recvDataFrom = do+ (datagram, _) <- SB.recvFrom sockUDP 8192+ let udpReply = decode (B.fromStrict datagram) :: UDPRequest+ originalSender = toSockAddr_ (address udpReply) (port udpReply)+ return (B.toStrict (payload udpReply), originalSender)+ client sendDataTo recvDataFrom+ _ -> liftIO $ throwIO $ HandshakeFail reply++performAuth :: (Connection c) => ClientConfig -> c -> StateIO ()+performAuth config conn = do+ case userPass config of+ Nothing -> encodeAndSend conn $ Hello [NoAuth]+ Just _ -> encodeAndSend conn $ Hello [NoAuth, UserPass]+ selectedMethod <- recv' conn+ case method selectedMethod of+ NoAuth -> return ()+ UserPass -> do+ case userPass config of+ Just (user, pass) -> do+ encodeAndSend conn $ UserPassRequest user pass+ response <- recv' conn+ case response of+ UserPassResponse Success -> return ()+ UserPassResponse status -> liftIO $ throwIO $ AuthFailed status+ _ -> liftIO $ throwIO AuthMissingCredentials+ _ -> liftIO $ throwIO $ AuthUnsupported (method selectedMethod)++resolvePort :: ServiceName -> StateIO PortNumber+resolvePort port = liftIO $+ case readMaybe port of+ Just p -> return p+ Nothing -> throwIO $ PortStringInvalid port++recv' :: (Binary b, Connection c) => c -> StateIO b+recv' conn = do+ buffer <- get+ (val, left) <- recvAndDecode conn buffer+ put left+ return val
+ Network/SOCKS5/Internal.hs view
@@ -0,0 +1,423 @@+module Network.SOCKS5.Internal+ ( Hello (..),+ MethodSelection (..),+ Command (..),+ Request (..),+ Rep (..),+ Reply (..),+ UDPRequest (..),+ sendUDPRequestTo,+ UserPassRequest (..),+ UserPassResponse (..),+ Status (..),+ SOCKSException (..),+ Connection (..),+ recvAndDecode,+ encodeAndSend,+ )+where++import Control.Exception+import Control.Monad+import Control.Monad.State (MonadIO (liftIO))+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as LB+import Data.Text.Lazy qualified as LT+import Data.Text.Lazy.Encoding qualified as LTE+import Network.SOCKS5.Types+import Network.Socket+import Network.Socket.ByteString qualified as SB+import Network.Socket.ByteString.Lazy qualified as LSB+import Network.TLS+import Prelude hiding (getContents)++-- The client connects to the server, and sends a version+-- identifier/method selection message:+-- +-----+----------+----------++-- | VER | NMETHODS | METHODS |+-- +-----+----------+----------++-- | 1 | 1 | 1 to 255 |+-- +-----+----------+----------+++newtype Hello = Hello+ { methods :: [Method]+ }+ deriving (Eq, Show)++instance Binary Hello where+ put :: Hello -> Put+ put (Hello methods) = do+ putWord8 5+ putWord8 (fromIntegral $ length methods)+ mapM_ put methods++ get :: Get Hello+ get = do+ void getWord8+ nMethods <- getWord8+ methods <- replicateM (fromIntegral nMethods) get+ return $ Hello methods++-- The server selects from one of the methods given in METHODS, and+-- sends a METHOD selection message:+-- +-----+--------++-- | VER | METHOD |+-- +-----+--------++-- | 1 | 1 |+-- +-----+--------+++newtype MethodSelection = MethodSelection+ { method :: Method+ }+ deriving (Eq, Show)++instance Binary MethodSelection where+ put :: MethodSelection -> Put+ put (MethodSelection method) = do+ putWord8 5+ put method++ get :: Get MethodSelection+ get = do+ void getWord8+ MethodSelection <$> get++-- The SOCKS request is formed as follows:+-- +-----+-----+-------+------+----------+----------++-- | VER | CMD | RSV | ATYP | DST.ADDR | DST.PORT |+-- +-----+-----+-------+------+----------+----------++-- | 1 | 1 | X'00' | 1 | Variable | 2 |+-- +-----+-----+-------+------+----------+----------++-- Where:+-- VER: protocol version: X'05'+-- CMD:+-- CONNECT: X'01'+-- BIND: X'02'+-- UDP ASSOCIATE: X'03'+-- RSV: RESERVED+-- ATYP: address type of following address:+-- IP V4 address: X'01'+-- DOMAINNAME: X'03'+-- IP V6 address: X'04'+-- DST.ADDR: desired destination address+-- DST.PORT: desired destination port in network octet order++data Command+ = Connect+ | Bind+ | UDPAssociate+ deriving (Eq, Show)++instance Binary Command where+ put :: Command -> Put+ put Connect = putWord8 0x01+ put Bind = putWord8 0x02+ put UDPAssociate = putWord8 0x03++ get :: Get Command+ get = do+ cmd <- getWord8+ case cmd of+ 0x01 -> return Connect+ 0x02 -> return Bind+ 0x03 -> return UDPAssociate+ _ -> fail $ "Unknown command: " ++ show cmd++data Request = Request+ { command :: Command,+ destinationAddress :: Address,+ destinationPort :: PortNumber+ }+ deriving (Eq, Show)++instance Binary Request where+ put :: Request -> Put+ put (Request command destinationAddress destinationPort) = do+ putWord8 0x05+ put command+ putWord8 0x00 -- RSV+ put destinationAddress+ putWord16be $ fromIntegral destinationPort++ get :: Get Request+ get = do+ void getWord8+ command <- get+ void getWord8 -- RSV, ignored+ address <- get+ port <- getWord16be+ let destinationPort = fromIntegral port+ return $ Request command address destinationPort++-- The server evaluates the request, and+-- returns a reply formed as follows:+-- +-----+-----+-------+------+----------+----------++-- | VER | REP | RSV | ATYP | BND.ADDR | BND.PORT |+-- +-----+-----+-------+------+----------+----------++-- | 1 | 1 | X'00' | 1 | Variable | 2 |+-- +-----+-----+-------+------+----------+----------++-- Where:+-- VER: protocol version: X'05'+-- REP: Reply field:+-- X'00': succeeded+-- X'01': general SOCKS server failure+-- X'02': connection not allowed by ruleset+-- X'03': Network unreachable+-- X'04': Host unreachable+-- X'05': Connection refused+-- X'06': TTL expired+-- X'07': Command not supported+-- X'08': Address type not supported+-- X'09': to X'FF' unassigned+-- RSV: RESERVED+-- ATYP: address type of following address+-- IP V4 address: X'01'+-- DOMAINNAME: X'03'+-- IP V6 address: X'04'+-- BND.ADDR: server bound address+-- BND.PORT: server bound port in network octet order++data Rep+ = Succeeded+ | GeneralSOCKSFailure+ | ConnectionNotAllowedByRuleset+ | NetworkUnreachable+ | HostUnreachable+ | ConnectionRefused+ | TTLExpired+ | CommandNotSupported+ | AddressTypeNotSupported+ | Unassigned Word8+ deriving (Eq, Show)++instance Binary Rep where+ put :: Rep -> Put+ put Succeeded = putWord8 0x00+ put GeneralSOCKSFailure = putWord8 0x01+ put ConnectionNotAllowedByRuleset = putWord8 0x02+ put NetworkUnreachable = putWord8 0x03+ put HostUnreachable = putWord8 0x04+ put ConnectionRefused = putWord8 0x05+ put TTLExpired = putWord8 0x06+ put CommandNotSupported = putWord8 0x07+ put AddressTypeNotSupported = putWord8 0x08+ put (Unassigned m) = putWord8 m++ get :: Get Rep+ get = do+ rep <- getWord8+ case rep of+ 0x00 -> return Succeeded+ 0x01 -> return GeneralSOCKSFailure+ 0x02 -> return ConnectionNotAllowedByRuleset+ 0x03 -> return NetworkUnreachable+ 0x04 -> return HostUnreachable+ 0x05 -> return ConnectionRefused+ 0x06 -> return TTLExpired+ 0x07 -> return CommandNotSupported+ 0x08 -> return AddressTypeNotSupported+ _ -> return $ Unassigned rep++data Reply = Reply+ { reply :: Rep,+ boundAddress :: Address,+ boundPort :: PortNumber+ }+ deriving (Eq, Show)++instance Binary Reply where+ put :: Reply -> Put+ put (Reply reply bindAddress boundPort) = do+ putWord8 0x05+ put reply+ putWord8 0x00 -- RSV+ put bindAddress+ putWord16be $ fromIntegral boundPort++ get :: Get Reply+ get = do+ void getWord8+ reply <- get+ void getWord8 -- RSV, ignored+ address <- get+ port <- getWord16be+ let boundPort = fromIntegral port+ return $ Reply reply address boundPort++-- Each UDP datagram carries a UDP request header with it:+-- +-----+------+------+----------+----------+----------++-- | RSV | FRAG | ATYP | DST.ADDR | DST.PORT | DATA |+-- +-----+------+------+----------+----------+----------++-- | 2 | 1 | 1 | Variable | 2 | Variable |+-- +-----+------+------+----------+----------+----------++-- The fields in the UDP request header are:+-- RSV: Reserved X'0000'+-- FRAG: Current fragment number+-- ATYP: address type of following addresses:+-- IP V4 address: X'01'+-- DOMAINNAME: X'03'+-- IP V6 address: X'04'+-- DST.ADDR: desired destination address+-- DST.PORT: desired destination port+-- DATA: user data++data UDPRequest = UDPRequest+ { frag :: Word8,+ address :: Address,+ port :: PortNumber,+ payload :: LB.ByteString+ }+ deriving (Eq, Show)++instance Binary UDPRequest where+ put :: UDPRequest -> Put+ put (UDPRequest frag addr port p) = do+ putWord16be 0x0000 -- RSV+ putWord8 frag+ put addr+ putWord16be $ fromIntegral port+ putLazyByteString p++ get :: Get UDPRequest+ get = do+ void getWord16be -- RSV+ frag <- getWord8+ addr <- get+ port <- getWord16be+ let portNum = fromIntegral port+ UDPRequest frag addr portNum <$> getRemainingLazyByteString++sendUDPRequestTo :: Socket -> Word8 -> Address -> PortNumber -> LB.ByteString -> SockAddr -> IO ()+sendUDPRequestTo sock frag addr port payload =+ SB.sendAllTo sock $ LB.toStrict $ encode $ UDPRequest frag addr port payload++-- Once the SOCKS V5 server has started, and the client has selected the+-- Username/Password Authentication protocol, the Username/Password+-- subnegotiation begins. This begins with the client producing a+-- Username/Password request:+-- +-----+------+----------+------+----------++-- | VER | ULEN | UNAME | PLEN | PASSWD |+-- +-----+------+----------+------+----------++-- | 1 | 1 | 1 to 255 | 1 | 1 to 255 |+-- +-----+------+----------+------+----------+++data UserPassRequest = UserPassRequest+ { username :: LT.Text,+ password :: LT.Text+ }+ deriving (Eq, Show)++instance Binary UserPassRequest where+ put :: UserPassRequest -> Put+ put (UserPassRequest uname passwd) = do+ let encodedUname = LTE.encodeUtf8 uname+ encodedPasswd = LTE.encodeUtf8 passwd+ uLen = fromIntegral $ LB.length encodedUname+ pLen = fromIntegral $ LB.length encodedPasswd+ putWord8 0x01 -- VER+ putWord8 uLen+ putLazyByteString encodedUname+ putWord8 pLen+ putLazyByteString encodedPasswd++ get :: Get UserPassRequest+ get = do+ void getWord8 -- VER, ignored+ uLen <- getWord8+ uname <- getLazyByteString (fromIntegral uLen)+ pLen <- getWord8+ passwd <- getLazyByteString (fromIntegral pLen)+ case (LTE.decodeUtf8' uname, LTE.decodeUtf8' passwd) of+ (Left err, _) -> fail $ "Failed to decode username: " ++ show err+ (_, Left err) -> fail $ "Failed to decode password: " ++ show err+ (Right u, Right p) -> return $ UserPassRequest u p++-- The server verifies the supplied UNAME and PASSWD, and sends the+-- following response:+-- +-----+--------++-- | VER | STATUS |+-- +-----+--------++-- | 1 | 1 |+-- +-----+--------+++data Status+ = Success+ | Failure+ deriving (Eq, Show)++instance Binary Status where+ put :: Status -> Put+ put Success = putWord8 0x00+ put Failure = putWord8 0x01++ get :: Get Status+ get = do+ status <- getWord8+ case status of+ 0x00 -> return Success+ _ -> return Failure++newtype UserPassResponse = UserPassResponse+ { status :: Status+ }+ deriving (Eq, Show)++instance Binary UserPassResponse where+ put :: UserPassResponse -> Put+ put (UserPassResponse status) = do+ putWord8 0x01 -- VER+ put status++ get :: Get UserPassResponse+ get = do+ void getWord8 -- VER, ignored+ UserPassResponse <$> get++data SOCKSException+ = HandshakeFail Reply+ | AuthUnsupported Method+ | AuthFailed Status+ | AuthMissingCredentials+ | ConnectionToTargetFailed SomeException+ | NoAcceptableAuthMethods+ | PortStringInvalid ServiceName+ deriving (Show)++instance Exception SOCKSException++class Connection c where+ connRecv :: c -> IO B.ByteString+ connSend :: c -> LB.ByteString -> IO ()++instance Connection Socket where+ connRecv :: Socket -> IO B.ByteString+ connRecv sock = SB.recv sock 4096++ connSend :: Socket -> LB.ByteString -> IO ()+ connSend = LSB.sendAll++instance Connection Context where+ connRecv :: Context -> IO B.ByteString+ connRecv = recvData++ connSend :: Context -> LB.ByteString -> IO ()+ connSend = sendData++recvAndDecode :: (Binary a, Connection c, MonadIO m) => c -> B.ByteString -> m (a, B.ByteString)+recvAndDecode conn buffer = liftIO $ go $ pushChunk (runGetIncremental get) buffer+ where+ go :: Decoder a -> IO (a, B.ByteString)+ go (Done left _ val) = return (val, left)+ go (Fail _ _ err) = throwIO $ userError $ "SOCKS5 parse error: " ++ err+ go (Partial k) = do+ chunk <- connRecv conn+ if B.null chunk+ then go (k Nothing)+ else go (k (Just chunk))++encodeAndSend :: (Binary a, Connection c, MonadIO m) => c -> a -> m ()+encodeAndSend conn val = do+ liftIO $ connSend conn $ encode val
+ Network/SOCKS5/Server.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Functions to run a SOCKS5 server.+module Network.SOCKS5.Server+ ( ServerConfig (..),++ -- * SOCKS5 Server+ runSOCKS5Server,++ -- * SOCKS5 Server with TLS+ runSOCKS5ServerTLS,+ )+where++import Control.Concurrent.Async+import Control.Exception+import Control.Monad+import Control.Monad.State+import Data.Bifunctor+import Data.Binary (Binary, decode)+import Data.ByteString qualified as B+import Data.IORef+import Data.List.NonEmpty qualified as NE+import Data.Text.Lazy qualified as LT+import Network.Run.TCP+import Network.SOCKS5.Internal+import Network.SOCKS5.Types+import Network.Socket+import Network.Socket.ByteString qualified as SB+import Network.TLS+import System.IO.Error++data ServerConfig = ServerConfig+ { -- | Hostname or IP address to bind the server to+ serverHost :: HostName,+ -- | Port number to listen on+ serverPort :: ServiceName,+ -- | List of User/Password pairs for UserPass authentication+ users :: [(LT.Text, LT.Text)]+ }++type StateIO a = StateT B.ByteString IO a++-- | Run a SOCKS5 server with the given configuration.+runSOCKS5Server :: ServerConfig -> IO ()+runSOCKS5Server config = do+ let host = serverHost config+ port = serverPort config+ putStrLn $ "Starting SOCKS5 server on " ++ host ++ ":" ++ port+ runTCPServer (Just host) port $ \sockTCP -> do+ clientAddr <- getPeerName sockTCP+ putStrLn $ "Accepted new client connection from " ++ show clientAddr+ handle (\(e :: SomeException) -> putStrLn $ show clientAddr ++ ": " ++ show e) $+ newClient config sockTCP sockTCP++-- | Run a SOCKS5 server with TLS support.+runSOCKS5ServerTLS :: ServerConfig -> ServerParams -> IO ()+runSOCKS5ServerTLS config params = do+ let host = serverHost config+ port = serverPort config+ putStrLn $ "Starting SOCKS5 server on " ++ host ++ ":" ++ port ++ " (TLS: on)"+ runTCPServer (Just host) port $ \sockTCP -> do+ clientAddr <- getPeerName sockTCP+ putStrLn $ "Accepted new client connection from " ++ show clientAddr+ handle (\(e :: SomeException) -> putStrLn $ show clientAddr ++ ": " ++ show e) $ do+ ctx <- contextNew sockTCP params+ handshake ctx+ newClient config ctx sockTCP+ bye ctx++newClient :: (Connection c) => ServerConfig -> c -> Socket -> IO ()+newClient config conn clientSock = do+ void $ flip runStateT B.empty $ do+ handleAuthentication config conn+ req <- recv' conn+ liftIO $ putStrLn $ "Received SOCKS5 Request: " ++ show req+ case command req of+ Connect -> liftIO $ handleConnect req conn clientSock+ Bind -> liftIO $ handleBind req conn clientSock+ UDPAssociate -> liftIO $ handleUDPAssociate req conn clientSock++handleAuthentication :: (Connection c) => ServerConfig -> c -> StateIO ()+handleAuthentication config conn = do+ auths <- methods <$> recv' conn+ let noUsers = null $ users config+ selectedMethod <-+ if+ | NoAuth `elem` auths && noUsers -> do+ encodeAndSend conn $ MethodSelection NoAuth+ return NoAuth+ | UserPass `elem` auths && not noUsers -> do+ encodeAndSend conn $ MethodSelection UserPass+ return UserPass+ | otherwise -> liftIO $ throwIO NoAcceptableAuthMethods+ when (selectedMethod == UserPass) $ do+ UserPassRequest uname passwd <- recv' conn+ let credentials = (uname, passwd)+ if credentials `elem` users config+ then encodeAndSend conn $ UserPassResponse Success+ else do+ encodeAndSend conn $ UserPassResponse Failure+ liftIO $ throwIO $ AuthFailed Failure++handleConnect :: (Connection c) => Request -> c -> Socket -> IO ()+handleConnect (Request _ addr port) conn clientSock = do+ handle (replyError conn) $+ runTCPClient (show addr) (show port) $ \destSock -> do+ putStrLn "Successfully connected to destination server."+ (selfAddr, selfPort) <- fromSockAddr_ <$> getSocketName clientSock+ encodeAndSend conn $ Reply Succeeded selfAddr selfPort+ putStrLn $ "Sent SOCKS5 Reply: Succeeded, bound to " ++ show selfAddr ++ ":" ++ show selfPort+ let forwardToDest = do+ clientData <- connRecv conn+ unless (B.null clientData) $ do+ SB.sendAll destSock clientData+ forwardToDest+ let forwardToClient = do+ serverData <- SB.recv destSock 4096+ unless (B.null serverData) $ do+ connSend conn $ B.fromStrict serverData+ forwardToClient+ concurrently_ forwardToDest forwardToClient+ putStrLn "Data forwarding complete. Closing dest connection."++handleBind :: (Connection c) => Request -> c -> Socket -> IO ()+handleBind (Request _ _destAddr _destPort) conn clientSock =+ handle (replyError conn) $+ bracket (newTCPSocket "0.0.0.0") close $ \listenSock -> do+ (selfAddr, _) <- fromSockAddr_ <$> getSocketName clientSock+ (_, listenPort) <- fromSockAddr_ <$> getSocketName listenSock+ putStrLn $ "Listening for connections on " ++ show selfAddr ++ ":" ++ show listenPort+ encodeAndSend conn $ Reply Succeeded selfAddr listenPort+ bracket (accept listenSock) (\(destSock, _) -> close destSock) $ \(destSock, destSockAddr) -> do+ let (destAddr, destPort) = fromSockAddr_ destSockAddr+ putStrLn $ "Accepted connection from " ++ show destAddr ++ ":" ++ show destPort+ encodeAndSend conn $ Reply Succeeded destAddr destPort+ let forwardToDest = do+ clientData <- connRecv conn+ unless (B.null clientData) $ do+ SB.sendAll destSock clientData+ forwardToDest+ let forwardToClient = do+ serverData <- SB.recv destSock 4096+ unless (B.null serverData) $ do+ connSend conn $ B.fromStrict serverData+ forwardToClient+ concurrently_ forwardToDest forwardToClient+ putStrLn "Data forwarding complete. Closing dest connection."+ where+ newTCPSocket host = do+ addrInfo <- head <$> getAddrInfo (Just defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}) (Just host) (Just "0")+ sock <- openSocket addrInfo+ bind sock (addrAddress addrInfo)+ listen sock 1+ return sock++-- The UDP relay server MUST acquire from the SOCKS server the expected+-- IP address of the client that will send datagrams to the BND.PORT+-- given in the reply to UDP ASSOCIATE. It MUST drop any datagrams+-- arriving from any source IP address other than the one recorded for+-- the particular association.++handleUDPAssociate :: (Connection c) => Request -> c -> Socket -> IO ()+handleUDPAssociate (Request _ destAddr destPort) conn clientSock =+ handle (replyError clientSock) $+ bracket (newUDPSocket "0.0.0.0") close $ \relaySock -> do+ (selfAddr, _) <- fromSockAddr_ <$> getSocketName clientSock+ (_, relayPort) <- fromSockAddr_ <$> getSocketName relaySock+ encodeAndSend conn $ Reply Succeeded selfAddr relayPort+ (expectedClient, _) <- fromSockAddr_ <$> getPeerName clientSock+ putStrLn $ "UDP association created for " ++ show expectedClient ++ ". Relaying on port " ++ show relayPort ++ "."+ -- If the client is not in possesion of the information at the time of the UDP+ -- ASSOCIATE, the client MUST use a port number and address of all zeros.+ let expectedDest = case (destAddr, destPort) of+ (AddressIPv4 "0.0.0.0", 0) -> Nothing+ (AddressIPv6 "::", 0) -> Nothing+ (AddressDomain _, _) -> Nothing+ _ -> Just destAddr+ -- A UDP association terminates when the TCP connection that the UDP ASSOCIATE request arrived on terminates.+ withAsync (forwardUDP expectedClient expectedDest relaySock) $ \_ -> do+ putStrLn "UDP association active. Waiting for TCP control connection to close."+ waitForTCPClose clientSock+ putStrLn "TCP control connection closed. Terminating UDP association."+ where+ newUDPSocket host = do+ addrInfo <- head <$> getAddrInfo (Just defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Datagram}) (Just host) (Just "0")+ sock <- openSocket addrInfo+ bind sock (addrAddress addrInfo)+ return sock+ waitForTCPClose sock = do+ chunk <- SB.recv sock 1024+ unless (B.null chunk) $ waitForTCPClose sock++forwardUDP :: Address -> Maybe Address -> Socket -> IO ()+forwardUDP expectedClientAddr expectedDestAddr relaySock = do+ putStrLn $ "Waiting UDP packets from client: " ++ show expectedClientAddr ++ " and dest: " ++ show expectedDestAddr+ -- Use an IORef to store the client address once received, we don't know port yet+ clientUDPSockAddr <- newIORef Nothing+ forever $ do+ (datagram, sourceUDPSockAddr) <- first B.fromStrict <$> SB.recvFrom relaySock 8192+ let (sourceUDPAddr, _) = fromSockAddr_ sourceUDPSockAddr+ -- sourceUDPAddr is used to compare only the address, not the port+ mClientSockAddr <- readIORef clientUDPSockAddr+ case mClientSockAddr of+ Nothing ->+ when (sourceUDPAddr == expectedClientAddr) $ do+ putStrLn $ "Accepted first UDP packet from client at " ++ show sourceUDPSockAddr+ writeIORef clientUDPSockAddr (Just sourceUDPSockAddr)+ handleClientPacket datagram+ Just clientSockAddr ->+ if+ | sourceUDPSockAddr == clientSockAddr -> handleClientPacket datagram+ | isExpectedDest sourceUDPAddr -> handleRemotePacket datagram sourceUDPSockAddr clientSockAddr+ | otherwise -> putStrLn $ "Received packet from unexpected source: " ++ show sourceUDPSockAddr+ where+ handleClientPacket datagram = do+ let (UDPRequest _ addr port load) = decode datagram :: UDPRequest+ destAddr <- NE.head <$> getAddrInfo (Just defaultHints {addrSocketType = Datagram}) (Just $ show addr) (Just $ show port)+ SB.sendAllTo relaySock (B.toStrict load) (addrAddress destAddr)+ isExpectedDest addr = case expectedDestAddr of+ Nothing -> True+ Just destAddr -> addr == destAddr+ handleRemotePacket datagram sourceSockAddr clientSockAddr = do+ let (remoteAddr, remotePort) = fromSockAddr_ sourceSockAddr+ sendUDPRequestTo relaySock 0 remoteAddr remotePort datagram clientSockAddr++recv' :: (Binary b, Connection c) => c -> StateIO b+recv' conn = do+ buffer <- get+ (val, left) <- liftIO $ recvAndDecode conn buffer+ put left+ return val++replyError :: (Connection c) => c -> SomeException -> IO ()+replyError conn e = do+ let rep = case fromException e of+ Just (ioe :: IOException) ->+ if+ | isDoesNotExistError ioe -> HostUnreachable+ | isPermissionError ioe -> ConnectionNotAllowedByRuleset+ | otherwise -> GeneralSOCKSFailure+ _ -> GeneralSOCKSFailure+ putStrLn $ "Replying with error: " ++ show rep+ encodeAndSend conn $ Reply rep (AddressIPv4 "0.0.0.0") 0+ throwIO e
+ Network/SOCKS5/Types.hs view
@@ -0,0 +1,123 @@+-- Types you may want to import.+module Network.SOCKS5.Types+ ( Method (..),+ Address (..),+ fromSockAddr_,+ toSockAddr_,+ )+where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString.Lazy qualified as LB+import Data.IP+import Data.Text.Lazy qualified as LT+import Data.Text.Lazy.Encoding qualified as LTE+import Network.Socket++-- The values currently defined for METHOD are:+-- X'00': NO AUTHENTICATION REQUIRED+-- X'01': GSSAPI+-- X'02': USERNAME/PASSWORD+-- X'03': to X'7F' IANA ASSIGNED+-- X'80': to X'FE' RESERVED FOR PRIVATE METHODS+-- X'FF': NO ACCEPTABLE METHODS++data Method+ = NoAuth+ | GSSAPI+ | UserPass+ | IANAAssigned Word8+ | PrivateMethod Word8+ | NoAcceptableMethods+ | UnknownMethod Word8+ deriving (Eq, Show)++instance Binary Method where+ put :: Method -> Put+ put NoAuth = putWord8 0x00+ put GSSAPI = putWord8 0x01+ put UserPass = putWord8 0x02+ put (IANAAssigned m) = putWord8 m+ put (PrivateMethod m) = putWord8 m+ put NoAcceptableMethods = putWord8 0xFF+ put (UnknownMethod m) = putWord8 m++ get :: Get Method+ get = do+ m <- getWord8+ case m of+ 0x00 -> return NoAuth+ 0x01 -> return GSSAPI+ 0x02 -> return UserPass+ _ | m >= 0x03 && m <= 0x7F -> return $ IANAAssigned m+ _ | m >= 0x80 && m <= 0xFE -> return $ PrivateMethod m+ 0xFF -> return NoAcceptableMethods+ _ -> return $ UnknownMethod m++-- | Address type used for destination addresses in SOCKS5 protocol.+data Address+ = AddressIPv4 IPv4+ | AddressIPv6 IPv6+ | AddressDomain LT.Text+ deriving (Eq)++instance Show Address where+ show :: Address -> String+ show (AddressIPv4 ip) = show ip+ show (AddressIPv6 ip) = show ip+ show (AddressDomain name) = LT.unpack name++instance Binary Address where+ put :: Address -> Put+ put (AddressIPv4 ip) = do+ putWord8 0x01+ putWord32be $ fromIPv4w ip+ put (AddressIPv6 ip) = do+ putWord8 0x04+ let (a1, a2, a3, a4) = fromIPv6w ip+ in mapM_ putWord32be [a1, a2, a3, a4]+ put (AddressDomain name) = do+ putWord8 0x03+ let encodedName = LTE.encodeUtf8 name+ byteLength = LB.length encodedName+ if byteLength > fromIntegral (maxBound :: Word8)+ then+ error $+ "DomainName (UTF-8 encoded) has length of "+ ++ show byteLength+ ++ " bytes. Max allowed is "+ ++ show (maxBound :: Word8)+ else putWord8 $ fromIntegral byteLength+ putLazyByteString encodedName++ get :: Get Address+ get = do+ addrType <- getWord8+ case addrType of+ 0x01 -> do+ AddressIPv4 . toIPv4w <$> getWord32be+ 0x04 -> do+ a1 <- getWord32be+ a2 <- getWord32be+ a3 <- getWord32be+ a4 <- getWord32be+ return $ AddressIPv6 $ toIPv6w (a1, a2, a3, a4)+ 0x03 -> do+ len <- getWord8+ encodedName <- getLazyByteString (fromIntegral len)+ case LTE.decodeUtf8' encodedName of+ Left err -> fail $ "Failed to decode UTF-8 domain name: " ++ show err+ Right name -> return $ AddressDomain name+ _ -> fail $ "Unknown address type: " ++ show addrType++fromSockAddr_ :: SockAddr -> (Address, PortNumber)+fromSockAddr_ (SockAddrInet port host) = (AddressIPv4 (fromHostAddress host), fromIntegral port)+fromSockAddr_ (SockAddrInet6 port _ host _) = (AddressIPv6 (toIPv6w host), fromIntegral port)+fromSockAddr_ path = error $ "Unexpected Unix socket address: " ++ show path++toSockAddr_ :: Address -> PortNumber -> SockAddr+toSockAddr_ (AddressIPv4 host) port = SockAddrInet (fromIntegral port) $ toHostAddress host+toSockAddr_ (AddressIPv6 host) port = SockAddrInet6 (fromIntegral port) 0 (toHostAddress6 host) 0+toSockAddr_ (AddressDomain host) _ = error $ "Address conversion for DomainName not implemented: " ++ show host
+ example/Main.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Char8 as C8+import Network.SOCKS5.Client+import Network.SOCKS5.Types+import Network.Socket.ByteString (recv, sendAll)++main :: IO ()+main = do+ let proxyConfig =+ ClientConfig+ { proxyHost = "127.0.0.1",+ proxyPort = "11451",+ userPass = Nothing+ }+ let destAddr = AddressDomain "example.com"+ let destPort = "80"++ runTCPConnect destAddr destPort proxyConfig $ \sock -> do+ putStrLn "Connected to example.com through SOCKS5 proxy!"+ sendAll sock "GET / HTTP/1.1\r\nHost: example.com\r\nConnection: close\r\n\r\n"+ response <- recv sock 4096+ C8.putStrLn response
+ server/Main.hs view
@@ -0,0 +1,105 @@+import Data.Default+import Data.Text.Lazy qualified as LT+import Network.SOCKS5.Server+import Network.TLS+import Network.TLS.Extra.Cipher+import Options.Applicative++data Args = Args+ { host :: String,+ port :: String,+ useTLS :: Bool,+ cert :: FilePath,+ key :: FilePath,+ userPass :: [String]+ }++argsParser :: Parser Args+argsParser =+ Args+ <$> strOption+ ( long "host"+ <> short 'H'+ <> metavar "HOSTNAME"+ <> value "0.0.0.0"+ <> showDefault+ <> help "The hostname to bind the server to."+ )+ <*> strOption+ ( long "port"+ <> short 'P'+ <> metavar "PORT"+ <> value "1080"+ <> showDefault+ <> help "The port to listen on."+ )+ <*> switch+ ( long "tls"+ <> help "Enable TLS encryption. Requires --cert and --key."+ )+ <*> strOption+ ( long "cert"+ <> metavar "CERT_FILE"+ <> value "cert.pem"+ <> showDefault+ <> help "The TLS certificate file."+ )+ <*> strOption+ ( long "key"+ <> metavar "KEY_FILE"+ <> value "key.pem"+ <> showDefault+ <> help "The TLS private key file."+ )+ <*> many+ ( strOption+ ( long "user-pass"+ <> short 'u'+ <> metavar "USERNAME:PASSWORD"+ <> help "User/password pair for authentication. Can be specified multiple times."+ )+ )++parseUserPass :: String -> (LT.Text, LT.Text)+parseUserPass s = case break (== ':') s of+ (user, ':' : pass) | not (null user) && not (null pass) -> (LT.pack user, LT.pack pass)+ _ -> error $ "Invalid format for user-pass. Expected USERNAME:PASSWORD, but got: " ++ s++main :: IO ()+main = do+ args <-+ execParser $+ info+ (argsParser <**> helper)+ ( fullDesc+ <> progDesc "Run a SOCKS5 proxy server."+ <> header "socks5-server - A simple SOCKS5 proxy"+ )++ let users = map parseUserPass (userPass args)+ let serverConfig =+ ServerConfig+ { serverHost = host args,+ serverPort = port args,+ users = users+ }+ if useTLS args+ then do+ params <- credential (cert args) (key args)+ runSOCKS5ServerTLS serverConfig params+ else runSOCKS5Server serverConfig++credential :: FilePath -> FilePath -> IO ServerParams+credential cert key = do+ cred <- either error id <$> credentialLoadX509 cert key+ return+ (defaultParamsServer :: ServerParams)+ { serverShared =+ def+ { sharedCredentials = Credentials [cred]+ },+ serverSupported =+ def+ { supportedCiphers = ciphersuite_strong+ }+ }
+ socks5.cabal view
@@ -0,0 +1,96 @@+cabal-version: 3.0+name: socks5+version: 0.6.0.0+synopsis: A SOCKS5 (RFC 1928) implementation+description:+ This package provides a library with simple functions to create SOCKS5 clients and servers, along with a standalone server executable.++ It supports all standard SOCKS5 commands (CONNECT, BIND, and UDP ASSOCIATE), Username/Password authentication (RFC 1929), and TLS-secured connections.++license: BSD-3-Clause+license-file: LICENSE+author: Shi Rao+maintainer: github@homovetus.com+category: Network+build-type: Simple+extra-doc-files: CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/homovetus/socks5++common warnings+ ghc-options:+ -Wall+ -threaded++library+ import: warnings+ exposed-modules:+ Network.SOCKS5.Client+ Network.SOCKS5.Internal+ Network.SOCKS5.Server+ Network.SOCKS5.Types++ build-depends:+ async ^>=2.2,+ base >=4.18 && <5,+ binary ^>=0.8,+ bytestring ^>=0.12,+ iproute ^>=1.7,+ mtl ^>=2.3,+ network ^>=3.2,+ network-run ^>=0.4,+ text ^>=2.1,+ tls ^>=2.1,++ default-language: GHC2021++executable socks5+ import: warnings+ main-is: Main.hs+ build-depends:+ base >=4.18 && <5,+ data-default ^>=0.8,+ optparse-applicative ^>=0.19,+ socks5,+ text ^>=2.1,+ tls ^>=2.1,++ hs-source-dirs: server+ default-language: GHC2021++executable socks5-example+ import: warnings+ main-is: Main.hs+ build-depends:+ base ^>=4.18,+ bytestring ^>=0.12,+ network ^>=3.2,+ socks5,++ hs-source-dirs: example+ default-language: Haskell2010++test-suite socks5-test+ import: warnings+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests+ ghc-options:+ -threaded+ -rtsopts+ -with-rtsopts=-N++ build-depends:+ async ^>=2.2,+ base ^>=4.18,+ bytestring ^>=0.12,+ data-default ^>=0.8,+ hspec ^>=2.11,+ network ^>=3.2,+ network-run ^>=0.4,+ socks5,+ tls ^>=2.1,++ default-language: GHC2021
+ tests/Spec.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Concurrent+import Control.Concurrent.Async+import Control.Monad+import Data.Bits+import Data.ByteString qualified as B+import Data.ByteString.Char8 qualified as C8+import Data.Default+import Network.Run.TCP+import Network.SOCKS5.Client+import Network.SOCKS5.Server+import Network.SOCKS5.Types+import Network.Socket+import Network.Socket.ByteString+import Network.TLS+import Network.TLS.Extra.Cipher+import Test.Hspec++main :: IO ()+main = hspec $ do+ aroundAll withSOCKS5Server $ do+ describe "Network.SOCKS5.Client" $ do+ it "should run TCP connect successfully to ipinfo.io" $ \proxyConfig -> do+ let destAddr = AddressDomain "ipinfo.io"+ destPort = "80"+ runTCPConnect destAddr destPort proxyConfig $ \sock -> do+ let request = C8.pack "GET / HTTP/1.1\r\nHost: ipinfo.io\r\nConnection: close\r\n\r\n"+ putStrLn "Sending HTTP GET request..."+ sendAll sock request+ response <- recv sock 4096+ putStrLn "Received HTTP Response (first 4096 bytes):"+ putStrLn "--------------------------"+ C8.putStrLn response+ putStrLn "--------------------------"+ response `shouldSatisfy` (B.length |> (> 0))+ response `shouldSatisfy` ("HTTP/1.1 200 OK" `B.isPrefixOf`)++ it "should run BIND command successfully" $ \proxyConfig -> do+ let destAddr = AddressIPv4 "8.8.8.8"+ destPort = "80"+ runTCPBind+ destAddr+ destPort+ proxyConfig+ ( \boundAddr boundPort -> do+ void $ async $ do+ threadDelay 200000+ putStrLn $ "Third-party connector attempting to connect to " ++ show boundAddr ++ ":" ++ show boundPort+ runTCPClient (show boundAddr) (show boundPort) $ \remoteSock -> do+ putStrLn "Third-party connector: connection successful."+ forever $ sendAll remoteSock "PING"+ )+ ( \_ _ sock -> do+ putStrLn "SOCKS5 client: received connection, waiting for data..."+ ping <- recv sock 4+ putStrLn "SOCKS5 client: received data."+ ping `shouldBe` "PING"+ )++ it "should run UDP associate successfully and perform a DNS query" $ \proxyConfig -> do+ runUDPAssociate proxyConfig $ \sendUDP recvUDP -> do+ let dnsServerAddr = SockAddrInet 53 (tupleToHostAddress (8, 8, 8, 8))+ let dnsQuery =+ B.pack [0x12, 0x34, 0x01, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x67, 0x6f, 0x6f, 0x67, 0x6c, 0x65, 0x03, 0x63, 0x6f, 0x6d, 0x00, 0x00, 0x01, 0x00, 0x01]+ putStrLn $ "Sending DNS query for 'google.com' to " ++ show dnsServerAddr ++ " via proxy..."+ sendUDP dnsQuery dnsServerAddr+ (response, from) <- recvUDP+ putStrLn $ "Received " ++ show (B.length response) ++ " bytes from " ++ show from+ response `shouldSatisfy` (B.length |> (> 0))+ B.take 2 response `shouldBe` B.take 2 dnsQuery+ when (B.length response >= 8) $ do+ let flags = B.unpack $ B.take 2 $ B.drop 2 response+ anCountBytes = B.unpack $ B.take 2 $ B.drop 6 response+ answerCount = (fromIntegral (head anCountBytes) `shiftL` 8) + fromIntegral (last anCountBytes) :: Int+ head flags `shouldSatisfy` (>= 0x80)+ answerCount `shouldSatisfy` (> 0)++ aroundAll withSOCKS5ServerTLS $ do+ describe "Network.SOCKS5.Client" $ do+ it "should run TCP connect successfully to ipinfo.io with TLS" $ \(proxyConfig, clientParams) -> do+ let destAddr = AddressDomain "ipinfo.io"+ destPort = "80"+ runTCPConnectTLS destAddr destPort proxyConfig clientParams $ \ctx -> do+ let request = C8.pack "GET / HTTP/1.1\r\nHost: ipinfo.io\r\nConnection: close\r\n\r\n"+ putStrLn "Sending HTTP GET request..."+ sendData ctx $ C8.fromStrict request+ response <- recvData ctx+ putStrLn "Received HTTP Response:"+ putStrLn "--------------------------"+ C8.putStrLn response+ putStrLn "--------------------------"+ response `shouldSatisfy` (B.length |> (> 0))+ response `shouldSatisfy` ("HTTP/1.1 200 OK" `B.isPrefixOf`)++ it "should run BIND command successfully with TLS" $ \(proxyConfig, clientParams) -> do+ let destAddr = AddressIPv4 "8.8.8.8"+ destPort = "80"+ runTCPBindTLS+ destAddr+ destPort+ proxyConfig+ clientParams+ ( \boundAddr boundPort -> do+ void $ async $ do+ threadDelay 200000+ putStrLn $ "Third-party connector attempting to connect to " ++ show boundAddr ++ ":" ++ show boundPort+ runTCPClient (show boundAddr) (show boundPort) $ \remoteSock -> do+ putStrLn "Third-party connector: connection successful."+ sendAll remoteSock "PING"+ )+ ( \_ _ ctx -> do+ putStrLn "SOCKS5 client: received connection, waiting for data..."+ ping <- recvData ctx+ putStrLn "SOCKS5 client: received data."+ ping `shouldBe` "PING"+ )++ it "should run UDP associate successfully and perform a DNS query with TLS" $ \(proxyConfig, clientParams) -> do+ runUDPAssociateTLS proxyConfig clientParams $ \sendUDP recvUDP -> do+ let dnsServerAddr = SockAddrInet 53 (tupleToHostAddress (8, 8, 8, 8))+ let dnsQuery =+ B.pack [0x12, 0x34, 0x01, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x67, 0x6f, 0x6f, 0x67, 0x6c, 0x65, 0x03, 0x63, 0x6f, 0x6d, 0x00, 0x00, 0x01, 0x00, 0x01]+ putStrLn $ "Sending DNS query for 'google.com' to " ++ show dnsServerAddr ++ " via proxy..."+ sendUDP dnsQuery dnsServerAddr+ (response, from) <- recvUDP+ putStrLn $ "Received " ++ show (B.length response) ++ " bytes from " ++ show from+ response `shouldSatisfy` (B.length |> (> 0))+ B.take 2 response `shouldBe` B.take 2 dnsQuery+ when (B.length response >= 8) $ do+ let flags = B.unpack $ B.take 2 $ B.drop 2 response+ anCountBytes = B.unpack $ B.take 2 $ B.drop 6 response+ answerCount = (fromIntegral (head anCountBytes) `shiftL` 8) + fromIntegral (last anCountBytes) :: Int+ head flags `shouldSatisfy` (>= 0x80)+ answerCount `shouldSatisfy` (> 0)++withSOCKS5Server :: (ClientConfig -> IO a) -> IO a+withSOCKS5Server action = do+ let serverConfig =+ ServerConfig+ { serverHost = "0.0.0.0",+ serverPort = "10800",+ users = [("testuser", "testpass")]+ }+ withAsync (runSOCKS5Server serverConfig) $ \_ -> do+ threadDelay 200000+ putStrLn "SOCKS5 server started. Running tests..."+ result <- action $ ClientConfig "127.0.0.1" "10800" (Just ("testuser", "testpass"))+ putStrLn "Tests finished. Stopping SOCKS5 server..."+ return result++withSOCKS5ServerTLS :: ((ClientConfig, ClientParams) -> IO a) -> IO a+withSOCKS5ServerTLS action = do+ let serverConfig =+ ServerConfig+ { serverHost = "0.0.0.0",+ serverPort = "10800",+ users = [("testuser", "testpass")]+ }+ serverParams <- credential "tests/cert.pem" "tests/key.pem"+ withAsync (runSOCKS5ServerTLS serverConfig serverParams) $ \_ -> do+ threadDelay 200000+ putStrLn "SOCKS5 TLS server started. Running tests..."+ let clientConfig = ClientConfig "127.0.0.1" "10800" (Just ("testuser", "testpass"))+ let clientParams =+ (defaultParamsClient "127.0.0.1" "")+ { clientSupported =+ def+ { supportedCiphers = ciphersuite_strong+ },+ clientShared =+ def+ { sharedValidationCache = ValidationCache (\_ _ _ -> return ValidationCachePass) (\_ _ _ -> return ())+ }+ }+ result <- action (clientConfig, clientParams)+ putStrLn "Tests finished. Stopping SOCKS5 TLS server..."+ return result++credential :: FilePath -> FilePath -> IO ServerParams+credential cert key = do+ cred <- either error id <$> credentialLoadX509 cert key+ return+ (defaultParamsServer :: ServerParams)+ { serverShared =+ def+ { sharedCredentials = Credentials [cred]+ },+ serverSupported =+ def+ { supportedCiphers = ciphersuite_strong+ }+ }++(|>) :: (a -> b) -> (b -> Bool) -> a -> Bool+f |> p = p . f