{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module      : Network.Socks5.Wire
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
module Network.Socks5.Wire
    ( SocksHello(..)
    , SocksHelloResponse(..)
    , SocksRequest(..)
    , SocksResponse(..)
    ) where

import Basement.Compat.Base
import Control.Monad
import qualified Data.ByteString as B
import Data.Serialize
import qualified Prelude

import Network.Socket (PortNumber)

import Network.Socks5.Types

-- | Initial message sent by client with the list of authentification methods supported
data SocksHello = SocksHello { SocksHello -> [SocksMethod]
getSocksHelloMethods :: [SocksMethod] }
    deriving (Int -> SocksHello -> ShowS
[SocksHello] -> ShowS
SocksHello -> String
(Int -> SocksHello -> ShowS)
-> (SocksHello -> String)
-> ([SocksHello] -> ShowS)
-> Show SocksHello
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocksHello -> ShowS
showsPrec :: Int -> SocksHello -> ShowS
$cshow :: SocksHello -> String
show :: SocksHello -> String
$cshowList :: [SocksHello] -> ShowS
showList :: [SocksHello] -> ShowS
Show,SocksHello -> SocksHello -> Bool
(SocksHello -> SocksHello -> Bool)
-> (SocksHello -> SocksHello -> Bool) -> Eq SocksHello
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocksHello -> SocksHello -> Bool
== :: SocksHello -> SocksHello -> Bool
$c/= :: SocksHello -> SocksHello -> Bool
/= :: SocksHello -> SocksHello -> Bool
Eq)

-- | Initial message send by server in return from Hello, with the
-- server chosen method of authentication
data SocksHelloResponse = SocksHelloResponse { SocksHelloResponse -> SocksMethod
getSocksHelloResponseMethod :: SocksMethod }
    deriving (Int -> SocksHelloResponse -> ShowS
[SocksHelloResponse] -> ShowS
SocksHelloResponse -> String
(Int -> SocksHelloResponse -> ShowS)
-> (SocksHelloResponse -> String)
-> ([SocksHelloResponse] -> ShowS)
-> Show SocksHelloResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocksHelloResponse -> ShowS
showsPrec :: Int -> SocksHelloResponse -> ShowS
$cshow :: SocksHelloResponse -> String
show :: SocksHelloResponse -> String
$cshowList :: [SocksHelloResponse] -> ShowS
showList :: [SocksHelloResponse] -> ShowS
Show,SocksHelloResponse -> SocksHelloResponse -> Bool
(SocksHelloResponse -> SocksHelloResponse -> Bool)
-> (SocksHelloResponse -> SocksHelloResponse -> Bool)
-> Eq SocksHelloResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocksHelloResponse -> SocksHelloResponse -> Bool
== :: SocksHelloResponse -> SocksHelloResponse -> Bool
$c/= :: SocksHelloResponse -> SocksHelloResponse -> Bool
/= :: SocksHelloResponse -> SocksHelloResponse -> Bool
Eq)

-- | Define a SOCKS requests
data SocksRequest = SocksRequest
    { SocksRequest -> SocksCommand
requestCommand  :: SocksCommand
    , SocksRequest -> SocksHostAddress
requestDstAddr  :: SocksHostAddress
    , SocksRequest -> PortNumber
requestDstPort  :: PortNumber
    } deriving (Int -> SocksRequest -> ShowS
[SocksRequest] -> ShowS
SocksRequest -> String
(Int -> SocksRequest -> ShowS)
-> (SocksRequest -> String)
-> ([SocksRequest] -> ShowS)
-> Show SocksRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocksRequest -> ShowS
showsPrec :: Int -> SocksRequest -> ShowS
$cshow :: SocksRequest -> String
show :: SocksRequest -> String
$cshowList :: [SocksRequest] -> ShowS
showList :: [SocksRequest] -> ShowS
Show,SocksRequest -> SocksRequest -> Bool
(SocksRequest -> SocksRequest -> Bool)
-> (SocksRequest -> SocksRequest -> Bool) -> Eq SocksRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocksRequest -> SocksRequest -> Bool
== :: SocksRequest -> SocksRequest -> Bool
$c/= :: SocksRequest -> SocksRequest -> Bool
/= :: SocksRequest -> SocksRequest -> Bool
Eq)

-- | Define a SOCKS response
data SocksResponse = SocksResponse
    { SocksResponse -> SocksReply
responseReply    :: SocksReply
    , SocksResponse -> SocksHostAddress
responseBindAddr :: SocksHostAddress
    , SocksResponse -> PortNumber
responseBindPort :: PortNumber
    } deriving (Int -> SocksResponse -> ShowS
[SocksResponse] -> ShowS
SocksResponse -> String
(Int -> SocksResponse -> ShowS)
-> (SocksResponse -> String)
-> ([SocksResponse] -> ShowS)
-> Show SocksResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocksResponse -> ShowS
showsPrec :: Int -> SocksResponse -> ShowS
$cshow :: SocksResponse -> String
show :: SocksResponse -> String
$cshowList :: [SocksResponse] -> ShowS
showList :: [SocksResponse] -> ShowS
Show,SocksResponse -> SocksResponse -> Bool
(SocksResponse -> SocksResponse -> Bool)
-> (SocksResponse -> SocksResponse -> Bool) -> Eq SocksResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocksResponse -> SocksResponse -> Bool
== :: SocksResponse -> SocksResponse -> Bool
$c/= :: SocksResponse -> SocksResponse -> Bool
/= :: SocksResponse -> SocksResponse -> Bool
Eq)

getAddr :: a -> Get SocksHostAddress
getAddr a
1 = HostAddress -> SocksHostAddress
SocksAddrIPV4 (HostAddress -> SocksHostAddress)
-> Get HostAddress -> Get SocksHostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HostAddress
getWord32host
getAddr a
3 = FQDN -> SocksHostAddress
SocksAddrDomainName (FQDN -> SocksHostAddress) -> Get FQDN -> Get SocksHostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getLength8 Get Int -> (Int -> Get FQDN) -> Get FQDN
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get FQDN
getByteString)
getAddr a
4 = HostAddress6 -> SocksHostAddress
SocksAddrIPV6 (HostAddress6 -> SocksHostAddress)
-> Get HostAddress6 -> Get SocksHostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HostAddress
 -> HostAddress -> HostAddress -> HostAddress -> HostAddress6)
-> Get HostAddress
-> Get HostAddress
-> Get HostAddress
-> Get HostAddress
-> Get HostAddress6
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) Get HostAddress
getWord32host Get HostAddress
getWord32host Get HostAddress
getWord32host Get HostAddress
getWord32host)
getAddr a
n = String -> Get SocksHostAddress
forall a. HasCallStack => String -> a
error (String
"cannot get unknown socket address type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n)

putAddr :: SocksHostAddress -> PutM ()
putAddr (SocksAddrIPV4 HostAddress
h)         = Putter Word8
putWord8 Word8
1 PutM () -> PutM () -> PutM ()
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter HostAddress
putWord32host HostAddress
h
putAddr (SocksAddrDomainName FQDN
b)   = Putter Word8
putWord8 Word8
3 PutM () -> PutM () -> PutM ()
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PutM ()
putLength8 (FQDN -> Int
B.length FQDN
b) PutM () -> PutM () -> PutM ()
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter FQDN
putByteString FQDN
b
putAddr (SocksAddrIPV6 (HostAddress
a,HostAddress
b,HostAddress
c,HostAddress
d)) = Putter Word8
putWord8 Word8
4 PutM () -> PutM () -> PutM ()
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter HostAddress -> [HostAddress] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Putter HostAddress
putWord32host [HostAddress
a,HostAddress
b,HostAddress
c,HostAddress
d]

putEnum8 :: Enum e => e -> Put
putEnum8 :: forall e. Enum e => e -> PutM ()
putEnum8 = Putter Word8
putWord8 Putter Word8 -> (e -> Word8) -> e -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Int -> Word8) -> (e -> Int) -> e -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> Int
forall a. Enum a => a -> Int
fromEnum

getEnum8 :: Enum e => Get e
getEnum8 :: forall e. Enum e => Get e
getEnum8 = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> (Word8 -> Int) -> Word8 -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Word8 -> e) -> Get Word8 -> Get e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

putLength8 :: Int -> Put
putLength8 :: Int -> PutM ()
putLength8 = Putter Word8
putWord8 Putter Word8 -> (Int -> Word8) -> Int -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral

getLength8 :: Get Int
getLength8 :: Get Int
getLength8 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

getSocksRequest :: a -> Get SocksRequest
getSocksRequest a
5 = do
    SocksCommand
cmd <- Get SocksCommand
forall e. Enum e => Get e
getEnum8
    Word8
_   <- Get Word8
getWord8
    SocksHostAddress
addr <- Get Word8
getWord8 Get Word8
-> (Word8 -> Get SocksHostAddress) -> Get SocksHostAddress
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get SocksHostAddress
forall {a}. (Eq a, Num a, Show a) => a -> Get SocksHostAddress
getAddr
    PortNumber
port <- Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Word16 -> PortNumber) -> Get Word16 -> Get PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
    SocksRequest -> Get SocksRequest
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SocksRequest -> Get SocksRequest)
-> SocksRequest -> Get SocksRequest
forall a b. (a -> b) -> a -> b
$ SocksCommand -> SocksHostAddress -> PortNumber -> SocksRequest
SocksRequest SocksCommand
cmd SocksHostAddress
addr PortNumber
port
getSocksRequest a
v =
    String -> Get SocksRequest
forall a. HasCallStack => String -> a
error (String
"unsupported version of the protocol " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
v)

getSocksResponse :: a -> Get SocksResponse
getSocksResponse a
5 = do
    SocksReply
reply <- Get SocksReply
forall e. Enum e => Get e
getEnum8
    Word8
_     <- Get Word8
getWord8
    SocksHostAddress
addr <- Get Word8
getWord8 Get Word8
-> (Word8 -> Get SocksHostAddress) -> Get SocksHostAddress
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get SocksHostAddress
forall {a}. (Eq a, Num a, Show a) => a -> Get SocksHostAddress
getAddr
    PortNumber
port <- Word16 -> PortNumber
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (Word16 -> PortNumber) -> Get Word16 -> Get PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
    SocksResponse -> Get SocksResponse
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (SocksResponse -> Get SocksResponse)
-> SocksResponse -> Get SocksResponse
forall a b. (a -> b) -> a -> b
$ SocksReply -> SocksHostAddress -> PortNumber -> SocksResponse
SocksResponse SocksReply
reply SocksHostAddress
addr PortNumber
port
getSocksResponse a
v =
    String -> Get SocksResponse
forall a. HasCallStack => String -> a
error (String
"unsupported version of the protocol " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
v)

instance Serialize SocksHello where
    put :: Putter SocksHello
put (SocksHello [SocksMethod]
ms) = do
        Putter Word8
putWord8 Word8
5
        Int -> PutM ()
putLength8 ([SocksMethod] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [SocksMethod]
ms)
        (SocksMethod -> PutM ()) -> [SocksMethod] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SocksMethod -> PutM ()
forall e. Enum e => e -> PutM ()
putEnum8 [SocksMethod]
ms
    get :: Get SocksHello
get = do
        Word8
v <- Get Word8
getWord8
        case Word8
v of
            Word8
5 -> [SocksMethod] -> SocksHello
SocksHello ([SocksMethod] -> SocksHello)
-> Get [SocksMethod] -> Get SocksHello
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getLength8 Get Int -> (Int -> Get [SocksMethod]) -> Get [SocksMethod]
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Get SocksMethod -> Get [SocksMethod])
-> Get SocksMethod -> Int -> Get [SocksMethod]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Get SocksMethod -> Get [SocksMethod]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Get SocksMethod
forall e. Enum e => Get e
getEnum8)
            Word8
_ -> String -> Get SocksHello
forall a. HasCallStack => String -> a
error String
"unsupported sock hello version"

instance Serialize SocksHelloResponse where
    put :: Putter SocksHelloResponse
put (SocksHelloResponse SocksMethod
m) = Putter Word8
putWord8 Word8
5 PutM () -> PutM () -> PutM ()
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SocksMethod -> PutM ()
forall e. Enum e => e -> PutM ()
putEnum8 SocksMethod
m
    get :: Get SocksHelloResponse
get = do
        Word8
v <- Get Word8
getWord8
        case Word8
v of
            Word8
5 -> SocksMethod -> SocksHelloResponse
SocksHelloResponse (SocksMethod -> SocksHelloResponse)
-> Get SocksMethod -> Get SocksHelloResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SocksMethod
forall e. Enum e => Get e
getEnum8
            Word8
_ -> String -> Get SocksHelloResponse
forall a. HasCallStack => String -> a
error String
"unsupported sock hello response version"

instance Serialize SocksRequest where
    put :: Putter SocksRequest
put SocksRequest
req = do
        Putter Word8
putWord8 Word8
5
        SocksCommand -> PutM ()
forall e. Enum e => e -> PutM ()
putEnum8 (SocksCommand -> PutM ()) -> SocksCommand -> PutM ()
forall a b. (a -> b) -> a -> b
$ SocksRequest -> SocksCommand
requestCommand SocksRequest
req
        Putter Word8
putWord8 Word8
0
        SocksHostAddress -> PutM ()
putAddr (SocksHostAddress -> PutM ()) -> SocksHostAddress -> PutM ()
forall a b. (a -> b) -> a -> b
$ SocksRequest -> SocksHostAddress
requestDstAddr SocksRequest
req
        Putter Word16
putWord16be Putter Word16 -> Putter Word16
forall a b. (a -> b) -> a -> b
$ PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (PortNumber -> Word16) -> PortNumber -> Word16
forall a b. (a -> b) -> a -> b
$ SocksRequest -> PortNumber
requestDstPort SocksRequest
req
        
    get :: Get SocksRequest
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get SocksRequest) -> Get SocksRequest
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get SocksRequest
forall {a}. (Eq a, Num a, Show a) => a -> Get SocksRequest
getSocksRequest

instance Serialize SocksResponse where
    put :: Putter SocksResponse
put SocksResponse
req = do
        Putter Word8
putWord8 Word8
5
        SocksReply -> PutM ()
forall e. Enum e => e -> PutM ()
putEnum8 (SocksReply -> PutM ()) -> SocksReply -> PutM ()
forall a b. (a -> b) -> a -> b
$ SocksResponse -> SocksReply
responseReply SocksResponse
req
        Putter Word8
putWord8 Word8
0
        SocksHostAddress -> PutM ()
putAddr (SocksHostAddress -> PutM ()) -> SocksHostAddress -> PutM ()
forall a b. (a -> b) -> a -> b
$ SocksResponse -> SocksHostAddress
responseBindAddr SocksResponse
req
        Putter Word16
putWord16be Putter Word16 -> Putter Word16
forall a b. (a -> b) -> a -> b
$ PortNumber -> Word16
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (PortNumber -> Word16) -> PortNumber -> Word16
forall a b. (a -> b) -> a -> b
$ SocksResponse -> PortNumber
responseBindPort SocksResponse
req
    get :: Get SocksResponse
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get SocksResponse) -> Get SocksResponse
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get SocksResponse
forall {a}. (Eq a, Num a, Show a) => a -> Get SocksResponse
getSocksResponse