{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
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
data SocksHello = SocksHello { SocksHello -> [SocksMethod]
getSocksHelloMethods :: [SocksMethod] }
deriving (Int -> SocksHello -> ShowS
[SocksHello] -> ShowS
SocksHello -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocksHello] -> ShowS
$cshowList :: [SocksHello] -> ShowS
show :: SocksHello -> String
$cshow :: SocksHello -> String
showsPrec :: Int -> SocksHello -> ShowS
$cshowsPrec :: Int -> SocksHello -> ShowS
Show,SocksHello -> SocksHello -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocksHello -> SocksHello -> Bool
$c/= :: SocksHello -> SocksHello -> Bool
== :: SocksHello -> SocksHello -> Bool
$c== :: SocksHello -> SocksHello -> Bool
Eq)
data SocksHelloResponse = SocksHelloResponse { SocksHelloResponse -> SocksMethod
getSocksHelloResponseMethod :: SocksMethod }
deriving (Int -> SocksHelloResponse -> ShowS
[SocksHelloResponse] -> ShowS
SocksHelloResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocksHelloResponse] -> ShowS
$cshowList :: [SocksHelloResponse] -> ShowS
show :: SocksHelloResponse -> String
$cshow :: SocksHelloResponse -> String
showsPrec :: Int -> SocksHelloResponse -> ShowS
$cshowsPrec :: Int -> SocksHelloResponse -> ShowS
Show,SocksHelloResponse -> SocksHelloResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocksHelloResponse -> SocksHelloResponse -> Bool
$c/= :: SocksHelloResponse -> SocksHelloResponse -> Bool
== :: SocksHelloResponse -> SocksHelloResponse -> Bool
$c== :: SocksHelloResponse -> SocksHelloResponse -> Bool
Eq)
data SocksRequest = SocksRequest
{ SocksRequest -> SocksCommand
requestCommand :: SocksCommand
, SocksRequest -> SocksHostAddress
requestDstAddr :: SocksHostAddress
, SocksRequest -> PortNumber
requestDstPort :: PortNumber
} deriving (Int -> SocksRequest -> ShowS
[SocksRequest] -> ShowS
SocksRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocksRequest] -> ShowS
$cshowList :: [SocksRequest] -> ShowS
show :: SocksRequest -> String
$cshow :: SocksRequest -> String
showsPrec :: Int -> SocksRequest -> ShowS
$cshowsPrec :: Int -> SocksRequest -> ShowS
Show,SocksRequest -> SocksRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocksRequest -> SocksRequest -> Bool
$c/= :: SocksRequest -> SocksRequest -> Bool
== :: SocksRequest -> SocksRequest -> Bool
$c== :: SocksRequest -> SocksRequest -> Bool
Eq)
data SocksResponse = SocksResponse
{ SocksResponse -> SocksReply
responseReply :: SocksReply
, SocksResponse -> SocksHostAddress
responseBindAddr :: SocksHostAddress
, SocksResponse -> PortNumber
responseBindPort :: PortNumber
} deriving (Int -> SocksResponse -> ShowS
[SocksResponse] -> ShowS
SocksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SocksResponse] -> ShowS
$cshowList :: [SocksResponse] -> ShowS
show :: SocksResponse -> String
$cshow :: SocksResponse -> String
showsPrec :: Int -> SocksResponse -> ShowS
$cshowsPrec :: Int -> SocksResponse -> ShowS
Show,SocksResponse -> SocksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocksResponse -> SocksResponse -> Bool
$c/= :: SocksResponse -> SocksResponse -> Bool
== :: SocksResponse -> SocksResponse -> Bool
$c== :: SocksResponse -> SocksResponse -> Bool
Eq)
getAddr :: a -> Get SocksHostAddress
getAddr a
1 = HostAddress -> SocksHostAddress
SocksAddrIPV4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HostAddress
getWord32host
getAddr a
3 = FQDN -> SocksHostAddress
SocksAddrDomainName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getLength8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get FQDN
getByteString)
getAddr a
4 = HostAddress6 -> SocksHostAddress
SocksAddrIPV6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 = forall a. HasCallStack => String -> a
error (String
"cannot get unknown socket address type: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n)
putAddr :: SocksHostAddress -> PutM ()
putAddr (SocksAddrIPV4 HostAddress
h) = Putter Word8
putWord8 Word8
1 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> PutM ()
putLength8 (FQDN -> Int
B.length FQDN
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Enum a => a -> Int
fromEnum
getEnum8 :: Enum e => Get e
getEnum8 :: forall e. Enum e => Get e
getEnum8 = forall a. Enum a => Int -> a
toEnum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
getLength8 :: Get Int
getLength8 :: Get Int
getLength8 = forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral 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 <- forall e. Enum e => Get e
getEnum8
Word8
_ <- Get Word8
getWord8
SocksHostAddress
addr <- Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (Eq a, Num a, Show a) => a -> Get SocksHostAddress
getAddr
PortNumber
port <- forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SocksCommand -> SocksHostAddress -> PortNumber -> SocksRequest
SocksRequest SocksCommand
cmd SocksHostAddress
addr PortNumber
port
getSocksRequest a
v =
forall a. HasCallStack => String -> a
error (String
"unsupported version of the protocol " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
v)
getSocksResponse :: a -> Get SocksResponse
getSocksResponse a
5 = do
SocksReply
reply <- forall e. Enum e => Get e
getEnum8
Word8
_ <- Get Word8
getWord8
SocksHostAddress
addr <- Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (Eq a, Num a, Show a) => a -> Get SocksHostAddress
getAddr
PortNumber
port <- forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SocksReply -> SocksHostAddress -> PortNumber -> SocksResponse
SocksResponse SocksReply
reply SocksHostAddress
addr PortNumber
port
getSocksResponse a
v =
forall a. HasCallStack => String -> a
error (String
"unsupported version of the protocol " forall a. Semigroup a => a -> a -> a
<> 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 (forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [SocksMethod]
ms)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int
getLength8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM forall e. Enum e => Get e
getEnum8)
Word8
_ -> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Enum e => Get e
getEnum8
Word8
_ -> 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
forall e. Enum e => e -> PutM ()
putEnum8 forall a b. (a -> b) -> a -> b
$ SocksRequest -> SocksCommand
requestCommand SocksRequest
req
Putter Word8
putWord8 Word8
0
SocksHostAddress -> PutM ()
putAddr forall a b. (a -> b) -> a -> b
$ SocksRequest -> SocksHostAddress
requestDstAddr SocksRequest
req
Putter Word16
putWord16be forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall a b. (a -> b) -> a -> b
$ SocksRequest -> PortNumber
requestDstPort SocksRequest
req
get :: Get SocksRequest
get = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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
forall e. Enum e => e -> PutM ()
putEnum8 forall a b. (a -> b) -> a -> b
$ SocksResponse -> SocksReply
responseReply SocksResponse
req
Putter Word8
putWord8 Word8
0
SocksHostAddress -> PutM ()
putAddr forall a b. (a -> b) -> a -> b
$ SocksResponse -> SocksHostAddress
responseBindAddr SocksResponse
req
Putter Word16
putWord16be forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral forall a b. (a -> b) -> a -> b
$ SocksResponse -> PortNumber
responseBindPort SocksResponse
req
get :: Get SocksResponse
get = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. (Eq a, Num a, Show a) => a -> Get SocksResponse
getSocksResponse