{- |
Module      : Network.Socks5
License     : BSD-style
Copyright   : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

This is an implementation of the SOCKS Protocol Version 5 as defined in
[RFC 1928](https://datatracker.ietf.org/doc/html/rfc1928).

In Wikipedia's words:

  SOCKS is an Internet protocol that exchanges network packets between a client
  and server through a proxy server. SOCKS5 optionally provides authentication
  so only authorized users may access a server. Practically, a SOCKS server
  proxies TCP connections to an arbitrary IP address, and provides a means for
  UDP packets to be forwarded. A SOCKS server accepts incoming client connection
  on TCP port 1080.

BIND and UDP ASSOCIATE messages are not implemented. However the main usage of
SOCKS is implemented.
-}

module Network.Socks5
  ( -- * Types

    SocksAddress (..)
  , SocksHostAddress (..)
  , SocksReply (..)
  , SocksError (..)
    -- * Configuration

  , SocksConf (..)
  , socksHost
  , defaultSocksConf
  , defaultSocksConfFromSockAddr
    -- * Methods

  , socksConnectWithSocket
  , socksConnect
    -- * Variants

  , socksConnectName
  ) where

import           Control.Exception ( bracketOnError )
import           Control.Monad ( when )
import           Data.ByteString.Char8  ( pack )
import           Network.Socket
                   ( close, Socket, SocketType(..), Family(..), socket, connect
                   , PortNumber, defaultProtocol
                   )
import           Network.Socks5.Command ( Connect (..), establish, rpc_ )
import           Network.Socks5.Conf
                   ( SocksConf (..), defaultSocksConf
                   , defaultSocksConfFromSockAddr, socksHost
                   )
import           Network.Socks5.Types
                   ( SocksAddress (..), SocksError (..), SocksHostAddress (..)
                   , SocksMethod (..), SocksReply (..)
                   )

-- | Connect a user-specified new socket on the SOCKS server to a destination.

--

-- The specified socket needs to be connected to the SOCKS server already.

--

-- |socket|-----sockServer----->|server|----destAddr----->|destination|

--

socksConnectWithSocket ::
     Socket       -- ^ The socket to use.

  -> SocksConf    -- ^ The SOCKS configuration for the server.

  -> SocksAddress -- ^ The SOCKS address to connect to.

  -> IO (SocksHostAddress, PortNumber)
socksConnectWithSocket :: Socket
-> SocksConf -> SocksAddress -> IO (SocksHostAddress, PortNumber)
socksConnectWithSocket Socket
sock SocksConf
serverConf SocksAddress
destAddr = do
  SocksMethod
r <- SocksVersion -> Socket -> [SocksMethod] -> IO SocksMethod
establish (SocksConf -> SocksVersion
socksVersion SocksConf
serverConf) Socket
sock [SocksMethod
SocksMethodNone]
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SocksMethod
r SocksMethod -> SocksMethod -> Bool
forall a. Eq a => a -> a -> Bool
== SocksMethod
SocksMethodNotAcceptable) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot connect with no socks method of authentication"
  Socket -> Connect -> IO (SocksHostAddress, PortNumber)
forall a.
Command a =>
Socket -> a -> IO (SocksHostAddress, PortNumber)
rpc_ Socket
sock (SocksAddress -> Connect
Connect SocksAddress
destAddr)

-- | Connect a new socket to a SOCKS server and connect the stream on the

-- server side to the specified SOCKS address.

socksConnect ::
     SocksConf
     -- ^ The SOCKS configuration for the server.

  -> SocksAddress
     -- ^ The SOCKS address to connect to.

  -> IO (Socket, (SocksHostAddress, PortNumber))
socksConnect :: SocksConf
-> SocksAddress -> IO (Socket, (SocksHostAddress, PortNumber))
socksConnect SocksConf
serverConf SocksAddress
destAddr =
  IO Socket
-> (Socket -> IO ())
-> (Socket -> IO (Socket, (SocksHostAddress, PortNumber)))
-> IO (Socket, (SocksHostAddress, PortNumber))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET SocketType
Stream ProtocolNumber
defaultProtocol) Socket -> IO ()
close ((Socket -> IO (Socket, (SocksHostAddress, PortNumber)))
 -> IO (Socket, (SocksHostAddress, PortNumber)))
-> (Socket -> IO (Socket, (SocksHostAddress, PortNumber)))
-> IO (Socket, (SocksHostAddress, PortNumber))
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
    Socket -> SockAddr -> IO ()
connect Socket
sock (SocksConf -> SockAddr
socksServer SocksConf
serverConf)
    (SocksHostAddress, PortNumber)
ret <- Socket
-> SocksConf -> SocksAddress -> IO (SocksHostAddress, PortNumber)
socksConnectWithSocket Socket
sock SocksConf
serverConf SocksAddress
destAddr
    (Socket, (SocksHostAddress, PortNumber))
-> IO (Socket, (SocksHostAddress, PortNumber))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, (SocksHostAddress, PortNumber)
ret)

-- | Connect a new socket to the SOCKS server, and connect the stream to a

-- fully-qualified domain name (FQDN) resolved on the server side.

socksConnectName ::
     Socket
     -- ^ The socket to use. The socket must *not* be connected already.

  -> SocksConf
     -- ^ The SOCKS configuration for the server.

  -> String
     -- ^ Destination FQDN. Should comprise only ASCII characters, otherwise

     -- unexpected behaviour will ensure. For FQDN including other Unicode code

     -- points, Punycode encoding should be used.

  -> PortNumber
     -- ^ The port number to use.

  -> IO ()
socksConnectName :: Socket -> SocksConf -> [Char] -> PortNumber -> IO ()
socksConnectName Socket
sock SocksConf
sockConf [Char]
destination PortNumber
port = do
  Socket -> SockAddr -> IO ()
connect Socket
sock (SocksConf -> SockAddr
socksServer SocksConf
sockConf)
  (SocksHostAddress
_, PortNumber
_) <- Socket
-> SocksConf -> SocksAddress -> IO (SocksHostAddress, PortNumber)
socksConnectWithSocket Socket
sock SocksConf
sockConf SocksAddress
addr
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  addr :: SocksAddress
addr = SocksHostAddress -> PortNumber -> SocksAddress
SocksAddress (SocksFQDN -> SocksHostAddress
SocksAddrDomainName (SocksFQDN -> SocksHostAddress) -> SocksFQDN -> SocksHostAddress
forall a b. (a -> b) -> a -> b
$ [Char] -> SocksFQDN
pack [Char]
destination) PortNumber
port