{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
module Socks5 where
import ClassyPrelude
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString as BC
import qualified Data.ByteString.Char8 as BC8
import Data.Either
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Network.Socket (HostAddress, HostName, PortNumber)
import Numeric (showHex)
import Control.Monad.Except (MonadError)
import qualified Data.Streaming.Network as N
socksVersion :: Word8
socksVersion :: Word8
socksVersion = Word8
0x05
data AuthMethod = NoAuth
| GSSAPI
| Login
| Reserved
| NotAllowed
deriving (Int -> AuthMethod -> ShowS
[AuthMethod] -> ShowS
AuthMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthMethod] -> ShowS
$cshowList :: [AuthMethod] -> ShowS
show :: AuthMethod -> String
$cshow :: AuthMethod -> String
showsPrec :: Int -> AuthMethod -> ShowS
$cshowsPrec :: Int -> AuthMethod -> ShowS
Show, ReadPrec [AuthMethod]
ReadPrec AuthMethod
Int -> ReadS AuthMethod
ReadS [AuthMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthMethod]
$creadListPrec :: ReadPrec [AuthMethod]
readPrec :: ReadPrec AuthMethod
$creadPrec :: ReadPrec AuthMethod
readList :: ReadS [AuthMethod]
$creadList :: ReadS [AuthMethod]
readsPrec :: Int -> ReadS AuthMethod
$creadsPrec :: Int -> ReadS AuthMethod
Read)
data RequestAuth = RequestAuth
{ RequestAuth -> Int
version :: Int
, RequestAuth -> Vector AuthMethod
methods :: Vector AuthMethod
} deriving (Int -> RequestAuth -> ShowS
[RequestAuth] -> ShowS
RequestAuth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestAuth] -> ShowS
$cshowList :: [RequestAuth] -> ShowS
show :: RequestAuth -> String
$cshow :: RequestAuth -> String
showsPrec :: Int -> RequestAuth -> ShowS
$cshowsPrec :: Int -> RequestAuth -> ShowS
Show, ReadPrec [RequestAuth]
ReadPrec RequestAuth
Int -> ReadS RequestAuth
ReadS [RequestAuth]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestAuth]
$creadListPrec :: ReadPrec [RequestAuth]
readPrec :: ReadPrec RequestAuth
$creadPrec :: ReadPrec RequestAuth
readList :: ReadS [RequestAuth]
$creadList :: ReadS [RequestAuth]
readsPrec :: Int -> ReadS RequestAuth
$creadsPrec :: Int -> ReadS RequestAuth
Read)
data ResponseAuth = ResponseAuth
{ ResponseAuth -> Int
version :: Int
, ResponseAuth -> AuthMethod
method :: AuthMethod
} deriving (Int -> ResponseAuth -> ShowS
[ResponseAuth] -> ShowS
ResponseAuth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseAuth] -> ShowS
$cshowList :: [ResponseAuth] -> ShowS
show :: ResponseAuth -> String
$cshow :: ResponseAuth -> String
showsPrec :: Int -> ResponseAuth -> ShowS
$cshowsPrec :: Int -> ResponseAuth -> ShowS
Show, ReadPrec [ResponseAuth]
ReadPrec ResponseAuth
Int -> ReadS ResponseAuth
ReadS [ResponseAuth]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResponseAuth]
$creadListPrec :: ReadPrec [ResponseAuth]
readPrec :: ReadPrec ResponseAuth
$creadPrec :: ReadPrec ResponseAuth
readList :: ReadS [ResponseAuth]
$creadList :: ReadS [ResponseAuth]
readsPrec :: Int -> ReadS ResponseAuth
$creadsPrec :: Int -> ReadS ResponseAuth
Read)
instance Binary ResponseAuth where
put :: ResponseAuth -> Put
put ResponseAuth{Int
AuthMethod
method :: AuthMethod
version :: Int
$sel:method:ResponseAuth :: ResponseAuth -> AuthMethod
$sel:version:ResponseAuth :: ResponseAuth -> Int
..} = Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
version) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put AuthMethod
method
get :: Get ResponseAuth
get = Int -> AuthMethod -> ResponseAuth
ResponseAuth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
instance Binary AuthMethod where
put :: AuthMethod -> Put
put AuthMethod
val = case AuthMethod
val of
AuthMethod
NoAuth -> Word8 -> Put
putWord8 Word8
0x00
AuthMethod
GSSAPI -> Word8 -> Put
putWord8 Word8
0x01
AuthMethod
Login -> Word8 -> Put
putWord8 Word8
0x02
AuthMethod
NotAllowed -> Word8 -> Put
putWord8 Word8
0xFF
AuthMethod
_ -> Word8 -> Put
putWord8 Word8
0x03
get :: Get AuthMethod
get = do
Word8
method <- Get Word8
getWord8
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Word8
method of
Word8
0x00 -> AuthMethod
NoAuth
Word8
0x01 -> AuthMethod
GSSAPI
Word8
0x02 -> AuthMethod
Login
Word8
0xFF -> AuthMethod
NotAllowed
Word8
_ -> AuthMethod
Reserved
instance Binary RequestAuth where
put :: RequestAuth -> Put
put RequestAuth{Int
Vector AuthMethod
methods :: Vector AuthMethod
version :: Int
$sel:methods:RequestAuth :: RequestAuth -> Vector AuthMethod
$sel:version:RequestAuth :: RequestAuth -> Int
..} = do
Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
version)
Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall mono. MonoFoldable mono => mono -> Int
length Vector AuthMethod
methods)
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
mapM_ forall t. Binary t => t -> Put
put Vector AuthMethod
methods
get :: Get RequestAuth
get = do
Int
version <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
version forall a. Eq a => a -> a -> Bool
== Int
0x05)
Int
nbMethods <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
nbMethods forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
nbMethods forall a. Ord a => a -> a -> Bool
<= Int
0xFF)
Vector AuthMethod
methods <- forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
Index seq -> m (Element seq) -> m seq
replicateM Int
nbMethods forall t. Binary t => Get t
get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Vector AuthMethod -> RequestAuth
RequestAuth Int
version Vector AuthMethod
methods
data Request = Request
{ Request -> Int
version :: Int
, Request -> Command
command :: Command
, Request -> String
addr :: HostName
, Request -> PortNumber
port :: PortNumber
} deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)
data Command = Connect
| Bind
| UdpAssociate
deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show, Command -> Command -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command
Command -> Int
Command -> [Command]
Command -> Command
Command -> Command -> [Command]
Command -> Command -> Command -> [Command]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Command -> Command -> Command -> [Command]
$cenumFromThenTo :: Command -> Command -> Command -> [Command]
enumFromTo :: Command -> Command -> [Command]
$cenumFromTo :: Command -> Command -> [Command]
enumFromThen :: Command -> Command -> [Command]
$cenumFromThen :: Command -> Command -> [Command]
enumFrom :: Command -> [Command]
$cenumFrom :: Command -> [Command]
fromEnum :: Command -> Int
$cfromEnum :: Command -> Int
toEnum :: Int -> Command
$ctoEnum :: Int -> Command
pred :: Command -> Command
$cpred :: Command -> Command
succ :: Command -> Command
$csucc :: Command -> Command
Enum, Command
forall a. a -> a -> Bounded a
maxBound :: Command
$cmaxBound :: Command
minBound :: Command
$cminBound :: Command
Bounded)
instance Binary Command where
put :: Command -> Put
put = Word8 -> Put
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. Num a => a -> a -> a
+Word8
1) 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
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
get :: Get Command
get = do
Int
cmd <- (\Word8
val -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
val forall a. Num a => a -> a -> a
- Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
cmd forall a. Ord a => a -> a -> Bool
>= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: Command) Bool -> Bool -> Bool
&& Int
cmd forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: Command)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
cmd
instance Binary Request where
put :: Request -> Put
put Request{Int
String
PortNumber
Command
port :: PortNumber
addr :: String
command :: Command
version :: Int
$sel:port:Request :: Request -> PortNumber
$sel:addr:Request :: Request -> String
$sel:command:Request :: Request -> Command
$sel:version:Request :: Request -> Int
..} = do
Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
version)
forall t. Binary t => t -> Put
put Command
command
Word8 -> Put
putWord8 Word8
0x00
Word8 -> Put
putWord8 Word8
0x03
let host :: ByteString
host = String -> ByteString
BC8.pack String
addr
Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> Int
length forall a b. (a -> b) -> a -> b
$ ByteString
host)
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
(Element mono -> f b) -> mono -> f ()
traverse_ forall t. Binary t => t -> Put
put ByteString
host
Word16 -> Put
putWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port)
get :: Get Request
get = do
Int
version <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
version forall a. Eq a => a -> a -> Bool
== Int
5)
Command
cmd <- forall t. Binary t => Get t
get :: Get Command
Word8
_ <- Get Word8
getWord8
Integer
opCode <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
opCode forall a. Eq a => a -> a -> Bool
== Integer
0x03 Bool -> Bool -> Bool
|| Integer
opCode forall a. Eq a => a -> a -> Bool
== Integer
0x01)
Text
host <- if Integer
opCode forall a. Eq a => a -> a -> Bool
== Integer
0x03
then do
Int
length <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall b a. b -> Either a b -> b
fromRight Text
T.empty forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either UnicodeException Text
E.decodeUtf8' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
Index seq -> m (Element seq) -> m seq
replicateM Int
length Get Word8
getWord8
else do
[Word8]
ipv4 <- forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
Index seq -> m (Element seq) -> m seq
replicateM Int
4 Get Word8
getWord8 :: Get [Word8]
let ipv4Str :: Text
ipv4Str = Text -> [Text] -> Text
T.intercalate Text
"." forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Show a => a -> Text
tshow 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) [Word8]
ipv4
forall (m :: * -> *) a. Monad m => a -> m a
return Text
ipv4Str
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall mono. MonoFoldable mono => mono -> Bool
null Text
host)
PortNumber
port <- forall a b. (Integral a, Num b) => a -> b
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 Request
{ $sel:version:Request :: Int
version = Int
version
, $sel:command:Request :: Command
command = Command
cmd
, $sel:addr:Request :: String
addr = forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
host
, $sel:port:Request :: PortNumber
port = PortNumber
port
}
toHex :: LByteString -> String
toHex :: LByteString -> String
toHex = forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr forall a. (Integral a, Show a) => a -> ShowS
showHex String
"" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
unpack
data Response = Response
{ Response -> Int
version :: Int
, Response -> RetCode
returnCode :: RetCode
, Response -> String
serverAddr :: HostName
, Response -> PortNumber
serverPort :: PortNumber
} deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)
data RetCode = SUCCEEDED
| GENERAL_FAILURE
| NOT_ALLOWED
| NO_NETWORK
| HOST_UNREACHABLE
| CONNECTION_REFUSED
| TTL_EXPIRED
| UNSUPPORTED_COMMAND
| UNSUPPORTED_ADDRESS_TYPE
| UNASSIGNED
deriving (Int -> RetCode -> ShowS
[RetCode] -> ShowS
RetCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetCode] -> ShowS
$cshowList :: [RetCode] -> ShowS
show :: RetCode -> String
$cshow :: RetCode -> String
showsPrec :: Int -> RetCode -> ShowS
$cshowsPrec :: Int -> RetCode -> ShowS
Show, RetCode -> RetCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetCode -> RetCode -> Bool
$c/= :: RetCode -> RetCode -> Bool
== :: RetCode -> RetCode -> Bool
$c== :: RetCode -> RetCode -> Bool
Eq, Int -> RetCode
RetCode -> Int
RetCode -> [RetCode]
RetCode -> RetCode
RetCode -> RetCode -> [RetCode]
RetCode -> RetCode -> RetCode -> [RetCode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RetCode -> RetCode -> RetCode -> [RetCode]
$cenumFromThenTo :: RetCode -> RetCode -> RetCode -> [RetCode]
enumFromTo :: RetCode -> RetCode -> [RetCode]
$cenumFromTo :: RetCode -> RetCode -> [RetCode]
enumFromThen :: RetCode -> RetCode -> [RetCode]
$cenumFromThen :: RetCode -> RetCode -> [RetCode]
enumFrom :: RetCode -> [RetCode]
$cenumFrom :: RetCode -> [RetCode]
fromEnum :: RetCode -> Int
$cfromEnum :: RetCode -> Int
toEnum :: Int -> RetCode
$ctoEnum :: Int -> RetCode
pred :: RetCode -> RetCode
$cpred :: RetCode -> RetCode
succ :: RetCode -> RetCode
$csucc :: RetCode -> RetCode
Enum, RetCode
forall a. a -> a -> Bounded a
maxBound :: RetCode
$cmaxBound :: RetCode
minBound :: RetCode
$cminBound :: RetCode
Bounded)
instance Binary RetCode where
put :: RetCode -> Put
put = Word8 -> Put
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
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
get :: Get RetCode
get = 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. Ord a => a -> a -> a
min forall a. Bounded a => a
maxBound 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
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
instance Binary Response where
put :: Response -> Put
put Response{Int
String
PortNumber
RetCode
serverPort :: PortNumber
serverAddr :: String
returnCode :: RetCode
version :: Int
$sel:serverPort:Response :: Response -> PortNumber
$sel:serverAddr:Response :: Response -> String
$sel:returnCode:Response :: Response -> RetCode
$sel:version:Response :: Response -> Int
..} = do
Word8 -> Put
putWord8 Word8
socksVersion
forall t. Binary t => t -> Put
put RetCode
returnCode
Word8 -> Put
putWord8 Word8
0x00
Word8 -> Put
putWord8 Word8
0x03
let host :: ByteString
host = String -> ByteString
BC8.pack String
serverAddr
Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> Int
length forall a b. (a -> b) -> a -> b
$ ByteString
host)
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
(Element mono -> f b) -> mono -> f ()
traverse_ forall t. Binary t => t -> Put
put ByteString
host
Word16 -> Put
putWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
serverPort)
get :: Get Response
get = do
Int
version <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Int
version forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
socksVersion)
RetCode
ret <- 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. Ord a => a -> a -> a
min forall a. Bounded a => a
maxBound 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
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
Get Word8
getWord8
Integer
opCode <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Integer
opCode forall a. Eq a => a -> a -> Bool
== Integer
0x03)
Int
length <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
Text
host <- forall b a. b -> Either a b -> b
fromRight Text
T.empty forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either UnicodeException Text
E.decodeUtf8' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
Index seq -> m (Element seq) -> m seq
replicateM Int
length Get Word8
getWord8
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall mono. MonoFoldable mono => mono -> Bool
null Text
host)
Word16
port <- Get Word16
getWord16be
forall (m :: * -> *) a. Monad m => a -> m a
return Response
{ $sel:version:Response :: Int
version = Int
version
, $sel:returnCode:Response :: RetCode
returnCode = RetCode
ret
, $sel:serverAddr:Response :: String
serverAddr = forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
host
, $sel:serverPort:Response :: PortNumber
serverPort = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
port
}
data ServerSettings = ServerSettings
{ ServerSettings -> PortNumber
listenOn :: PortNumber
, ServerSettings -> String
bindOn :: HostName
} deriving (Int -> ServerSettings -> ShowS
[ServerSettings] -> ShowS
ServerSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerSettings] -> ShowS
$cshowList :: [ServerSettings] -> ShowS
show :: ServerSettings -> String
$cshow :: ServerSettings -> String
showsPrec :: Int -> ServerSettings -> ShowS
$cshowsPrec :: Int -> ServerSettings -> ShowS
Show)