    {-# Language PatternSynonyms #-}
    {-|
    Module      : Hookup.Socks5
    Description : SOCKS5 network protocol implementation
    Copyright   : (c) Eric Mertens, 2018
    License     : ISC
    Maintainer  : emertens@gmail.com

    This module provides types, parsers, and builders for the messages
    used in the SOCKS5 protocol. See <https://tools.ietf.org/html/rfc1928>
    -}
    module Hookup.Socks5

      ( -- * Client hello message
        ClientHello(..)
      , buildClientHello
      , parseClientHello

      -- * Server hello message
      , ServerHello(..)
      , buildServerHello
      , parseServerHello

      -- * Command request message
      , Request(..)
      , buildRequest
      , parseRequest

      -- * Command response message
      , Response(..)
      , buildResponse
      , parseResponse

      -- * Network address types
      , Address(..)
      , Host(..)

      -- * Authentication methods
      , AuthMethod
          ( AuthNoAuthenticationRequired
          , AuthGssApi
          , AuthUsernamePassword
          , AuthNoAcceptableMethods )

      -- * Plaintext authentication request message
      , PlainAuthentication(..)
      , buildPlainAuthentication
      , parsePlainAuthentication

      -- * Plaintext authentication reply message
      , PlainAuthenticationReply(..)
      , buildPlainAuthenticationReply
      , parsePlainAuthenticationReply

      -- * Commands
      , Command
          ( Connect
          , Bind
          , UdpAssociate )

      -- * Command reply codes
      , CommandReply
          ( CommandReply
          , Succeeded
          , GeneralFailure
          , NotAllowed
          , NetUnreachable
          , HostUnreachable
          , ConnectionRefused
          , TTLExpired
          , CmdNotSupported
          , AddrNotSupported )

      )
      where

    import           Control.Monad              (replicateM)
    import           Data.Attoparsec.ByteString (Parser)
    import           Data.ByteString            (ByteString)
    import           Data.ByteString.Builder    (Builder)
    import           Data.Word                  (Word8, Word16)
    import           Network.Socket             (HostAddress, HostAddress6, PortNumber,
                                                 hostAddressToTuple, hostAddress6ToTuple,
                                                 tupleToHostAddress, tupleToHostAddress6)
    import qualified Data.Attoparsec.ByteString as Parser
    import qualified Data.ByteString            as B
    import qualified Data.ByteString.Builder    as Builder
    import qualified Data.ByteString.Lazy       as L

    -- | SOCKS authentication methods
    newtype AuthMethod                      = AuthMethod Word8 deriving (AuthMethod -> AuthMethod -> Bool
    (AuthMethod -> AuthMethod -> Bool)
    -> (AuthMethod -> AuthMethod -> Bool) -> Eq AuthMethod
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AuthMethod -> AuthMethod -> Bool
    == :: AuthMethod -> AuthMethod -> Bool
    $c/= :: AuthMethod -> AuthMethod -> Bool
    /= :: AuthMethod -> AuthMethod -> Bool
    Eq, Int -> AuthMethod -> ShowS
    [AuthMethod] -> ShowS
    AuthMethod -> String
    (Int -> AuthMethod -> ShowS)
    -> (AuthMethod -> String)
    -> ([AuthMethod] -> ShowS)
    -> Show AuthMethod
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AuthMethod -> ShowS
    showsPrec :: Int -> AuthMethod -> ShowS
    $cshow :: AuthMethod -> String
    show :: AuthMethod -> String
    $cshowList :: [AuthMethod] -> ShowS
    showList :: [AuthMethod] -> ShowS
    Show)

    pattern AuthNoAuthenticationRequired, AuthGssApi, AuthUsernamePassword, AuthNoAcceptableMethods :: AuthMethod

    pattern $mAuthNoAuthenticationRequired :: forall {r}. AuthMethod -> ((# #) -> r) -> ((# #) -> r) -> r
    $bAuthNoAuthenticationRequired :: AuthMethod
    AuthNoAuthenticationRequired    = AuthMethod 0x00
    pattern $mAuthGssApi :: forall {r}. AuthMethod -> ((# #) -> r) -> ((# #) -> r) -> r
    $bAuthGssApi :: AuthMethod
    AuthGssApi                      = AuthMethod 0x01
    pattern $mAuthUsernamePassword :: forall {r}. AuthMethod -> ((# #) -> r) -> ((# #) -> r) -> r
    $bAuthUsernamePassword :: AuthMethod
    AuthUsernamePassword            = AuthMethod 0x02
    pattern $mAuthNoAcceptableMethods :: forall {r}. AuthMethod -> ((# #) -> r) -> ((# #) -> r) -> r
    $bAuthNoAcceptableMethods :: AuthMethod
    AuthNoAcceptableMethods         = AuthMethod 0xFF

    -- | SOCKS client commands
    newtype Command                         = Command Word8 deriving (Command -> Command -> Bool
    (Command -> Command -> Bool)
    -> (Command -> Command -> Bool) -> Eq Command
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Command -> Command -> Bool
    == :: Command -> Command -> Bool
    $c/= :: Command -> Command -> Bool
    /= :: Command -> Command -> Bool
    Eq, Int -> Command -> ShowS
    [Command] -> ShowS
    Command -> String
    (Int -> Command -> ShowS)
    -> (Command -> String) -> ([Command] -> ShowS) -> Show Command
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Command -> ShowS
    showsPrec :: Int -> Command -> ShowS
    $cshow :: Command -> String
    show :: Command -> String
    $cshowList :: [Command] -> ShowS
    showList :: [Command] -> ShowS
    Show)

    pattern Connect, Bind, UdpAssociate :: Command

    pattern $mConnect :: forall {r}. Command -> ((# #) -> r) -> ((# #) -> r) -> r
    $bConnect :: Command
    Connect                         = Command 1
    pattern $mBind :: forall {r}. Command -> ((# #) -> r) -> ((# #) -> r) -> r
    $bBind :: Command
    Bind                            = Command 2
    pattern $mUdpAssociate :: forall {r}. Command -> ((# #) -> r) -> ((# #) -> r) -> r
    $bUdpAssociate :: Command
    UdpAssociate                    = Command 3

    -- | Tags used in the protocol messages for encoded 'Host' values
    newtype HostTag                         = HostTag Word8 deriving (HostTag -> HostTag -> Bool
    (HostTag -> HostTag -> Bool)
    -> (HostTag -> HostTag -> Bool) -> Eq HostTag
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HostTag -> HostTag -> Bool
    == :: HostTag -> HostTag -> Bool
    $c/= :: HostTag -> HostTag -> Bool
    /= :: HostTag -> HostTag -> Bool
    Eq, Int -> HostTag -> ShowS
    [HostTag] -> ShowS
    HostTag -> String
    (Int -> HostTag -> ShowS)
    -> (HostTag -> String) -> ([HostTag] -> ShowS) -> Show HostTag
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HostTag -> ShowS
    showsPrec :: Int -> HostTag -> ShowS
    $cshow :: HostTag -> String
    show :: HostTag -> String
    $cshowList :: [HostTag] -> ShowS
    showList :: [HostTag] -> ShowS
    Show)

    pattern IPv4Tag, DomainNameTag, IPv6Tag :: HostTag

    pattern $mIPv4Tag :: forall {r}. HostTag -> ((# #) -> r) -> ((# #) -> r) -> r
    $bIPv4Tag :: HostTag
    IPv4Tag                         = HostTag 1
    pattern $mDomainNameTag :: forall {r}. HostTag -> ((# #) -> r) -> ((# #) -> r) -> r
    $bDomainNameTag :: HostTag
    DomainNameTag                   = HostTag 3
    pattern $mIPv6Tag :: forall {r}. HostTag -> ((# #) -> r) -> ((# #) -> r) -> r
    $bIPv6Tag :: HostTag
    IPv6Tag                         = HostTag 4

    -- | SOCKS command reply codes
    newtype CommandReply                    = CommandReply Word8 deriving (CommandReply -> CommandReply -> Bool
    (CommandReply -> CommandReply -> Bool)
    -> (CommandReply -> CommandReply -> Bool) -> Eq CommandReply
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CommandReply -> CommandReply -> Bool
    == :: CommandReply -> CommandReply -> Bool
    $c/= :: CommandReply -> CommandReply -> Bool
    /= :: CommandReply -> CommandReply -> Bool
    Eq, Int -> CommandReply -> ShowS
    [CommandReply] -> ShowS
    CommandReply -> String
    (Int -> CommandReply -> ShowS)
    -> (CommandReply -> String)
    -> ([CommandReply] -> ShowS)
    -> Show CommandReply
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CommandReply -> ShowS
    showsPrec :: Int -> CommandReply -> ShowS
    $cshow :: CommandReply -> String
    show :: CommandReply -> String
    $cshowList :: [CommandReply] -> ShowS
    showList :: [CommandReply] -> ShowS
    Show)

    pattern Succeeded, GeneralFailure, NotAllowed, NetUnreachable, HostUnreachable,
      ConnectionRefused, TTLExpired, CmdNotSupported, AddrNotSupported :: CommandReply

    pattern $mSucceeded :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bSucceeded :: CommandReply
    Succeeded                       = CommandReply 0
    pattern $mGeneralFailure :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bGeneralFailure :: CommandReply
    GeneralFailure                  = CommandReply 1
    pattern $mNotAllowed :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bNotAllowed :: CommandReply
    NotAllowed                      = CommandReply 2
    pattern $mNetUnreachable :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bNetUnreachable :: CommandReply
    NetUnreachable                  = CommandReply 3
    pattern $mHostUnreachable :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bHostUnreachable :: CommandReply
    HostUnreachable                 = CommandReply 4
    pattern $mConnectionRefused :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bConnectionRefused :: CommandReply
    ConnectionRefused               = CommandReply 5
    pattern $mTTLExpired :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bTTLExpired :: CommandReply
    TTLExpired                      = CommandReply 6
    pattern $mCmdNotSupported :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bCmdNotSupported :: CommandReply
    CmdNotSupported                 = CommandReply 7
    pattern $mAddrNotSupported :: forall {r}. CommandReply -> ((# #) -> r) -> ((# #) -> r) -> r
    $bAddrNotSupported :: CommandReply
    AddrNotSupported                = CommandReply 8

    -- | Network host and port number
    data Address = Address Host PortNumber
      deriving Int -> Address -> ShowS
    [Address] -> ShowS
    Address -> String
    (Int -> Address -> ShowS)
    -> (Address -> String) -> ([Address] -> ShowS) -> Show Address
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Address -> ShowS
    showsPrec :: Int -> Address -> ShowS
    $cshow :: Address -> String
    show :: Address -> String
    $cshowList :: [Address] -> ShowS
    showList :: [Address] -> ShowS
    Show

    -- | Network host identified by address or domain name.
    data Host
      = IPv4 HostAddress      -- ^ IPv4 host address
      | IPv6 HostAddress6     -- ^ IPv6 host address
      | DomainName ByteString -- ^ Domain name (maximum length 255)
      deriving Int -> Host -> ShowS
    [Host] -> ShowS
    Host -> String
    (Int -> Host -> ShowS)
    -> (Host -> String) -> ([Host] -> ShowS) -> Show Host
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Host -> ShowS
    showsPrec :: Int -> Host -> ShowS
    $cshow :: Host -> String
    show :: Host -> String
    $cshowList :: [Host] -> ShowS
    showList :: [Host] -> ShowS
    Show

    -- RFC 1929 Username/Password

    -- | Plaintext username and password request
    data PlainAuthentication = PlainAuthentication
      { PlainAuthentication -> ByteString
    plainUsername :: ByteString -- ^ username
      , PlainAuthentication -> ByteString
    plainPassword :: ByteString -- ^ password
      }
      deriving Int -> PlainAuthentication -> ShowS
    [PlainAuthentication] -> ShowS
    PlainAuthentication -> String
    (Int -> PlainAuthentication -> ShowS)
    -> (PlainAuthentication -> String)
    -> ([PlainAuthentication] -> ShowS)
    -> Show PlainAuthentication
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PlainAuthentication -> ShowS
    showsPrec :: Int -> PlainAuthentication -> ShowS
    $cshow :: PlainAuthentication -> String
    show :: PlainAuthentication -> String
    $cshowList :: [PlainAuthentication] -> ShowS
    showList :: [PlainAuthentication] -> ShowS
    Show

    -- | Plaintext username and password response
    newtype PlainAuthenticationReply = PlainAuthenticationReply
      { PlainAuthenticationReply -> Word8
    plainStatus :: Word8 -- ^ @0@ for success, failure otherwise
      }
      deriving Int -> PlainAuthenticationReply -> ShowS
    [PlainAuthenticationReply] -> ShowS
    PlainAuthenticationReply -> String
    (Int -> PlainAuthenticationReply -> ShowS)
    -> (PlainAuthenticationReply -> String)
    -> ([PlainAuthenticationReply] -> ShowS)
    -> Show PlainAuthenticationReply
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PlainAuthenticationReply -> ShowS
    showsPrec :: Int -> PlainAuthenticationReply -> ShowS
    $cshow :: PlainAuthenticationReply -> String
    show :: PlainAuthenticationReply -> String
    $cshowList :: [PlainAuthenticationReply] -> ShowS
    showList :: [PlainAuthenticationReply] -> ShowS
    Show

    -- | Initial SOCKS sent by client with proposed list of authentication methods.
    newtype ClientHello = ClientHello
      { ClientHello -> [AuthMethod]
    cHelloMethods :: [AuthMethod] -- ^ proposed methods (maximum length 255)
      }
      deriving Int -> ClientHello -> ShowS
    [ClientHello] -> ShowS
    ClientHello -> String
    (Int -> ClientHello -> ShowS)
    -> (ClientHello -> String)
    -> ([ClientHello] -> ShowS)
    -> Show ClientHello
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ClientHello -> ShowS
    showsPrec :: Int -> ClientHello -> ShowS
    $cshow :: ClientHello -> String
    show :: ClientHello -> String
    $cshowList :: [ClientHello] -> ShowS
    showList :: [ClientHello] -> ShowS
    Show

    -- | Initial SOCKS sent by server with chosen authentication method.
    newtype ServerHello = ServerHello
      { ServerHello -> AuthMethod
    sHelloMethod  :: AuthMethod
      }
      deriving Int -> ServerHello -> ShowS
    [ServerHello] -> ShowS
    ServerHello -> String
    (Int -> ServerHello -> ShowS)
    -> (ServerHello -> String)
    -> ([ServerHello] -> ShowS)
    -> Show ServerHello
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ServerHello -> ShowS
    showsPrec :: Int -> ServerHello -> ShowS
    $cshow :: ServerHello -> String
    show :: ServerHello -> String
    $cshowList :: [ServerHello] -> ShowS
    showList :: [ServerHello] -> ShowS
    Show

    -- | Client message used to request a network operation from the SOCKS server.
    data Request = Request
      { Request -> Command
    reqCommand :: Command
      , Request -> Address
    reqAddress :: Address
      }
      deriving Int -> Request -> ShowS
    [Request] -> ShowS
    Request -> String
    (Int -> Request -> ShowS)
    -> (Request -> String) -> ([Request] -> ShowS) -> Show Request
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Request -> ShowS
    showsPrec :: Int -> Request -> ShowS
    $cshow :: Request -> String
    show :: Request -> String
    $cshowList :: [Request] -> ShowS
    showList :: [Request] -> ShowS
    Show

    -- | Server message used to indicate result of client's request.
    data Response = Response
      { Response -> CommandReply
    rspReply   :: CommandReply
      , Response -> Address
    rspAddress :: Address
      }
      deriving Int -> Response -> ShowS
    [Response] -> ShowS
    Response -> String
    (Int -> Response -> ShowS)
    -> (Response -> String) -> ([Response] -> ShowS) -> Show Response
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Response -> ShowS
    showsPrec :: Int -> Response -> ShowS
    $cshow :: Response -> String
    show :: Response -> String
    $cshowList :: [Response] -> ShowS
    showList :: [Response] -> ShowS
    Show

    -- | Transform a 'Builder' into a strict 'ByteString'
    runBuilder :: Builder -> ByteString
    runBuilder :: Builder -> ByteString
    runBuilder = LazyByteString -> ByteString
    L.toStrict (LazyByteString -> ByteString)
    -> (Builder -> LazyByteString) -> Builder -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> LazyByteString
    Builder.toLazyByteString

    ------------------------------------------------------------------------

    buildCommand :: Command -> Builder
    buildCommand :: Command -> Builder
    buildCommand (Command Word8
    c) = Word8 -> Builder
    Builder.word8 Word8
    c

    parseCommand :: Parser Command
    parseCommand :: Parser Command
    parseCommand = Word8 -> Command
    Command (Word8 -> Command) -> Parser ByteString Word8 -> Parser Command
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Word8
    Parser.anyWord8

    ------------------------------------------------------------------------

    buildHost :: Host -> Builder
    buildHost :: Host -> Builder
    buildHost (IPv4 HostAddress
    hostAddr) = HostTag -> Builder
    buildHostTag HostTag
    IPv4Tag       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> HostAddress -> Builder
    buildHostAddress  HostAddress
    hostAddr
    buildHost (IPv6 HostAddress6
    hostAddr) = HostTag -> Builder
    buildHostTag HostTag
    IPv6Tag       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> HostAddress6 -> Builder
    buildHostAddress6 HostAddress6
    hostAddr
    buildHost (DomainName ByteString
    dn) = HostTag -> Builder
    buildHostTag HostTag
    DomainNameTag Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> Builder
    buildDomainName ByteString
    dn

    parseHost :: Parser Host
    parseHost :: Parser Host
    parseHost =
      do tag <- Parser HostTag
    parseHostTag
         case tag of
           HostTag
    IPv4Tag       -> HostAddress -> Host
    IPv4       (HostAddress -> Host)
    -> Parser ByteString HostAddress -> Parser Host
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString HostAddress
    parseHostAddress
           HostTag
    IPv6Tag       -> HostAddress6 -> Host
    IPv6       (HostAddress6 -> Host)
    -> Parser ByteString HostAddress6 -> Parser Host
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString HostAddress6
    parseHostAddress6
           HostTag
    DomainNameTag -> ByteString -> Host
    DomainName (ByteString -> Host) -> Parser ByteString ByteString -> Parser Host
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString ByteString
    parseDomainName
           HostTag
    _             -> String -> Parser Host
    forall a. String -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "bad address tag"

    ------------------------------------------------------------------------

    buildAddress :: Address -> Builder
    buildAddress :: Address -> Builder
    buildAddress (Address Host
    host PortNumber
    port) = Host -> Builder
    buildHost Host
    host Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> PortNumber -> Builder
    buildPort PortNumber
    port

    parseAddress :: Parser Address
    parseAddress :: Parser Address
    parseAddress = Host -> PortNumber -> Address
    Address (Host -> PortNumber -> Address)
    -> Parser Host -> Parser ByteString (PortNumber -> Address)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Host
    parseHost Parser ByteString (PortNumber -> Address)
    -> Parser ByteString PortNumber -> Parser Address
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ByteString PortNumber
    parsePort

    ------------------------------------------------------------------------

    buildHostTag :: HostTag -> Builder
    buildHostTag :: HostTag -> Builder
    buildHostTag (HostTag Word8
    tag) = Word8 -> Builder
    Builder.word8 Word8
    tag

    parseHostTag :: Parser HostTag
    parseHostTag :: Parser HostTag
    parseHostTag = Word8 -> HostTag
    HostTag (Word8 -> HostTag) -> Parser ByteString Word8 -> Parser HostTag
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Word8
    Parser.anyWord8

    ------------------------------------------------------------------------

    buildHostAddress :: HostAddress -> Builder
    buildHostAddress :: HostAddress -> Builder
    buildHostAddress HostAddress
    hostAddr =
      case HostAddress -> (Word8, Word8, Word8, Word8)
    hostAddressToTuple HostAddress
    hostAddr of
        (Word8
    a1,Word8
    a2,Word8
    a3,Word8
    a4) -> (Word8 -> Builder) -> [Word8] -> Builder
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Word8 -> Builder
    Builder.word8 [Word8
    a1,Word8
    a2,Word8
    a3,Word8
    a4]

    parseHostAddress :: Parser HostAddress
    parseHostAddress :: Parser ByteString HostAddress
    parseHostAddress =
      do [a1,a2,a3,a4] <- Int -> Parser ByteString Word8 -> Parser ByteString [Word8]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    4 Parser ByteString Word8
    Parser.anyWord8
         pure $! tupleToHostAddress (a1,a2,a3,a4)

    ------------------------------------------------------------------------

    buildHostAddress6 :: HostAddress6 -> Builder
    buildHostAddress6 :: HostAddress6 -> Builder
    buildHostAddress6 HostAddress6
    hostAddr =
      case HostAddress6
    -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
    hostAddress6ToTuple HostAddress6
    hostAddr of
        (Word16
    a1,Word16
    a2,Word16
    a3,Word16
    a4,Word16
    a5,Word16
    a6,Word16
    a7,Word16
    a8) ->
          (Word16 -> Builder) -> [Word16] -> Builder
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Word16 -> Builder
    Builder.word16BE [Word16
    a1,Word16
    a2,Word16
    a3,Word16
    a4,Word16
    a5,Word16
    a6,Word16
    a7,Word16
    a8]

    parseHostAddress6 :: Parser HostAddress6
    parseHostAddress6 :: Parser ByteString HostAddress6
    parseHostAddress6 =
      do [a1,a2,a3,a4,a5,a6,a7,a8] <- Int -> Parser ByteString Word16 -> Parser ByteString [Word16]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    8 Parser ByteString Word16
    parseWord16BE
         pure $! tupleToHostAddress6 (a1,a2,a3,a4,a5,a6,a7,a8)

    ------------------------------------------------------------------------

    buildDomainName :: ByteString -> Builder
    buildDomainName :: ByteString -> Builder
    buildDomainName ByteString
    bs
      | ByteString -> Int
    B.length ByteString
    bs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    256 = Word8 -> Builder
    Builder.word8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    B.length ByteString
    bs)) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                            ByteString -> Builder
    Builder.byteString ByteString
    bs
      | Bool
    otherwise = String -> Builder
    forall a. HasCallStack => String -> a
    error String
    "SOCKS5 domain name too long"

    parseDomainName :: Parser ByteString
    parseDomainName :: Parser ByteString ByteString
    parseDomainName =
      do len <- Parser ByteString Word8
    Parser.anyWord8
         Parser.take (fromIntegral len)

    ------------------------------------------------------------------------

    buildPort :: PortNumber -> Builder
    buildPort :: PortNumber -> Builder
    buildPort PortNumber
    port = Word16 -> Builder
    Builder.word16BE (PortNumber -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral PortNumber
    port)

    parsePort :: Parser PortNumber
    parsePort :: Parser ByteString PortNumber
    parsePort = Word16 -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> PortNumber)
    -> Parser ByteString Word16 -> Parser ByteString PortNumber
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Word16
    parseWord16BE

    ------------------------------------------------------------------------

    buildVersion :: Builder
    buildVersion :: Builder
    buildVersion = Word8 -> Builder
    Builder.word8 Word8
    5

    parseVersion :: Parser ()
    parseVersion :: Parser ()
    parseVersion = () () -> Parser ByteString Word8 -> Parser ()
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Word8 -> Parser ByteString Word8
    Parser.word8 Word8
    5

    ------------------------------------------------------------------------

    buildAuthMethod :: AuthMethod -> Builder
    buildAuthMethod :: AuthMethod -> Builder
    buildAuthMethod (AuthMethod Word8
    x) = Word8 -> Builder
    Builder.word8 Word8
    x

    parseAuthMethod :: Parser AuthMethod
    parseAuthMethod :: Parser AuthMethod
    parseAuthMethod = Word8 -> AuthMethod
    AuthMethod (Word8 -> AuthMethod)
    -> Parser ByteString Word8 -> Parser AuthMethod
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Word8
    Parser.anyWord8

    ------------------------------------------------------------------------

    buildReply :: CommandReply -> Builder
    buildReply :: CommandReply -> Builder
    buildReply (CommandReply Word8
    x) = Word8 -> Builder
    Builder.word8 Word8
    x

    parseReply :: Parser CommandReply
    parseReply :: Parser CommandReply
    parseReply = Word8 -> CommandReply
    CommandReply (Word8 -> CommandReply)
    -> Parser ByteString Word8 -> Parser CommandReply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString Word8
    Parser.anyWord8

    ------------------------------------------------------------------------

    buildReserved :: Builder
    buildReserved :: Builder
    buildReserved = Word8 -> Builder
    Builder.word8 Word8
    0

    parseReserved :: Parser ()
    parseReserved :: Parser ()
    parseReserved = () () -> Parser ByteString Word8 -> Parser ()
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Parser ByteString Word8
    Parser.anyWord8

    ------------------------------------------------------------------------

    -- | Build a list of buildable things prefixing the length of the list
    -- as a single byte. The list must not be longer than 255 elements.
    buildListOf :: (a -> Builder) -> [a] -> Builder
    buildListOf :: forall a. (a -> Builder) -> [a] -> Builder
    buildListOf a -> Builder
    builder [a]
    xs
      | [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    256 = Word8 -> Builder
    Builder.word8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs)) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                          (a -> Builder) -> [a] -> Builder
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap a -> Builder
    builder [a]
    xs
      | Bool
    otherwise       = String -> Builder
    forall a. HasCallStack => String -> a
    error String
    "buildListOf: list too long"

    -- | Parse a list of parsable things where the length of the list
    -- is encoded as a single byte before the items to be parsed.
    parseListOf :: Parser a -> Parser [a]
    parseListOf :: forall a. Parser a -> Parser [a]
    parseListOf Parser a
    parser =
      do n <- Parser ByteString Word8
    Parser.anyWord8
         replicateM (fromIntegral n) parser

    ------------------------------------------------------------------------

    buildClientHello :: ClientHello -> ByteString
    buildClientHello :: ClientHello -> ByteString
    buildClientHello ClientHello
    msg =
      Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      Builder
    buildVersion Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      (AuthMethod -> Builder) -> [AuthMethod] -> Builder
    forall a. (a -> Builder) -> [a] -> Builder
    buildListOf AuthMethod -> Builder
    buildAuthMethod (ClientHello -> [AuthMethod]
    cHelloMethods ClientHello
    msg)

    parseClientHello :: Parser ClientHello
    parseClientHello :: Parser ClientHello
    parseClientHello =
      [AuthMethod] -> ClientHello
    ClientHello
        ([AuthMethod] -> ClientHello)
    -> Parser () -> Parser ByteString ([AuthMethod] -> ClientHello)
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$  Parser ()
    parseVersion
        Parser ByteString ([AuthMethod] -> ClientHello)
    -> Parser ByteString [AuthMethod] -> Parser ClientHello
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser AuthMethod -> Parser ByteString [AuthMethod]
    forall a. Parser a -> Parser [a]
    parseListOf Parser AuthMethod
    parseAuthMethod

    ------------------------------------------------------------------------

    buildServerHello :: ServerHello -> ByteString
    buildServerHello :: ServerHello -> ByteString
    buildServerHello ServerHello
    msg =
      Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      Builder
    buildVersion Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      AuthMethod -> Builder
    buildAuthMethod (ServerHello -> AuthMethod
    sHelloMethod ServerHello
    msg)

    parseServerHello :: Parser ServerHello
    parseServerHello :: Parser ServerHello
    parseServerHello =
      AuthMethod -> ServerHello
    ServerHello
        (AuthMethod -> ServerHello)
    -> Parser () -> Parser ByteString (AuthMethod -> ServerHello)
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$  Parser ()
    parseVersion
        Parser ByteString (AuthMethod -> ServerHello)
    -> Parser AuthMethod -> Parser ServerHello
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser AuthMethod
    parseAuthMethod

    ------------------------------------------------------------------------

    buildRequest :: Request -> ByteString
    buildRequest :: Request -> ByteString
    buildRequest Request
    req =
      Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      Builder
    buildVersion                    Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      Command -> Builder
    buildCommand  (Request -> Command
    reqCommand  Request
    req) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      Builder
    buildReserved                   Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      Address -> Builder
    buildAddress  (Request -> Address
    reqAddress  Request
    req)

    parseRequest :: Parser Request
    parseRequest :: Parser Request
    parseRequest =
      Command -> Address -> Request
    Request
        (Command -> Address -> Request)
    -> Parser () -> Parser ByteString (Command -> Address -> Request)
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$  Parser ()
    parseVersion
        Parser ByteString (Command -> Address -> Request)
    -> Parser Command -> Parser ByteString (Address -> Request)
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Command
    parseCommand
        Parser ByteString (Address -> Request)
    -> Parser () -> Parser ByteString (Address -> Request)
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*  Parser ()
    parseReserved
        Parser ByteString (Address -> Request)
    -> Parser Address -> Parser Request
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Address
    parseAddress

    ------------------------------------------------------------------------

    buildResponse :: Response -> ByteString
    buildResponse :: Response -> ByteString
    buildResponse Response
    msg =
      Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      Builder
    buildVersion                  Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      CommandReply -> Builder
    buildReply   (Response -> CommandReply
    rspReply   Response
    msg) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      Builder
    buildReserved                 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      Address -> Builder
    buildAddress (Response -> Address
    rspAddress Response
    msg)

    parseResponse :: Parser Response
    parseResponse :: Parser Response
    parseResponse =
      CommandReply -> Address -> Response
    Response
        (CommandReply -> Address -> Response)
    -> Parser ()
    -> Parser ByteString (CommandReply -> Address -> Response)
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$  Parser ()
    parseVersion
        Parser ByteString (CommandReply -> Address -> Response)
    -> Parser CommandReply -> Parser ByteString (Address -> Response)
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser CommandReply
    parseReply
        Parser ByteString (Address -> Response)
    -> Parser () -> Parser ByteString (Address -> Response)
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*  Parser ()
    parseReserved
        Parser ByteString (Address -> Response)
    -> Parser Address -> Parser Response
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Address
    parseAddress

    ------------------------------------------------------------------------

    buildPlainAuthentication :: PlainAuthentication -> ByteString
    buildPlainAuthentication :: PlainAuthentication -> ByteString
    buildPlainAuthentication PlainAuthentication
    msg =
      Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      Word8 -> Builder
    Builder.word8 Word8
    1 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> -- subnegotiation version
      ByteString -> Builder
    buildBS (PlainAuthentication -> ByteString
    plainUsername PlainAuthentication
    msg) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
      ByteString -> Builder
    buildBS (PlainAuthentication -> ByteString
    plainPassword PlainAuthentication
    msg)
      where
        buildBS :: ByteString -> Builder
    buildBS ByteString
    x =
          Word8 -> Builder
    Builder.word8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int
    B.length ByteString
    x)) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
          ByteString -> Builder
    Builder.byteString ByteString
    x

    parsePlainAuthentication :: Parser PlainAuthentication
    parsePlainAuthentication :: Parser PlainAuthentication
    parsePlainAuthentication =
      ByteString -> ByteString -> PlainAuthentication
    PlainAuthentication
        (ByteString -> ByteString -> PlainAuthentication)
    -> Parser ByteString Word8
    -> Parser
         ByteString (ByteString -> ByteString -> PlainAuthentication)
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$  Word8 -> Parser ByteString Word8
    Parser.word8 Word8
    1 -- subnegotiation version
        Parser ByteString (ByteString -> ByteString -> PlainAuthentication)
    -> Parser ByteString ByteString
    -> Parser ByteString (ByteString -> PlainAuthentication)
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ByteString ByteString
    parseBS
        Parser ByteString (ByteString -> PlainAuthentication)
    -> Parser ByteString ByteString -> Parser PlainAuthentication
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ByteString ByteString
    parseBS
      where
        parseBS :: Parser ByteString ByteString
    parseBS =
         do len <- Parser ByteString Word8
    Parser.anyWord8
            Parser.take (fromIntegral len)

    ------------------------------------------------------------------------

    buildPlainAuthenticationReply :: PlainAuthenticationReply -> ByteString
    buildPlainAuthenticationReply :: PlainAuthenticationReply -> ByteString
    buildPlainAuthenticationReply PlainAuthenticationReply
    msg =
      Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $
      Word8 -> Builder
    Builder.word8 Word8
    1 Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> -- subnegotiation version
      Word8 -> Builder
    Builder.word8 (PlainAuthenticationReply -> Word8
    plainStatus PlainAuthenticationReply
    msg)

    parsePlainAuthenticationReply :: Parser PlainAuthenticationReply
    parsePlainAuthenticationReply :: Parser PlainAuthenticationReply
    parsePlainAuthenticationReply =
      Word8 -> PlainAuthenticationReply
    PlainAuthenticationReply
        (Word8 -> PlainAuthenticationReply)
    -> Parser ByteString Word8
    -> Parser ByteString (Word8 -> PlainAuthenticationReply)
    forall a b. a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$  Word8 -> Parser ByteString Word8
    Parser.word8 Word8
    1 -- subnegotiation version
        Parser ByteString (Word8 -> PlainAuthenticationReply)
    -> Parser ByteString Word8 -> Parser PlainAuthenticationReply
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ByteString Word8
    Parser.anyWord8

    ------------------------------------------------------------------------

    -- | Match a 16-bit, big-endian word.
    parseWord16BE :: Parser Word16
    parseWord16BE :: Parser ByteString Word16
    parseWord16BE =
      do hi <- Parser ByteString Word8
    Parser.anyWord8
         lo <- Parser.anyWord8
         pure $! fromIntegral hi * 0x100 + fromIntegral lo