{-# 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
_ {- Reserverd -} -> 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
    -- Check length <= 255

  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 -- RESERVED
    Word8 -> Put
putWord8 Word8
0x03 -- DOMAINNAME
    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 -- RESERVED

    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 -- Addr type, we support only ipv4 and domainame
    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) -- DOMAINNAME OR IPV4

    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 -- Reserved
    Word8 -> Put
putWord8 Word8
0x03 -- DOMAINNAME
    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 -- RESERVED
    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 -- Type
    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
  -- , onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth
  -- , onRequest          :: (MonadIO m, MonadError IOException m) => Request -> m Response
  } 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)