    {-# LANGUAGE BangPatterns             #-}
    {-# LANGUAGE CPP                      #-}
    {-# LANGUAGE DeriveDataTypeable       #-}
    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE OverloadedStrings        #-}
    {-# LANGUAGE Trustworthy              #-}
    {-# LANGUAGE TupleSections            #-}

    {-|

    HAProxy proxying protocol support (see
    <http://haproxy.1wt.eu/download/1.5/doc/proxy-protocol.txt>) for applications
    using io-streams. The proxy protocol allows information about a networked peer
    (like remote address and port) to be propagated through a forwarding proxy that
    is configured to speak this protocol.

    This approach is safer than other alternatives like injecting a special HTTP
    header (like "X-Forwarded-For") because the data is sent out of band, requests
    without the proxy header fail, and proxy data cannot be spoofed by the client.

    -}

    module System.IO.Streams.Network.HAProxy
      (
      -- * Proxying requests.
        behindHAProxy
      , behindHAProxyWithLocalInfo
      , decodeHAProxyHeaders
      -- * Information about proxied requests.
      , ProxyInfo
      , socketToProxyInfo
      , makeProxyInfo
      , getSourceAddr
      , getDestAddr
      , getFamily
      , getSocketType
      ) where

    ------------------------------------------------------------------------------
    import           Control.Applicative                        ((<|>))
    import           Control.Monad                              (void, when)
    import           Data.Attoparsec.ByteString                 (anyWord8)
    import           Data.Attoparsec.ByteString.Char8           (Parser, char, decimal, skipWhile, string, take, takeWhile1)
    import           Data.Bits                                  (unsafeShiftR, (.&.))
    import qualified Data.ByteString                            as S8
    import           Data.ByteString.Char8                      (ByteString)
    import qualified Data.ByteString.Char8                      as S
    import qualified Data.ByteString.Unsafe                     as S
    import           Data.Word                                  (Word16, Word32, Word8)
    import           Foreign.C.Types                            (CUInt (..), CUShort (..))
    import           Foreign.Ptr                                (castPtr)
    import           Foreign.Storable                           (peek)
    import qualified Network.Socket                             as N
    import           Prelude                                    hiding (take)
    import           System.IO.Streams                          (InputStream, OutputStream)
    import qualified System.IO.Streams                          as Streams
    import qualified System.IO.Streams.Attoparsec               as Streams
    import           System.IO.Streams.Network.Internal.Address (getSockAddr)
    import           System.IO.Unsafe                           (unsafePerformIO)

    #if !MIN_VERSION_base(4,8,0)
    import           Control.Applicative                        ((<$>))
    #endif
    ------------------------------------------------------------------------------

    ------------------------------------------------------------------------------
    -- | Make a 'ProxyInfo' from a connected socket.
    socketToProxyInfo :: N.Socket -> N.SockAddr -> IO ProxyInfo
    socketToProxyInfo :: Socket -> SockAddr -> IO ProxyInfo
    socketToProxyInfo Socket
    s SockAddr
    sa = do
        da <- Socket -> IO SockAddr
    N.getSocketName Socket
    s
        !sty <- getSockType
        return $! makeProxyInfo sa da (addrFamily sa) sty
      where
    #if MIN_VERSION_network(3,0,1)
        getSockType :: IO SocketType
    getSockType = Socket -> IO SocketType
    N.getSocketType Socket
    s
    #else
        getSockType = let (N.MkSocket _ _ sty _ _) = s in return sty
    #endif

    ------------------------------------------------------------------------------
    -- | Parses the proxy headers emitted by HAProxy and runs a user action with
    -- the origin/destination socket addresses provided by HAProxy. Will throw a
    -- 'Sockets.ParseException' if the protocol header cannot be parsed properly.
    --
    -- We support version 1.5 of the protocol (both the "old" text protocol and the
    -- "new" binary protocol.). Typed data fields after the addresses are not (yet)
    -- supported.
    --
    behindHAProxy :: N.Socket         -- ^ A socket you've just accepted
                  -> N.SockAddr       -- ^ and its peer address
                  -> (ProxyInfo
                      -> InputStream ByteString
                      -> OutputStream ByteString
                      -> IO a)
                  -> IO a
    behindHAProxy :: forall a.
    Socket
    -> SockAddr
    -> (ProxyInfo
        -> InputStream ByteString -> OutputStream ByteString -> IO a)
    -> IO a
    behindHAProxy Socket
    socket SockAddr
    sa ProxyInfo
    -> InputStream ByteString -> OutputStream ByteString -> IO a
    m = do
        pinfo    <- Socket -> SockAddr -> IO ProxyInfo
    socketToProxyInfo Socket
    socket SockAddr
    sa
        sockets  <- Streams.socketToStreams socket
        behindHAProxyWithLocalInfo pinfo sockets m

    ------------------------------------------------------------------------------
    -- | Like 'behindHAProxy', but allows the socket addresses and input/output
    -- streams to be passed in instead of created based on an input 'Socket'.
    -- Useful for unit tests.
    --
    behindHAProxyWithLocalInfo
      :: ProxyInfo                                          -- ^ local socket info
      -> (InputStream ByteString, OutputStream ByteString)  -- ^ socket streams
      -> (ProxyInfo
              -> InputStream ByteString
              -> OutputStream ByteString
              -> IO a)              -- ^ user function
      -> IO a
    behindHAProxyWithLocalInfo :: forall a.
    ProxyInfo
    -> (InputStream ByteString, OutputStream ByteString)
    -> (ProxyInfo
        -> InputStream ByteString -> OutputStream ByteString -> IO a)
    -> IO a
    behindHAProxyWithLocalInfo ProxyInfo
    localProxyInfo (InputStream ByteString
    is, OutputStream ByteString
    os) ProxyInfo
    -> InputStream ByteString -> OutputStream ByteString -> IO a
    m = do
        proxyInfo <- ProxyInfo -> InputStream ByteString -> IO ProxyInfo
    decodeHAProxyHeaders ProxyInfo
    localProxyInfo InputStream ByteString
    is
        m proxyInfo is os

    ------------------------------------------------------------------------------
    decodeHAProxyHeaders :: ProxyInfo -> (InputStream ByteString) -> IO ProxyInfo
    decodeHAProxyHeaders :: ProxyInfo -> InputStream ByteString -> IO ProxyInfo
    decodeHAProxyHeaders ProxyInfo
    localProxyInfo InputStream ByteString
    is0 = do
        -- 536 bytes as per spec
        is <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    536 InputStream ByteString
    is0
        (!isOld, !mbOldInfo) <- Streams.parseFromStream
                                  (((True,) <$> parseOldHaProxy)
                                   <|> return (False, Nothing)) is
        if isOld
          then maybe (return localProxyInfo)
                     (\(ByteString
    srcAddr, Int
    srcPort, ByteString
    destAddr, Int
    destPort, Family
    f) -> do
                         (_, s) <- Int -> ByteString -> IO (Family, SockAddr)
    getSockAddr Int
    srcPort ByteString
    srcAddr
                         (_, d) <- getSockAddr destPort destAddr
                         return $! makeProxyInfo s d f $ getSocketType localProxyInfo)
                     mbOldInfo
          else Streams.parseFromStream (parseNewHaProxy localProxyInfo) is

    ------------------------------------------------------------------------------
    -- | Stores information about the proxied request.
    data ProxyInfo = ProxyInfo {
          ProxyInfo -> SockAddr
    _sourceAddr :: N.SockAddr
        , ProxyInfo -> SockAddr
    _destAddr   :: N.SockAddr
        , ProxyInfo -> Family
    _family     :: N.Family
        , ProxyInfo -> SocketType
    _sockType   :: N.SocketType
        } deriving (Int -> ProxyInfo -> ShowS
    [ProxyInfo] -> ShowS
    ProxyInfo -> [Char]
    (Int -> ProxyInfo -> ShowS)
    -> (ProxyInfo -> [Char])
    -> ([ProxyInfo] -> ShowS)
    -> Show ProxyInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ProxyInfo -> ShowS
    showsPrec :: Int -> ProxyInfo -> ShowS
    $cshow :: ProxyInfo -> [Char]
    show :: ProxyInfo -> [Char]
    $cshowList :: [ProxyInfo] -> ShowS
    showList :: [ProxyInfo] -> ShowS
    Show)

    ------------------------------------------------------------------------------
    -- | Gets the 'N.Family' of the proxied request (i.e. IPv4/IPv6/Unix domain
    -- sockets).
    getFamily :: ProxyInfo -> N.Family
    getFamily :: ProxyInfo -> Family
    getFamily ProxyInfo
    p = ProxyInfo -> Family
    _family ProxyInfo
    p

    ------------------------------------------------------------------------------
    -- | Gets the 'N.SocketType' of the proxied request (UDP/TCP).
    getSocketType :: ProxyInfo -> N.SocketType
    getSocketType :: ProxyInfo -> SocketType
    getSocketType ProxyInfo
    p = ProxyInfo -> SocketType
    _sockType ProxyInfo
    p

    ------------------------------------------------------------------------------
    -- | Gets the network address of the source node for this request (i.e. the
    -- client).
    getSourceAddr :: ProxyInfo -> N.SockAddr
    getSourceAddr :: ProxyInfo -> SockAddr
    getSourceAddr ProxyInfo
    p = ProxyInfo -> SockAddr
    _sourceAddr ProxyInfo
    p

    ------------------------------------------------------------------------------
    -- | Gets the network address of the destination node for this request (i.e. the
    -- client).
    getDestAddr :: ProxyInfo -> N.SockAddr
    getDestAddr :: ProxyInfo -> SockAddr
    getDestAddr ProxyInfo
    p = ProxyInfo -> SockAddr
    _destAddr ProxyInfo
    p

    ------------------------------------------------------------------------------
    -- | Makes a 'ProxyInfo' object.
    makeProxyInfo :: N.SockAddr      -- ^ the source address
                  -> N.SockAddr      -- ^ the destination address
                  -> N.Family        -- ^ the socket family
                  -> N.SocketType    -- ^ the socket type
                  -> ProxyInfo
    makeProxyInfo :: SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
    makeProxyInfo SockAddr
    srcAddr SockAddr
    destAddr Family
    f SocketType
    st = SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
    ProxyInfo SockAddr
    srcAddr SockAddr
    destAddr Family
    f SocketType
    st

    ------------------------------------------------------------------------------
    parseFamily :: Parser (Maybe N.Family)
    parseFamily :: Parser (Maybe Family)
    parseFamily = (ByteString -> Parser ByteString
    string ByteString
    "TCP4" Parser ByteString -> Parser (Maybe Family) -> Parser (Maybe Family)
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Family -> Parser (Maybe Family)
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Family -> Maybe Family
    forall a. a -> Maybe a
    Just Family
    N.AF_INET))
                    Parser (Maybe Family)
    -> Parser (Maybe Family) -> Parser (Maybe Family)
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (ByteString -> Parser ByteString
    string ByteString
    "TCP6" Parser ByteString -> Parser (Maybe Family) -> Parser (Maybe Family)
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Family -> Parser (Maybe Family)
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Family -> Maybe Family
    forall a. a -> Maybe a
    Just Family
    N.AF_INET6))
                    Parser (Maybe Family)
    -> Parser (Maybe Family) -> Parser (Maybe Family)
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (ByteString -> Parser ByteString
    string ByteString
    "UNKNOWN" Parser ByteString -> Parser (Maybe Family) -> Parser (Maybe Family)
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Family -> Parser (Maybe Family)
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Family
    forall a. Maybe a
    Nothing)

    ------------------------------------------------------------------------------
    parseOldHaProxy :: Parser (Maybe (ByteString, Int, ByteString, Int, N.Family))
    parseOldHaProxy :: Parser
      ByteString (Maybe (ByteString, Int, ByteString, Int, Family))
    parseOldHaProxy = do
        ByteString -> Parser ByteString
    string ByteString
    "PROXY "
        gotFamily <- Parser (Maybe Family)
    parseFamily
        case gotFamily of
          Maybe Family
    Nothing  -> (Char -> Bool) -> Parser ()
    skipWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r') Parser () -> Parser ByteString -> Parser ByteString
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Parser ByteString
    string ByteString
    "\r\n" Parser ByteString
    -> Parser
         ByteString (Maybe (ByteString, Int, ByteString, Int, Family))
    -> Parser
         ByteString (Maybe (ByteString, Int, ByteString, Int, Family))
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (ByteString, Int, ByteString, Int, Family)
    -> Parser
         ByteString (Maybe (ByteString, Int, ByteString, Int, Family))
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ByteString, Int, ByteString, Int, Family)
    forall a. Maybe a
    Nothing
          (Just Family
    f) -> do
              Char -> Parser Char
    char Char
    ' '
              srcAddress <- (Char -> Bool) -> Parser ByteString
    takeWhile1 (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ')
              char ' '
              destAddress <- takeWhile1 (/= ' ')
              char ' '
              srcPort <- decimal
              char ' '
              destPort <- decimal
              string "\r\n"
              return $! Just $! (srcAddress, srcPort, destAddress, destPort, f)

    ------------------------------------------------------------------------------
    protocolHeader :: ByteString
    protocolHeader :: ByteString
    protocolHeader = [Word8] -> ByteString
    S8.pack [ Word8
    0x0D, Word8
    0x0A, Word8
    0x0D, Word8
    0x0A, Word8
    0x00, Word8
    0x0D
                             , Word8
    0x0A, Word8
    0x51, Word8
    0x55, Word8
    0x49, Word8
    0x54, Word8
    0x0A ]
    {-# NOINLINE protocolHeader #-}

    ------------------------------------------------------------------------------
    parseNewHaProxy :: ProxyInfo -> Parser ProxyInfo
    parseNewHaProxy :: ProxyInfo -> Parser ProxyInfo
    parseNewHaProxy ProxyInfo
    localProxyInfo = do
        ByteString -> Parser ByteString
    string ByteString
    protocolHeader

        versionAndCommand <- Parser Word8
    anyWord8
        let version = (Word8
    versionAndCommand Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF0) Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4
        let command = (Word8
    versionAndCommand Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF) :: Word8

        when (version /= 0x2) $ fail $ "Invalid protocol version: " ++ show version
        when (command > 1) $ fail $ "Invalid command: " ++ show command

        protocolAndFamily <- anyWord8
        let family = (Word8
    protocolAndFamily Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF0) Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4
        let protocol = (Word8
    protocolAndFamily Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF) :: Word8

        -- VALUES FOR FAMILY
        -- 0x0 : AF_UNSPEC : the connection is forwarded for an unknown,
        -- unspecified or unsupported protocol. The sender should use this family
        -- when sending LOCAL commands or when dealing with unsupported protocol
        -- families. The receiver is free to accept the connection anyway and use
        -- the real endpoint addresses or to reject it. The receiver should ignore
        -- address information.

        -- 0x1 : AF_INET : the forwarded connection uses the AF_INET address family
        -- (IPv4). The addresses are exactly 4 bytes each in network byte order,
        -- followed by transport protocol information (typically ports).

        -- 0x2 : AF_INET6 : the forwarded connection uses the AF_INET6 address
        -- family (IPv6). The addresses are exactly 16 bytes each in network byte
        -- order, followed by transport protocol information (typically ports).
        --
        -- 0x3 : AF_UNIX : the forwarded connection uses the AF_UNIX address family
        -- (UNIX). The addresses are exactly 108 bytes each.
        socketType <- toSocketType protocol

        addressLen <- ntohs <$> snarf16

        case () of
            !()
    _ | Word8
    command Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x0 Bool -> Bool -> Bool
    || Word8
    family Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x0 Bool -> Bool -> Bool
    || Word8
    protocol Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x0   -- LOCAL
                    -> Word16 -> Parser ProxyInfo
    forall {a}. (Show a, Integral a) => a -> Parser ProxyInfo
    handleLocal Word16
    addressLen
               | Word8
    family Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x1 -> Word16 -> SocketType -> Parser ProxyInfo
    forall {a}.
    (Show a, Integral a) =>
    a -> SocketType -> Parser ProxyInfo
    handleIPv4 Word16
    addressLen SocketType
    socketType
               | Word8
    family Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x2 -> Word16 -> SocketType -> Parser ProxyInfo
    forall {a}.
    (Show a, Integral a) =>
    a -> SocketType -> Parser ProxyInfo
    handleIPv6 Word16
    addressLen SocketType
    socketType
    #ifndef WINDOWS
               | Word8
    family Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x3 -> Word16 -> SocketType -> Parser ProxyInfo
    forall {a}.
    (Show a, Integral a) =>
    a -> SocketType -> Parser ProxyInfo
    handleUnix Word16
    addressLen SocketType
    socketType
    #endif
               | Bool
    otherwise     -> [Char] -> Parser ProxyInfo
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> Parser ProxyInfo) -> [Char] -> Parser ProxyInfo
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Bad family " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> [Char]
    forall a. Show a => a -> [Char]
    show Word8
    family

      where
        toSocketType :: a -> m SocketType
    toSocketType a
    0 = SocketType -> m SocketType
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SocketType -> m SocketType) -> SocketType -> m SocketType
    forall a b. (a -> b) -> a -> b
    $! SocketType
    N.Stream
        toSocketType a
    1 = SocketType -> m SocketType
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SocketType -> m SocketType) -> SocketType -> m SocketType
    forall a b. (a -> b) -> a -> b
    $! SocketType
    N.Stream
        toSocketType a
    2 = SocketType -> m SocketType
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SocketType -> m SocketType) -> SocketType -> m SocketType
    forall a b. (a -> b) -> a -> b
    $! SocketType
    N.Datagram
        toSocketType a
    _ = [Char] -> m SocketType
    forall a. [Char] -> m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "bad protocol"

        handleLocal :: a -> Parser ProxyInfo
    handleLocal a
    addressLen = do
            -- skip N bytes and return the original addresses
            Bool -> Parser () -> Parser ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    addressLen a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    500) (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Parser ()
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> Parser ()) -> [Char] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "suspiciously long address "
                                              [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    addressLen
            Parser ByteString -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser ByteString -> Parser ()) -> Parser ByteString -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Parser ByteString
    take (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    addressLen)
            ProxyInfo -> Parser ProxyInfo
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProxyInfo
    localProxyInfo

        handleIPv4 :: a -> SocketType -> Parser ProxyInfo
    handleIPv4 a
    addressLen SocketType
    socketType = do
            Bool -> Parser () -> Parser ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    addressLen a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    12) (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Parser ()
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> Parser ()) -> [Char] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bad address length "
                                             [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    addressLen
                                             [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " for IPv4"
            let nskip :: a
    nskip = a
    addressLen a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    12
            srcAddr  <- Parser Word32
    snarf32
            destAddr <- snarf32
            srcPort  <- ntohs <$> snarf16
            destPort <- ntohs <$> snarf16
            void $ take $ fromIntegral nskip

            -- Note: we actually want the brain-dead constructors here
            let sa = PortNumber -> Word32 -> SockAddr
    N.SockAddrInet (Word16 -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    srcPort) Word32
    srcAddr
            let sb = PortNumber -> Word32 -> SockAddr
    N.SockAddrInet (Word16 -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    destPort) Word32
    destAddr
            return $! makeProxyInfo sa sb (addrFamily sa) socketType

        handleIPv6 :: a -> SocketType -> Parser ProxyInfo
    handleIPv6 a
    addressLen SocketType
    socketType = do
            let scopeId :: Word32
    scopeId = Word32
    0   -- means "reserved", kludge alert!
            let flow :: Word32
    flow    = Word32
    0

            Bool -> Parser () -> Parser ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    addressLen a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    36) (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Parser ()
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> Parser ()) -> [Char] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bad address length "
                                             [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    addressLen
                                             [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " for IPv6"
            let nskip :: a
    nskip = a
    addressLen a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    36
            s1 <- Word32 -> Word32
    ntohl (Word32 -> Word32) -> Parser Word32 -> Parser Word32
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Word32
    snarf32
            s2 <- ntohl <$> snarf32
            s3 <- ntohl <$> snarf32
            s4 <- ntohl <$> snarf32

            d1 <- ntohl <$> snarf32
            d2 <- ntohl <$> snarf32
            d3 <- ntohl <$> snarf32
            d4 <- ntohl <$> snarf32

            sp <- ntohs <$> snarf16
            dp <- ntohs <$> snarf16

            void $ take $ fromIntegral nskip

            let sa = PortNumber -> Word32 -> HostAddress6 -> Word32 -> SockAddr
    N.SockAddrInet6 (Word16 -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    sp) Word32
    flow (Word32
    s1, Word32
    s2, Word32
    s3, Word32
    s4) Word32
    scopeId
            let sb = PortNumber -> Word32 -> HostAddress6 -> Word32 -> SockAddr
    N.SockAddrInet6 (Word16 -> PortNumber
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    dp) Word32
    flow (Word32
    d1, Word32
    d2, Word32
    d3, Word32
    d4) Word32
    scopeId

            return $! makeProxyInfo sa sb (addrFamily sa) socketType
    #ifndef WINDOWS
        handleUnix :: a -> SocketType -> Parser ProxyInfo
    handleUnix a
    addressLen SocketType
    socketType = do
            Bool -> Parser () -> Parser ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    addressLen a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    216) (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Parser ()
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> Parser ()) -> [Char] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bad address length "
                                             [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    addressLen
                                             [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " for unix"
            addr1 <- Int -> Parser ByteString
    take Int
    108
            addr2 <- take 108
            void $ take $ fromIntegral $ addressLen - 216
            let sa = [Char] -> SockAddr
    N.SockAddrUnix (ByteString -> [Char]
    toUnixPath ByteString
    addr1)
            let sb = [Char] -> SockAddr
    N.SockAddrUnix (ByteString -> [Char]
    toUnixPath ByteString
    addr2)
            return $! makeProxyInfo sa sb (addrFamily sa) socketType

        toUnixPath :: ByteString -> [Char]
    toUnixPath = ByteString -> [Char]
    S.unpack (ByteString -> [Char])
    -> (ByteString -> ByteString) -> ByteString -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> a
    fst ((ByteString, ByteString) -> ByteString)
    -> (ByteString -> (ByteString, ByteString))
    -> ByteString
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    S.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '\x00')
    #endif

    foreign import ccall unsafe "iostreams_ntohs" c_ntohs :: CUShort -> CUShort
    foreign import ccall unsafe "iostreams_ntohl" c_ntohl :: CUInt -> CUInt

    ntohs :: Word16 -> Word16
    ntohs :: Word16 -> Word16
    ntohs = CUShort -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CUShort -> Word16) -> (Word16 -> CUShort) -> Word16 -> Word16
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CUShort -> CUShort
    c_ntohs (CUShort -> CUShort) -> (Word16 -> CUShort) -> Word16 -> CUShort
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word16 -> CUShort
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    ntohl :: Word32 -> Word32
    ntohl :: Word32 -> Word32
    ntohl = CUInt -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CUInt -> Word32) -> (Word32 -> CUInt) -> Word32 -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CUInt -> CUInt
    c_ntohl (CUInt -> CUInt) -> (Word32 -> CUInt) -> Word32 -> CUInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> CUInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral

    snarf32 :: Parser Word32
    snarf32 :: Parser Word32
    snarf32 = do
        s <- Int -> Parser ByteString
    take Int
    4
        return $! unsafePerformIO $! S.unsafeUseAsCString s $ peek . castPtr

    snarf16 :: Parser Word16
    snarf16 :: Parser ByteString Word16
    snarf16 = do
        s <- Int -> Parser ByteString
    take Int
    2
        return $! unsafePerformIO $! S.unsafeUseAsCString s $ peek . castPtr

    addrFamily :: N.SockAddr -> N.Family
    addrFamily :: SockAddr -> Family
    addrFamily SockAddr
    s = case SockAddr
    s of
                     (N.SockAddrInet PortNumber
    _ Word32
    _)      -> Family
    N.AF_INET
                     (N.SockAddrInet6 PortNumber
    _ Word32
    _ HostAddress6
    _ Word32
    _) -> Family
    N.AF_INET6
    #ifndef WINDOWS
                     (N.SockAddrUnix [Char]
    _ )       -> Family
    N.AF_UNIX
    #endif
                     SockAddr
    _                         -> [Char] -> Family
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "unknown family"