    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns #-}
    module Network.HTTP.Client.Connection
        ( connectionReadLine
        , connectionReadLineWith
        , connectionDropTillBlankLine
        , connectionUnreadLine
        , dummyConnection
        , openSocketConnection
        , openSocketConnectionSize
        , makeConnection
        , socketConnection
        , withSocket
        , strippedHostName
        ) where

    import Data.ByteString (ByteString, empty)
    import Data.IORef
    import Control.Monad
    import Control.Concurrent
    import Control.Concurrent.Async
    import Network.HTTP.Client.Types
    import Network.Socket (Socket, HostAddress)
    import qualified Network.Socket as NS
    import Network.Socket.ByteString (sendAll, recv)
    import qualified Control.Exception as E
    import qualified Data.ByteString as S
    import Data.Foldable (for_)
    import Data.Function (fix)
    import Data.Maybe (listToMaybe)
    import Data.Word (Word8)

    connectionReadLine :: Maybe MaxHeaderLength -> Connection -> IO ByteString
    connectionReadLine :: Maybe MaxHeaderLength -> Connection -> IO ByteString
    connectionReadLine Maybe MaxHeaderLength
    mhl Connection
    conn = do
        bs <- Connection -> IO ByteString
    connectionRead Connection
    conn
        when (S.null bs) $ throwHttp IncompleteHeaders
        connectionReadLineWith mhl conn bs

    -- | Keep dropping input until a blank line is found.
    connectionDropTillBlankLine :: Maybe MaxHeaderLength -> Connection -> IO ()
    connectionDropTillBlankLine :: Maybe MaxHeaderLength -> Connection -> IO ()
    connectionDropTillBlankLine Maybe MaxHeaderLength
    mhl Connection
    conn = (IO () -> IO ()) -> IO ()
    forall a. (a -> a) -> a
    fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IO ()
    loop -> do
        bs <- Maybe MaxHeaderLength -> Connection -> IO ByteString
    connectionReadLine Maybe MaxHeaderLength
    mhl Connection
    conn
        unless (S.null bs) loop

    connectionReadLineWith :: Maybe MaxHeaderLength -> Connection -> ByteString -> IO ByteString
    connectionReadLineWith :: Maybe MaxHeaderLength -> Connection -> ByteString -> IO ByteString
    connectionReadLineWith Maybe MaxHeaderLength
    mhl Connection
    conn ByteString
    bs0 =
        ByteString
    -> ([ByteString] -> [ByteString]) -> Int -> IO ByteString
    go ByteString
    bs0 [ByteString] -> [ByteString]
    forall a. a -> a
    id Int
    0
      where
        go :: ByteString
    -> ([ByteString] -> [ByteString]) -> Int -> IO ByteString
    go ByteString
    bs [ByteString] -> [ByteString]
    front Int
    total =
            case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    S.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    charLF) ByteString
    bs of
                (ByteString
    _, ByteString
    "") -> do
                    let total' :: Int
    total' = Int
    total Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    bs
                    case (MaxHeaderLength -> Int) -> Maybe MaxHeaderLength -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MaxHeaderLength -> Int
    unMaxHeaderLength Maybe MaxHeaderLength
    mhl of
                        Maybe Int
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                        Just Int
    n -> Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    total' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ HttpExceptionContent -> IO ()
    forall a. HttpExceptionContent -> IO a
    throwHttp HttpExceptionContent
    OverlongHeaders
                    bs' <- Connection -> IO ByteString
    connectionRead Connection
    conn
                    when (S.null bs') $ throwHttp IncompleteHeaders
                    go bs' (front . (bs:)) total'
                (ByteString
    x, Int -> ByteString -> ByteString
    S.drop Int
    1 -> ByteString
    y) -> do
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ByteString -> Bool
    S.null ByteString
    y) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Connection -> ByteString -> IO ()
    connectionUnread Connection
    conn ByteString
    y
                    ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $! ByteString -> ByteString
    killCR (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $! [ByteString] -> ByteString
    S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $! [ByteString] -> [ByteString]
    front [ByteString
    x]

    connectionUnreadLine :: Connection -> ByteString -> IO ()
    connectionUnreadLine :: Connection -> ByteString -> IO ()
    connectionUnreadLine Connection
    conn ByteString
    line = do
      Connection -> ByteString -> IO ()
    connectionUnread Connection
    conn ([Word8] -> ByteString
    S.pack [Word8
    charCR, Word8
    charLF])
      Connection -> ByteString -> IO ()
    connectionUnread Connection
    conn ByteString
    line

    charLF, charCR :: Word8
    charLF :: Word8
    charLF = Word8
    10
    charCR :: Word8
    charCR = Word8
    13

    killCR :: ByteString -> ByteString
    killCR :: ByteString -> ByteString
    killCR ByteString
    bs
        | ByteString -> Bool
    S.null ByteString
    bs = ByteString
    bs
        | HasCallStack => ByteString -> Word8
    ByteString -> Word8
    S.last ByteString
    bs Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    charCR = HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    S.init ByteString
    bs
        | Bool
    otherwise = ByteString
    bs

    -- | For testing
    dummyConnection :: [ByteString] -- ^ input
                    -> IO (Connection, IO [ByteString], IO [ByteString]) -- ^ conn, output, input
    dummyConnection :: [ByteString] -> IO (Connection, IO [ByteString], IO [ByteString])
    dummyConnection [ByteString]
    input0 = do
        iinput <- [ByteString] -> IO (IORef [ByteString])
    forall a. a -> IO (IORef a)
    newIORef [ByteString]
    input0
        ioutput <- newIORef []
        return (Connection
            { connectionRead = atomicModifyIORef iinput $ \[ByteString]
    input ->
                case [ByteString]
    input of
                    [] -> ([], ByteString
    empty)
                    ByteString
    x:[ByteString]
    xs -> ([ByteString]
    xs, ByteString
    x)
            , connectionUnread = \ByteString
    x -> IORef [ByteString] -> ([ByteString] -> ([ByteString], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [ByteString]
    iinput (([ByteString] -> ([ByteString], ())) -> IO ())
    -> ([ByteString] -> ([ByteString], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[ByteString]
    input -> (ByteString
    xByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    input, ())
            , connectionWrite = \ByteString
    x -> IORef [ByteString] -> ([ByteString] -> ([ByteString], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [ByteString]
    ioutput (([ByteString] -> ([ByteString], ())) -> IO ())
    -> ([ByteString] -> ([ByteString], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[ByteString]
    output -> ([ByteString]
    output [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString
    x], ())
            , connectionClose = return ()
            }, atomicModifyIORef ioutput $ \[ByteString]
    output -> ([], [ByteString]
    output), readIORef iinput)

    -- | Create a new 'Connection' from a read, write, and close function.
    --
    -- @since 0.5.3
    makeConnection :: IO ByteString -- ^ read
                   -> (ByteString -> IO ()) -- ^ write
                   -> IO () -- ^ close
                   -> IO Connection
    makeConnection :: IO ByteString -> (ByteString -> IO ()) -> IO () -> IO Connection
    makeConnection IO ByteString
    r ByteString -> IO ()
    w IO ()
    c = do
        istack <- [ByteString] -> IO (IORef [ByteString])
    forall a. a -> IO (IORef a)
    newIORef []

        -- it is necessary to make sure we never read from or write to
        -- already closed connection.
        closedVar <- newIORef False

        let close = do
              closed <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Bool
    closedVar (\Bool
    closed -> (Bool
    True, Bool
    closed))
              unless closed $
                c

        _ <- mkWeakIORef istack close
        return $! Connection
            { connectionRead = do
                closed <- readIORef closedVar
                when closed $ throwHttp ConnectionClosed
                join $ atomicModifyIORef istack $ \[ByteString]
    stack ->
                  case [ByteString]
    stack of
                      ByteString
    x:[ByteString]
    xs -> ([ByteString]
    xs, ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x)
                      [] -> ([], IO ByteString
    r)

            , connectionUnread = \ByteString
    x -> do
                closed <- IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef IORef Bool
    closedVar
                when closed $ throwHttp ConnectionClosed
                atomicModifyIORef istack $ \[ByteString]
    stack -> (ByteString
    xByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    stack, ())

            , connectionWrite = \ByteString
    x -> do
                closed <- IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef IORef Bool
    closedVar
                when closed $ throwHttp ConnectionClosed
                w x

            , connectionClose = close
            }

    -- | Create a new 'Connection' from a 'Socket'.
    --
    -- @since 0.5.3
    socketConnection :: Socket
                     -> Int -- ^ chunk size
                     -> IO Connection
    socketConnection :: Socket -> Int -> IO Connection
    socketConnection Socket
    socket Int
    chunksize = IO ByteString -> (ByteString -> IO ()) -> IO () -> IO Connection
    makeConnection
        (Socket -> Int -> IO ByteString
    recv Socket
    socket Int
    chunksize)
        (Socket -> ByteString -> IO ()
    sendAll Socket
    socket)
        (Socket -> IO ()
    NS.close Socket
    socket)

    openSocketConnection :: (Socket -> IO ())
                         -> Maybe HostAddress
                         -> String -- ^ host
                         -> Int -- ^ port
                         -> IO Connection
    openSocketConnection :: (Socket -> IO ())
    -> Maybe HostAddress -> [Char] -> Int -> IO Connection
    openSocketConnection Socket -> IO ()
    f = (Socket -> IO ())
    -> Int -> Maybe HostAddress -> [Char] -> Int -> IO Connection
    openSocketConnectionSize Socket -> IO ()
    f Int
    8192

    openSocketConnectionSize :: (Socket -> IO ())
                             -> Int -- ^ chunk size
                             -> Maybe HostAddress
                             -> String -- ^ host
                             -> Int -- ^ port
                             -> IO Connection
    openSocketConnectionSize :: (Socket -> IO ())
    -> Int -> Maybe HostAddress -> [Char] -> Int -> IO Connection
    openSocketConnectionSize Socket -> IO ()
    tweakSocket Int
    chunksize Maybe HostAddress
    hostAddress' [Char]
    host' Int
    port' =
        (Socket -> IO ())
    -> Maybe HostAddress
    -> [Char]
    -> Int
    -> (Socket -> IO Connection)
    -> IO Connection
    forall a.
    (Socket -> IO ())
    -> Maybe HostAddress -> [Char] -> Int -> (Socket -> IO a) -> IO a
    withSocket Socket -> IO ()
    tweakSocket Maybe HostAddress
    hostAddress' [Char]
    host' Int
    port' ((Socket -> IO Connection) -> IO Connection)
    -> (Socket -> IO Connection) -> IO Connection
    forall a b. (a -> b) -> a -> b
    $ \ Socket
    sock ->
            Socket -> Int -> IO Connection
    socketConnection Socket
    sock Int
    chunksize

    -- | strippedHostName takes a URI host name, as extracted
    -- by 'Network.URI.regName', and strips square brackets
    -- around IPv6 addresses.
    --
    -- The result is suitable for passing to services such as
    -- name resolution ('Network.Socket.getAddr').
    --
    -- @since
    strippedHostName :: String -> String
    strippedHostName :: [Char] -> [Char]
    strippedHostName [Char]
    hostName =
        case [Char]
    hostName of
            Char
    '[':Char
    'v':[Char]
    _ -> [Char]
    hostName -- IPvFuture, no obvious way to deal with this
            Char
    '[':[Char]
    rest ->
                case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ']') [Char]
    rest of
                    ([Char]
    ipv6, [Char]
    "]") -> [Char]
    ipv6
                    ([Char], [Char])
    _ -> [Char]
    hostName -- invalid host name
            [Char]
    _ -> [Char]
    hostName

    withSocket :: (Socket -> IO ())
               -> Maybe HostAddress
               -> String -- ^ host
               -> Int -- ^ port
               -> (Socket -> IO a)
               -> IO a
    withSocket :: forall a.
    (Socket -> IO ())
    -> Maybe HostAddress -> [Char] -> Int -> (Socket -> IO a) -> IO a
    withSocket Socket -> IO ()
    tweakSocket Maybe HostAddress
    hostAddress' [Char]
    host' Int
    port' Socket -> IO a
    f = do
        let hints :: AddrInfo
    hints = AddrInfo
    NS.defaultHints { NS.addrSocketType = NS.Stream }
        addrs <- case Maybe HostAddress
    hostAddress' of
            Maybe HostAddress
    Nothing ->
                Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO [AddrInfo]
    forall (t :: * -> *).
    GetAddrInfo t =>
    Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO (t AddrInfo)
    NS.getAddrInfo (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just AddrInfo
    hints) ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    strippedHostName [Char]
    host') ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    port')
            Just HostAddress
    ha ->
                [AddrInfo] -> IO [AddrInfo]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                    [NS.AddrInfo
                     { addrFlags :: [AddrInfoFlag]
    NS.addrFlags = []
                     , addrFamily :: Family
    NS.addrFamily = Family
    NS.AF_INET
                     , addrSocketType :: SocketType
    NS.addrSocketType = SocketType
    NS.Stream
                     , addrProtocol :: ProtocolNumber
    NS.addrProtocol = ProtocolNumber
    6 -- tcp
                     , addrAddress :: SockAddr
    NS.addrAddress = PortNumber -> HostAddress -> SockAddr
    NS.SockAddrInet (Int -> PortNumber
    forall a. Enum a => Int -> a
    toEnum Int
    port') HostAddress
    ha
                     , addrCanonName :: Maybe [Char]
    NS.addrCanonName = Maybe [Char]
    forall a. Maybe a
    Nothing
                     }]

        E.bracketOnError (firstSuccessful addrs $ openSocket tweakSocket) NS.close f

    openSocket :: (Socket -> IO a) -> AddrInfo -> IO Socket
    openSocket Socket -> IO a
    tweakSocket AddrInfo
    addr =
        IO Socket
    -> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    E.bracketOnError
            (Family -> SocketType -> ProtocolNumber -> IO Socket
    NS.socket (AddrInfo -> Family
    NS.addrFamily AddrInfo
    addr) (AddrInfo -> SocketType
    NS.addrSocketType AddrInfo
    addr)
                       (AddrInfo -> ProtocolNumber
    NS.addrProtocol AddrInfo
    addr))
            Socket -> IO ()
    NS.close
            (\Socket
    sock -> do
                Socket -> SocketOption -> Int -> IO ()
    NS.setSocketOption Socket
    sock SocketOption
    NS.NoDelay Int
    1
                Socket -> IO a
    tweakSocket Socket
    sock
                Socket -> SockAddr -> IO ()
    NS.connect Socket
    sock (AddrInfo -> SockAddr
    NS.addrAddress AddrInfo
    addr)
                Socket -> IO Socket
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Socket
    sock)

    -- Pick up an IP using an approximation of the happy-eyeballs algorithm:
    -- https://datatracker.ietf.org/doc/html/rfc8305
    --
    firstSuccessful :: [NS.AddrInfo] -> (NS.AddrInfo -> IO a) -> IO a
    firstSuccessful :: forall a. [AddrInfo] -> (AddrInfo -> IO a) -> IO a
    firstSuccessful []        AddrInfo -> IO a
    _  = [Char] -> IO a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "getAddrInfo returned empty list"
    firstSuccessful [AddrInfo]
    addresses AddrInfo -> IO a
    cb = do
        result <- IO (MVar (Either IOException a))
    forall a. IO (MVar a)
    newEmptyMVar
        either E.throwIO pure =<<
            withAsync (tryAddresses result)
                (\Async Bool
    _ -> MVar (Either IOException a) -> IO (Either IOException a)
    forall a. MVar a -> IO a
    takeMVar MVar (Either IOException a)
    result)
      where
        -- https://datatracker.ietf.org/doc/html/rfc8305#section-5
        connectionAttemptDelay :: Int
    connectionAttemptDelay = Int
    250 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000

        tryAddresses :: MVar (Either IOException a) -> IO Bool
    tryAddresses MVar (Either IOException a)
    result = do
            z <- [(AddrInfo, Int)]
    -> ((AddrInfo, Int) -> IO (Either IOException a))
    -> IO [Either IOException a]
    forall (t :: * -> *) a b.
    Traversable t =>
    t a -> (a -> IO b) -> IO (t b)
    forConcurrently ([AddrInfo] -> [Int] -> [(AddrInfo, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [AddrInfo]
    addresses [Int
    0..]) (((AddrInfo, Int) -> IO (Either IOException a))
     -> IO [Either IOException a])
    -> ((AddrInfo, Int) -> IO (Either IOException a))
    -> IO [Either IOException a]
    forall a b. (a -> b) -> a -> b
    $ \(AddrInfo
    addr, Int
    n) -> do
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    threadDelay (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    connectionAttemptDelay
                AddrInfo -> IO (Either IOException a)
    tryAddress AddrInfo
    addr

            case listToMaybe (reverse z) of
                Just e :: Either IOException a
    e@(Left IOException
    _) -> MVar (Either IOException a) -> Either IOException a -> IO Bool
    forall a. MVar a -> a -> IO Bool
    tryPutMVar MVar (Either IOException a)
    result Either IOException a
    e
                Maybe (Either IOException a)
    _               -> [Char] -> IO Bool
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO Bool) -> [Char] -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "tryAddresses invariant violated: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [AddrInfo] -> [Char]
    forall a. Show a => a -> [Char]
    show [AddrInfo]
    addresses
          where
            tryAddress :: AddrInfo -> IO (Either IOException a)
    tryAddress AddrInfo
    addr = do
                r :: Either E.IOException a <- IO a -> IO (Either IOException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO a -> IO (Either IOException a))
    -> IO a -> IO (Either IOException a)
    forall a b. (a -> b) -> a -> b
    $! AddrInfo -> IO a
    cb AddrInfo
    addr
                for_ r $ \a
    _ -> MVar (Either IOException a) -> Either IOException a -> IO Bool
    forall a. MVar a -> a -> IO Bool
    tryPutMVar MVar (Either IOException a)
    result Either IOException a
    r
                pure r