    {- |
    Module      : Network.Socks5.Wire
    License     : BSD-style
    Copyright   : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org>
    Stability   : experimental
    Portability : unknown
    -}

    module Network.Socks5.Wire
      ( SocksHello (..)
      , SocksHelloResponse (..)
      , SocksRequest (..)
      , SocksResponse (..)
      ) where

    import           Control.Monad ( liftM4, replicateM )
    import qualified Data.ByteString as B
    import           Data.Serialize
                       ( Get, Put, PutM (..), Serialize (..), getByteString
                       , getWord16be, getWord32host, getWord8, putByteString
                       , putWord16be, putWord32host, putWord8
                       )
    import           Network.Socket ( PortNumber )
    import           Network.Socks5.Types
                       ( SocksCommand, SocksHostAddress (..), SocksMethod
                       , SocksReply
                       )

    -- | Type representing initial messages sent by a client with the list of

    -- authentification methods supported.

    newtype SocksHello = SocksHello
      { SocksHello -> [SocksMethod]
    getSocksHelloMethods :: [SocksMethod]
      }
      deriving (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, 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)

    -- | Type representing initial messages sent by a server in response to Hello,

    -- with the server's chosen method of authentication.

    newtype SocksHelloResponse = SocksHelloResponse
      { SocksHelloResponse -> SocksMethod
    getSocksHelloResponseMethod :: SocksMethod
      }
      deriving (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, 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)

    -- | Type representing SOCKS requests.

    data SocksRequest = SocksRequest
      { SocksRequest -> SocksCommand
    requestCommand :: SocksCommand
      , SocksRequest -> SocksHostAddress
    requestDstAddr :: SocksHostAddress
      , SocksRequest -> PortNumber
    requestDstPort :: PortNumber
      }
      deriving (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, 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)

    -- | Type representing SOCKS responses.

    data SocksResponse = SocksResponse
        { SocksResponse -> SocksReply
    responseReply    :: SocksReply
        , SocksResponse -> SocksHostAddress
    responseBindAddr :: SocksHostAddress
        , SocksResponse -> PortNumber
    responseBindPort :: PortNumber
        }
        deriving (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, 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)

    getAddr :: (Eq a, Num a, Show a) => a -> Get SocksHostAddress
    getAddr :: forall a. (Eq a, Num a, Show a) => 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 = SocksFQDN -> SocksHostAddress
    SocksAddrDomainName (SocksFQDN -> SocksHostAddress)
    -> Get SocksFQDN -> Get SocksHostAddress
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Get Int
    getLength8 Get Int -> (Int -> Get SocksFQDN) -> Get SocksFQDN
    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 SocksFQDN
    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 :: 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 SocksFQDN
    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 (SocksFQDN -> Int
    B.length SocksFQDN
    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 SocksFQDN
    putByteString SocksFQDN
    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
    . Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (e -> Int) -> e -> Word8
    forall b c a. (b -> c) -> (a -> b) -> 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
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    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
    . Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

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

    getSocksRequest :: (Eq a, Num a, Show a) => a -> Get SocksRequest
    getSocksRequest :: forall a. (Eq a, Num a, Show a) => a -> Get SocksRequest
    getSocksRequest a
    5 = do
      cmd <- Get SocksCommand
    forall e. Enum e => Get e
    getEnum8
      _ <- getWord8
      addr <- getWord8 >>= getAddr
      port <- fromIntegral <$> getWord16be
      return $ SocksRequest cmd addr 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 :: (Eq a, Num a, Show a) => a -> Get SocksResponse
    getSocksResponse :: forall a. (Eq a, Num a, Show a) => a -> Get SocksResponse
    getSocksResponse a
    5 = do
      reply <- Get SocksReply
    forall e. Enum e => Get e
    getEnum8
      _ <- getWord8
      addr <- getWord8 >>= getAddr
      port <- fromIntegral <$> getWord16be
      return $ SocksResponse reply addr 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
    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
        v <- Get Word8
    getWord8
        case 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
        v <- Get Word8
    getWord8
        case 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
    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
    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