{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ViewPatterns #-}
-- |
-- Module      : Network.Socks5
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- This is an implementation of SOCKS5 as defined in RFC 1928
--
-- In Wikipedia's words:
--
--   SOCKet Secure (SOCKS) is an Internet protocol that routes network packets
--   between a client and server through a proxy server. SOCKS5 additionally
--   provides authentication so only authorized users may access a server.
--   Practically, a SOCKS server will proxy TCP connections to an arbitrary IP
--   address as well as providing a means for UDP packets to be forwarded.
--
-- BIND and UDP ASSOCIATE messages are not implemented.
-- However main usage of SOCKS is covered in this implementation.
--
module Network.Socks5
    (
    -- * Types
      SocksAddress(..)
    , SocksHostAddress(..)
    , SocksReply(..)
    , SocksError(..)
    -- * Configuration
    , module Network.Socks5.Conf
    -- * Methods
    , socksConnectWithSocket
    , socksConnect
    -- * Variants
    , socksConnectName
    ) where

import Control.Monad
import Control.Exception
import qualified Data.ByteString.Char8 as BC
import Network.Socket ( close, Socket, SocketType(..), Family(..)
                      , socket, connect, PortNumber, defaultProtocol)

import qualified Network.Socks5.Command as Cmd
import Network.Socks5.Conf
import Network.Socks5.Types
import Network.Socks5.Lowlevel

-- | connect a user specified new socket on the socks server to a destination
--
-- The socket in parameter needs to be already connected to the socks server
--
-- |socket|-----sockServer----->|server|----destAddr----->|destination|
--
socksConnectWithSocket :: Socket       -- ^ Socket to use.
                       -> SocksConf    -- ^ SOCKS configuration for the server.
                       -> SocksAddress -- ^ 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
Cmd.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)
Cmd.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 'SocksAddress' specified.
socksConnect :: SocksConf    -- ^ SOCKS configuration for the server.
             -> SocksAddress -- ^ 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 FQDN
-- resolved on the server side.
--
-- The socket needs to *not* be already connected.
--
-- The destination need to be an ASCII string, otherwise unexpected behavior will ensue.
-- For unicode destination, punycode encoding should be used.
socksConnectName :: Socket -> SocksConf -> String -> PortNumber -> 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 (FQDN -> SocksHostAddress
SocksAddrDomainName (FQDN -> SocksHostAddress) -> FQDN -> SocksHostAddress
forall a b. (a -> b) -> a -> b
$ [Char] -> FQDN
BC.pack [Char]
destination) PortNumber
port