    --
    -- HTTP client for use with io-streams
    --
    -- Copyright © 2012-2021 Athae Eredh Siniath and Others
    --
    -- The code in this file, and the program it is a part of, is
    -- made available to you by its authors as open source software:
    -- you can redistribute it and/or modify it under the terms of
    -- the BSD licence.
    --
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# OPTIONS_HADDOCK hide, not-home #-}

    module Network.Http.Inconvenience (
        URL,
        modifyContextSSL,
        establishConnection,
        get,
        post,
        postForm,
        encodedFormBody,
        multipartFormBody,
        Part,
        simplePart,
        filePart,
        inputStreamPart,
        put,
        baselineContextSSL,
        simpleHandler',
        concatHandler',
        jsonBody,
        jsonHandler,
        TooManyRedirects (..),
        HttpClientError (..),
        -- for testing
        splitURI,
        parseURL,
    ) where

    import Blaze.ByteString.Builder (Builder)
    import qualified Blaze.ByteString.Builder as Builder (
        fromByteString,
        fromLazyByteString,
        fromWord8,
        toByteString,
     )
    import qualified Blaze.ByteString.Builder.Char8 as Builder (fromString)
    import Control.Exception (Exception, bracket, throw)
    import Data.Aeson (FromJSON, Result (..), ToJSON, encode, fromJSON)
    import Data.Aeson.Parser (json')
    import Data.Bits (Bits (..))
    import Data.ByteString.Char8 (ByteString)
    import qualified Data.ByteString.Char8 as S
    import Data.ByteString.Internal (c2w, w2c)
    import Data.Char (intToDigit)
    import Data.HashSet (HashSet)
    import qualified Data.HashSet as HashSet
    import Data.IORef (IORef, newIORef, readIORef, writeIORef)
    import Data.List (intersperse)
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    import Data.Typeable (Typeable)
    import Data.Word (Word16)
    import GHC.Exts
    import GHC.Word (Word8 (..))
    import Network.URI (
        URI (..),
        URIAuth (..),
        escapeURIString,
        isAbsoluteURI,
        isAllowedInURI,
        parseRelativeReference,
        parseURI,
        uriToString,
     )
    import OpenSSL (withOpenSSL)
    import OpenSSL.Session (SSLContext)
    import qualified OpenSSL.Session as SSL
    import System.FilePath.Posix (takeFileName)
    import System.IO.Streams (InputStream, OutputStream)
    import qualified System.IO.Streams as Streams
    import qualified System.IO.Streams.Attoparsec as Streams
    import System.IO.Unsafe (unsafePerformIO)

    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid (Monoid (..), mappend)
    #endif

    import Network.Http.Connection
    import Network.Http.Internal
    import Network.Http.RequestBuilder

    -- (see also http://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/phases.html#standard-cpp-macros
    -- for a list of predefined CPP macros provided by GHC and/or Cabal; see also the cabal user's guide)
    #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
    import System.Directory (doesDirectoryExist)
    #endif

    type URL = ByteString

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

    {- |
    URL-escapes a string (see
    <http://tools.ietf.org/html/rfc2396.html#section-2.4>)
    -}
    urlEncode :: ByteString -> URL
    urlEncode :: ByteString -> ByteString
    urlEncode = Builder -> ByteString
    Builder.toByteString (Builder -> ByteString)
    -> (ByteString -> Builder) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Builder
    urlEncodeBuilder
    {-# INLINE urlEncode #-}

    {- |
    URL-escapes a string (see
    <http://tools.ietf.org/html/rfc2396.html#section-2.4>) into a 'Builder'.
    -}
    urlEncodeBuilder :: ByteString -> Builder
    urlEncodeBuilder :: ByteString -> Builder
    urlEncodeBuilder = Builder -> ByteString -> Builder
    go Builder
    forall a. Monoid a => a
    mempty
      where
        go :: Builder -> ByteString -> Builder
    go !Builder
    b !ByteString
    s = Builder
    -> ((Char, ByteString) -> Builder)
    -> Maybe (Char, ByteString)
    -> Builder
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Builder
    b' (Char, ByteString) -> Builder
    esc (ByteString -> Maybe (Char, ByteString)
    S.uncons ByteString
    y)
          where
            (ByteString
    x, ByteString
    y) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    S.span ((Char -> HashSet Char -> Bool) -> HashSet Char -> Char -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Char -> HashSet Char -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    HashSet.member HashSet Char
    urlEncodeTable) ByteString
    s
            b' :: Builder
    b' = Builder
    b Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` ByteString -> Builder
    Builder.fromByteString ByteString
    x
            esc :: (Char, ByteString) -> Builder
    esc (Char
    c, ByteString
    r) =
                let b'' :: Builder
    b'' =
                        if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' '
                            then Builder
    b' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word8 -> Builder
    Builder.fromWord8 (Char -> Word8
    c2w Char
    '+')
                            else Builder
    b' Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Char -> Builder
    hexd Char
    c
                 in Builder -> ByteString -> Builder
    go Builder
    b'' ByteString
    r

    hexd :: Char -> Builder
    hexd :: Char -> Builder
    hexd Char
    c0 =
        Word8 -> Builder
    Builder.fromWord8 (Char -> Word8
    c2w Char
    '%') Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word8 -> Builder
    Builder.fromWord8 Word8
    hi
            Builder -> Builder -> Builder
    forall a. Monoid a => a -> a -> a
    `mappend` Word8 -> Builder
    Builder.fromWord8 Word8
    low
      where
        !c :: Word8
    c = Char -> Word8
    c2w Char
    c0
        toDigit :: StatusCode -> Word8
    toDigit = Char -> Word8
    c2w (Char -> Word8) -> (StatusCode -> Char) -> StatusCode -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StatusCode -> Char
    intToDigit
        !low :: Word8
    low = StatusCode -> Word8
    toDigit (StatusCode -> Word8) -> StatusCode -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word8 -> StatusCode
    forall a. Enum a => a -> StatusCode
    fromEnum (Word8 -> StatusCode) -> Word8 -> StatusCode
    forall a b. (a -> b) -> a -> b
    $ Word8
    c Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xf
        !hi :: Word8
    hi = StatusCode -> Word8
    toDigit (StatusCode -> Word8) -> StatusCode -> Word8
    forall a b. (a -> b) -> a -> b
    $ (Word8
    c Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xf0) Word8 -> StatusCode -> StatusCode
    `shiftr` StatusCode
    4

        shiftr :: Word8 -> StatusCode -> StatusCode
    shiftr (W8# Word8#
    a#) (I# Int#
    b#) = Int# -> StatusCode
    I# (Word# -> Int#
    word2Int# (Word8# -> Int# -> Word#
    uncheckedShiftRL'# Word8#
    a# Int#
    b#))
    #if MIN_VERSION_base(4,16,0)
        uncheckedShiftRL'# :: Word8# -> Int# -> Word#
    uncheckedShiftRL'# Word8#
    a# Int#
    b# = Word8# -> Word#
    word8ToWord# (Word8# -> Int# -> Word8#
    uncheckedShiftRLWord8# Word8#
    a# Int#
    b#)
    #else
        uncheckedShiftRL'# = uncheckedShiftRL#
    #endif

    urlEncodeTable :: HashSet Char
    urlEncodeTable :: HashSet Char
    urlEncodeTable = [Char] -> HashSet Char
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    HashSet.fromList ([Char] -> HashSet Char) -> [Char] -> HashSet Char
    forall a b. (a -> b) -> a -> b
    $! (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Char -> Bool
    f ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $! (Word8 -> Char) -> [Word8] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Char
    w2c [Word8
    0 .. Word8
    255]
      where
        f :: Char -> Bool
    f Char
    c
            | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'A' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'Z' = Bool
    True
            | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    'a' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    'z' = Bool
    True
            | Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Char
    '0' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char
    '9' = Bool
    True
        f Char
    c = Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    "$-_.!~*'()," :: String)

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

    {-
        The default SSLContext used by the convenience APIs in the http-streams
        library. This is a kludge, unsafe bad yada yada. The technique, however,
        was described on a Haskell Wiki page, so that makes it an officially
        supported kludge. The justification for doing this is a) the functions
        accessing this IORef are themselves all in the IO monad, and b) these
        contortions are necessary to allow the library to be used for https:// URLs
        *without* requiring the developer to do 'withOpenSSL'.
    -}
    global :: IORef SSLContext
    global :: IORef SSLContext
    global = IO (IORef SSLContext) -> IORef SSLContext
    forall a. IO a -> a
    unsafePerformIO (IO (IORef SSLContext) -> IORef SSLContext)
    -> IO (IORef SSLContext) -> IORef SSLContext
    forall a b. (a -> b) -> a -> b
    $ do
        ctx <- IO SSLContext
    baselineContextSSL
        newIORef ctx
    {-# NOINLINE global #-}

    {- |
    Modify the context being used to configure the SSL tunnel used by
    the convenience API functions to make @https://@ connections. The
    default is that setup by 'baselineContextSSL'.
    -}
    modifyContextSSL :: (SSLContext -> IO SSLContext) -> IO ()
    modifyContextSSL :: (SSLContext -> IO SSLContext) -> IO ()
    modifyContextSSL SSLContext -> IO SSLContext
    f = do
        ctx <- IORef SSLContext -> IO SSLContext
    forall a. IORef a -> IO a
    readIORef IORef SSLContext
    global
        ctx' <- f ctx
        writeIORef global ctx'

    {- |
    Given a URL, work out whether it is normal, secure, or unix domain,
    and then open the connection to the webserver including setting the
    appropriate default port if one was not specified in the URL. This
    is what powers the convenience API, but you may find it useful in
    composing your own similar functions.

    For example (on the assumption that your server behaves when given
    an absolute URI as the request path), this will open a connection
    to server @www.example.com@ port @443@ and request @/photo.jpg@:

    >     let url = "https://www.example.com/photo.jpg"
    >
    >     c <- establishConnection url
    >     let q = buildRequest1 $ do
    >                 http GET url
    >     ...
    -}
    establishConnection :: URL -> IO (Connection)
    establishConnection :: ByteString -> IO Connection
    establishConnection ByteString
    r' = do
        URI -> IO Connection
    establish URI
    u
      where
        u :: URI
    u = ByteString -> URI
    parseURL ByteString
    r'
    {-# INLINE establishConnection #-}

    establish :: URI -> IO (Connection)
    establish :: URI -> IO Connection
    establish URI
    u =
        case [Char]
    scheme of
            [Char]
    "http:" -> do
                ByteString -> Port -> IO Connection
    openConnection ByteString
    host Port
    port
            [Char]
    "https:" -> do
                ctx <- IORef SSLContext -> IO SSLContext
    forall a. IORef a -> IO a
    readIORef IORef SSLContext
    global
                openConnectionSSL ctx host ports
            [Char]
    "unix:" -> do
                [Char] -> IO Connection
    openConnectionUnix ([Char] -> IO Connection) -> [Char] -> IO Connection
    forall a b. (a -> b) -> a -> b
    $ URI -> [Char]
    uriPath URI
    u
            [Char]
    _ -> [Char] -> IO Connection
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Unknown URI scheme " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    scheme)
      where
        scheme :: [Char]
    scheme = URI -> [Char]
    uriScheme URI
    u

        auth :: URIAuth
    auth = case URI -> Maybe URIAuth
    uriAuthority URI
    u of
            Just URIAuth
    x -> URIAuth
    x
            Maybe URIAuth
    Nothing -> [Char] -> [Char] -> [Char] -> URIAuth
    URIAuth [Char]
    "" [Char]
    "localhost" [Char]
    ""

        host :: ByteString
    host = [Char] -> ByteString
    S.pack (URIAuth -> [Char]
    uriRegName URIAuth
    auth)
        port :: Port
    port = case URIAuth -> [Char]
    uriPort URIAuth
    auth of
            [Char]
    "" -> Port
    80
            [Char]
    _ -> [Char] -> Port
    forall a. Read a => [Char] -> a
    read ([Char] -> Port) -> [Char] -> Port
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    forall a. HasCallStack => [a] -> [a]
    tail ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ URIAuth -> [Char]
    uriPort URIAuth
    auth :: Word16
        ports :: Port
    ports = case URIAuth -> [Char]
    uriPort URIAuth
    auth of
            [Char]
    "" -> Port
    443
            [Char]
    _ -> [Char] -> Port
    forall a. Read a => [Char] -> a
    read ([Char] -> Port) -> [Char] -> Port
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    forall a. HasCallStack => [a] -> [a]
    tail ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ URIAuth -> [Char]
    uriPort URIAuth
    auth :: Word16

    {- |
    Creates a basic SSL context. This is the SSL context used if you make an
    @\"https:\/\/\"@ request using one of the convenience functions. It
    configures OpenSSL to use the default set of ciphers.

    On Linux, OpenBSD and FreeBSD systems, this function also configures
    OpenSSL to verify certificates using the system/distribution supplied
    certificate authorities' certificates

    On other systems, /no certificate validation is performed/ by the
    generated 'SSLContext' because there is no canonical place to find
    the set of system certificates. When using this library on such system,
    you are encouraged to install the system
    certificates somewhere and create your own 'SSLContext'.
    -}

    {-
        We would like to turn certificate verification on for everyone, but
        this has proved contingent on leveraging platform specific mechanisms
        to reach the certificate store. That logic should probably be in
        hsopenssl, but feel free to change this as appropriate for your OS.
    -}
    baselineContextSSL :: IO SSLContext
    baselineContextSSL :: IO SSLContext
    baselineContextSSL = IO SSLContext -> IO SSLContext
    forall a. IO a -> IO a
    withOpenSSL (IO SSLContext -> IO SSLContext) -> IO SSLContext -> IO SSLContext
    forall a b. (a -> b) -> a -> b
    $ do
        ctx <- IO SSLContext
    SSL.context
        SSL.contextSetDefaultCiphers ctx
    #if defined(darwin_HOST_OS)
        SSL.contextSetVerificationMode ctx SSL.VerifyNone
    #elif defined(mingw32_HOST_OS)
        SSL.contextSetVerificationMode ctx SSL.VerifyNone
    #elif defined(freebsd_HOST_OS)
        SSL.contextSetCAFile ctx "/usr/local/etc/ssl/cert.pem"
        SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
    #elif defined(openbsd_HOST_OS)
        SSL.contextSetCAFile ctx "/etc/ssl/cert.pem"
        SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
    #else
        fedora <- doesDirectoryExist "/etc/pki/tls"
        if fedora
            then do
                SSL.contextSetCAFile ctx "/etc/pki/tls/certs/ca-bundle.crt"
            else do
                SSL.contextSetCADirectory ctx "/etc/ssl/certs"
        SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
    #endif
        return ctx

    parseURL :: URL -> URI
    parseURL :: ByteString -> URI
    parseURL ByteString
    r' =
        case [Char] -> Maybe URI
    parseURI [Char]
    r of
            Just URI
    u -> URI
    u
            Maybe URI
    Nothing -> [Char] -> URI
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Can't parse URI " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    r)
      where
        r :: [Char]
    r = (Char -> Bool) -> [Char] -> [Char]
    escapeURIString Char -> Bool
    isAllowedInURI ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack (Text -> [Char]) -> Text -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    T.decodeUtf8 ByteString
    r'

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

    {-
        Account for bug where "http://www.example.com" is parsed with no
        path element, resulting in an illegal HTTP request line.
    -}

    pathFrom :: URI -> ByteString
    pathFrom :: URI -> ByteString
    pathFrom URI
    u = case ByteString
    url of
        ByteString
    "" -> ByteString
    "/"
        ByteString
    _ -> ByteString
    url
      where
        url :: ByteString
    url =
            Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $! [Char] -> Text
    T.pack
                ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $! [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [URI -> [Char]
    uriPath URI
    u, URI -> [Char]
    uriQuery URI
    u, URI -> [Char]
    uriFragment URI
    u]

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

    {- |
    Issue an HTTP GET request and pass the resultant response to the
    supplied handler function. This code will silently follow redirects,
    to a maximum depth of 5 hops.

    The handler function is as for 'receiveResponse', so you can use one
    of the supplied convenience handlers if you're in a hurry:

    >     x' <- get "http://www.bbc.co.uk/news/" concatHandler

    But as ever the disadvantage of doing this is that you're not doing
    anything intelligent with the HTTP response status code. If you want
    an exception raised in the event of a non @2xx@ response, you can use:

    >     x' <- get "http://www.bbc.co.uk/news/" concatHandler'

    but for anything more refined you'll find it easy to simply write
    your own handler function.

    Throws 'TooManyRedirects' if more than 5 redirects are thrown.
    -}
    get ::
        -- | Resource to GET from.
        URL ->
        -- | Handler function to receive the response from the server.
        (Response -> InputStream ByteString -> IO β) ->
        IO β
    get :: forall β.
    ByteString -> (Response -> InputStream ByteString -> IO β) -> IO β
    get ByteString
    r' Response -> InputStream ByteString -> IO β
    handler = StatusCode
    -> ByteString
    -> (Response -> InputStream ByteString -> IO β)
    -> IO β
    forall {c}.
    StatusCode
    -> ByteString
    -> (Response -> InputStream ByteString -> IO c)
    -> IO c
    getN StatusCode
    0 ByteString
    r' Response -> InputStream ByteString -> IO β
    handler

    getN :: StatusCode
    -> ByteString
    -> (Response -> InputStream ByteString -> IO c)
    -> IO c
    getN StatusCode
    n ByteString
    r' Response -> InputStream ByteString -> IO c
    handler = do
        IO Connection
    -> (Connection -> IO ()) -> (Connection -> IO c) -> IO c
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
            (URI -> IO Connection
    establish URI
    u)
            (Connection -> IO ()
    teardown)
            (Connection -> IO c
    process)
      where
        teardown :: Connection -> IO ()
    teardown = Connection -> IO ()
    closeConnection

        u :: URI
    u = ByteString -> URI
    parseURL ByteString
    r'

        q :: Request
    q = RequestBuilder () -> Request
    forall α. RequestBuilder α -> Request
    buildRequest1 (RequestBuilder () -> Request) -> RequestBuilder () -> Request
    forall a b. (a -> b) -> a -> b
    $ do
            Method -> ByteString -> RequestBuilder ()
    http Method
    GET (URI -> ByteString
    pathFrom URI
    u)
            ByteString -> RequestBuilder ()
    setAccept ByteString
    "*/*"

        process :: Connection -> IO c
    process Connection
    c = do
            Connection -> Request -> (OutputStream Builder -> IO ()) -> IO ()
    forall α.
    Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
    sendRequest Connection
    c Request
    q OutputStream Builder -> IO ()
    emptyBody

            Connection -> (Response -> InputStream ByteString -> IO c) -> IO c
    forall β.
    Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
    receiveResponse Connection
    c (URI
    -> StatusCode
    -> (Response -> InputStream ByteString -> IO c)
    -> Response
    -> InputStream ByteString
    -> IO c
    forall β.
    URI
    -> StatusCode
    -> (Response -> InputStream ByteString -> IO β)
    -> Response
    -> InputStream ByteString
    -> IO β
    wrapRedirect URI
    u StatusCode
    n Response -> InputStream ByteString -> IO c
    handler)

    {-
        This is fairly simple-minded. Improvements could include reusing
        the Connection if the redirect is to the same host, and closing
        the original Connection if it is not. These are both things that
        can be done manually if using the full API, so not worried about
        it for now.
    -}

    wrapRedirect ::
        URI ->
        Int ->
        (Response -> InputStream ByteString -> IO β) ->
        Response ->
        InputStream ByteString ->
        IO β
    wrapRedirect :: forall β.
    URI
    -> StatusCode
    -> (Response -> InputStream ByteString -> IO β)
    -> Response
    -> InputStream ByteString
    -> IO β
    wrapRedirect URI
    u StatusCode
    n Response -> InputStream ByteString -> IO β
    handler Response
    p InputStream ByteString
    i = do
        if (StatusCode
    s StatusCode -> StatusCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == StatusCode
    301 Bool -> Bool -> Bool
    || StatusCode
    s StatusCode -> StatusCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == StatusCode
    302 Bool -> Bool -> Bool
    || StatusCode
    s StatusCode -> StatusCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == StatusCode
    303 Bool -> Bool -> Bool
    || StatusCode
    s StatusCode -> StatusCode -> Bool
    forall a. Eq a => a -> a -> Bool
    == StatusCode
    307)
            then case Maybe ByteString
    lm of
                Just ByteString
    l -> StatusCode
    -> ByteString
    -> (Response -> InputStream ByteString -> IO β)
    -> IO β
    forall {c}.
    StatusCode
    -> ByteString
    -> (Response -> InputStream ByteString -> IO c)
    -> IO c
    getN StatusCode
    n' (URI -> ByteString -> ByteString
    splitURI URI
    u ByteString
    l) Response -> InputStream ByteString -> IO β
    handler
                Maybe ByteString
    Nothing -> Response -> InputStream ByteString -> IO β
    handler Response
    p InputStream ByteString
    i
            else Response -> InputStream ByteString -> IO β
    handler Response
    p InputStream ByteString
    i
      where
        s :: StatusCode
    s = Response -> StatusCode
    getStatusCode Response
    p
        lm :: Maybe ByteString
    lm = Response -> ByteString -> Maybe ByteString
    getHeader Response
    p ByteString
    "Location"
        !n' :: StatusCode
    n' =
            if StatusCode
    n StatusCode -> StatusCode -> Bool
    forall a. Ord a => a -> a -> Bool
    < StatusCode
    5
                then StatusCode
    n StatusCode -> StatusCode -> StatusCode
    forall a. Num a => a -> a -> a
    + StatusCode
    1
                else TooManyRedirects -> StatusCode
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (TooManyRedirects -> StatusCode) -> TooManyRedirects -> StatusCode
    forall a b. (a -> b) -> a -> b
    $! StatusCode -> TooManyRedirects
    TooManyRedirects StatusCode
    n

    splitURI :: URI -> URL -> URL
    splitURI :: URI -> ByteString -> ByteString
    splitURI URI
    old ByteString
    new' =
        let new :: [Char]
    new = ByteString -> [Char]
    S.unpack ByteString
    new'
         in if [Char] -> Bool
    isAbsoluteURI [Char]
    new
                then ByteString
    new'
                else
                    let rel :: Maybe URI
    rel = [Char] -> Maybe URI
    parseRelativeReference [Char]
    new
                     in case Maybe URI
    rel of
                            Maybe URI
    Nothing -> ByteString
    new'
                            Just URI
    x ->
                                [Char] -> ByteString
    S.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                                    ([Char] -> [Char]) -> URI -> [Char] -> [Char]
    uriToString
                                        [Char] -> [Char]
    forall a. a -> a
    id
                                        URI
    old
                                            { uriPath = uriPath x
                                            , uriQuery = uriQuery x
                                            , uriFragment = uriFragment x
                                            }
                                        [Char]
    ""

    data TooManyRedirects = TooManyRedirects Int
        deriving (Typeable, StatusCode -> TooManyRedirects -> [Char] -> [Char]
    [TooManyRedirects] -> [Char] -> [Char]
    TooManyRedirects -> [Char]
    (StatusCode -> TooManyRedirects -> [Char] -> [Char])
    -> (TooManyRedirects -> [Char])
    -> ([TooManyRedirects] -> [Char] -> [Char])
    -> Show TooManyRedirects
    forall a.
    (StatusCode -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: StatusCode -> TooManyRedirects -> [Char] -> [Char]
    showsPrec :: StatusCode -> TooManyRedirects -> [Char] -> [Char]
    $cshow :: TooManyRedirects -> [Char]
    show :: TooManyRedirects -> [Char]
    $cshowList :: [TooManyRedirects] -> [Char] -> [Char]
    showList :: [TooManyRedirects] -> [Char] -> [Char]
    Show, TooManyRedirects -> TooManyRedirects -> Bool
    (TooManyRedirects -> TooManyRedirects -> Bool)
    -> (TooManyRedirects -> TooManyRedirects -> Bool)
    -> Eq TooManyRedirects
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TooManyRedirects -> TooManyRedirects -> Bool
    == :: TooManyRedirects -> TooManyRedirects -> Bool
    $c/= :: TooManyRedirects -> TooManyRedirects -> Bool
    /= :: TooManyRedirects -> TooManyRedirects -> Bool
    Eq)

    instance Exception TooManyRedirects

    {- |
    Send content to a server via an HTTP POST request. Use this
    function if you have an 'OutputStream' with the body content.
    -}
    post ::
        -- | Resource to POST to.
        URL ->
        -- | MIME type of the request body being sent.
        ContentType ->
        -- | Handler function to write content to server.
        (OutputStream Builder -> IO α) ->
        -- | Handler function to receive the response from the server.
        (Response -> InputStream ByteString -> IO β) ->
        IO β
    post :: forall α β.
    ByteString
    -> ByteString
    -> (OutputStream Builder -> IO α)
    -> (Response -> InputStream ByteString -> IO β)
    -> IO β
    post ByteString
    r' ByteString
    t OutputStream Builder -> IO α
    body Response -> InputStream ByteString -> IO β
    handler = do
        IO Connection
    -> (Connection -> IO ()) -> (Connection -> IO β) -> IO β
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
            (URI -> IO Connection
    establish URI
    u)
            (Connection -> IO ()
    teardown)
            (Connection -> IO β
    process)
      where
        teardown :: Connection -> IO ()
    teardown = Connection -> IO ()
    closeConnection

        u :: URI
    u = ByteString -> URI
    parseURL ByteString
    r'

        q :: Request
    q = RequestBuilder () -> Request
    forall α. RequestBuilder α -> Request
    buildRequest1 (RequestBuilder () -> Request) -> RequestBuilder () -> Request
    forall a b. (a -> b) -> a -> b
    $ do
            Method -> ByteString -> RequestBuilder ()
    http Method
    POST (URI -> ByteString
    pathFrom URI
    u)
            ByteString -> RequestBuilder ()
    setAccept ByteString
    "*/*"
            ByteString -> RequestBuilder ()
    setContentType ByteString
    t

        process :: Connection -> IO β
    process Connection
    c = do
            _ <- Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
    forall α.
    Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
    sendRequest Connection
    c Request
    q OutputStream Builder -> IO α
    body

            x <- receiveResponse c handler
            return x

    {- |
    Send form data to a server via an HTTP POST request. This is the
    usual use case; most services expect the body to be MIME type
    @application/x-www-form-urlencoded@ as this is what conventional
    web browsers send on form submission. If you want to POST to a URL
    with an arbitrary Content-Type, use 'post'.
    -}
    postForm ::
        -- | Resource to POST to.
        URL ->
        -- | List of name=value pairs. Will be sent URL-encoded.
        [(ByteString, ByteString)] ->
        -- | Handler function to receive the response from the server.
        (Response -> InputStream ByteString -> IO β) ->
        IO β
    postForm :: forall β.
    ByteString
    -> [(ByteString, ByteString)]
    -> (Response -> InputStream ByteString -> IO β)
    -> IO β
    postForm ByteString
    r' [(ByteString, ByteString)]
    nvs Response -> InputStream ByteString -> IO β
    handler = do
        IO Connection
    -> (Connection -> IO ()) -> (Connection -> IO β) -> IO β
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
            (URI -> IO Connection
    establish URI
    u)
            (Connection -> IO ()
    teardown)
            (Connection -> IO β
    process)
      where
        teardown :: Connection -> IO ()
    teardown = Connection -> IO ()
    closeConnection

        u :: URI
    u = ByteString -> URI
    parseURL ByteString
    r'

        q :: Request
    q = RequestBuilder () -> Request
    forall α. RequestBuilder α -> Request
    buildRequest1 (RequestBuilder () -> Request) -> RequestBuilder () -> Request
    forall a b. (a -> b) -> a -> b
    $ do
            Method -> ByteString -> RequestBuilder ()
    http Method
    POST (URI -> ByteString
    pathFrom URI
    u)
            ByteString -> RequestBuilder ()
    setAccept ByteString
    "*/*"
            ByteString -> RequestBuilder ()
    setContentType ByteString
    "application/x-www-form-urlencoded"

        process :: Connection -> IO β
    process Connection
    c = do
            _ <- Connection -> Request -> (OutputStream Builder -> IO ()) -> IO ()
    forall α.
    Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
    sendRequest Connection
    c Request
    q ([(ByteString, ByteString)] -> OutputStream Builder -> IO ()
    encodedFormBody [(ByteString, ByteString)]
    nvs)

            x <- receiveResponse c handler
            return x

    {- |
    Specify name/value pairs to be sent to the server in the manner
    used by web browsers when submitting a form via a POST request.
    Parameters will be URL encoded per RFC 2396 and combined into a
    single string which will be sent as the body of your request.

    You use this partially applied:

    >     let nvs = [("name","Kermit"),
    >                ("type","frog")]
    >                ("role","stagehand")]
    >
    >     sendRequest c q (encodedFormBody nvs)

    Note that it's going to be up to you to call 'setContentType' with
    a value of @\"application/x-www-form-urlencoded\"@ when building the
    Request object; the 'postForm' convenience (which uses this
    @encodedFormBody@ function) takes care of this for you, obviously.
    -}
    encodedFormBody :: [(ByteString, ByteString)] -> OutputStream Builder -> IO ()
    encodedFormBody :: [(ByteString, ByteString)] -> OutputStream Builder -> IO ()
    encodedFormBody [(ByteString, ByteString)]
    nvs OutputStream Builder
    o = do
        Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just Builder
    b) OutputStream Builder
    o
      where
        b :: Builder
    b = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat ([Builder] -> Builder) -> [Builder] -> Builder
    forall a b. (a -> b) -> a -> b
    $ Builder -> [Builder] -> [Builder]
    forall a. a -> [a] -> [a]
    intersperse ([Char] -> Builder
    Builder.fromString [Char]
    "&") ([Builder] -> [Builder]) -> [Builder] -> [Builder]
    forall a b. (a -> b) -> a -> b
    $ ((ByteString, ByteString) -> Builder)
    -> [(ByteString, ByteString)] -> [Builder]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, ByteString) -> Builder
    combine [(ByteString, ByteString)]
    nvs

        combine :: (ByteString, ByteString) -> Builder
        combine :: (ByteString, ByteString) -> Builder
    combine (ByteString
    n', ByteString
    v') = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ByteString -> Builder
    urlEncodeBuilder ByteString
    n', [Char] -> Builder
    Builder.fromString [Char]
    "=", ByteString -> Builder
    urlEncodeBuilder ByteString
    v']

    {- |
    Build a list of parts into an upload body.

    You use this partially applied:

    >     boundary <- randomBoundary
    >
    >     let q = buildRequest1 $ do
    >           http POST "/api/v1/upload"
    >           setContentMultipart boundary
    >
    >     let parts =
    >             [ simplePart "metadata" Nothing metadata
    >             , filePart "submission" (Just "audio/wav") filepath
    >             ]
    >
    >     sendRequest c q (multipartFormBody boundary parts)

    You /must/ have called 'setContentMultipart' when forming the request or the
    request body you are sending will be invalid and (obviously) you must pass in
    that same 'Boundary' value when calling this function.
    -}
    multipartFormBody :: Boundary -> [Part] -> OutputStream Builder -> IO ()
    multipartFormBody :: Boundary -> [Part] -> OutputStream Builder -> IO ()
    multipartFormBody Boundary
    boundary [Part]
    parts OutputStream Builder
    o = do
        (Part -> IO ()) -> [Part] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Part -> IO ()
    handlePart [Part]
    parts
        IO ()
    handleEnding
      where
        handlePart :: Part -> IO ()
        handlePart :: Part -> IO ()
    handlePart (Part ByteString
    field Maybe ByteString
    possibleContentType Maybe [Char]
    possibleFilename OutputStream Builder -> IO ()
    action) = do
            let h' :: Builder
    h' = Boundary
    -> ByteString -> Maybe [Char] -> Maybe ByteString -> Builder
    composeMultipartBytes Boundary
    boundary ByteString
    field Maybe [Char]
    possibleFilename Maybe ByteString
    possibleContentType
            Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just Builder
    h') OutputStream Builder
    o
            OutputStream Builder -> IO ()
    action OutputStream Builder
    o

        handleEnding :: IO ()
        handleEnding :: IO ()
    handleEnding = do
            Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just (Boundary -> Builder
    composeMultipartEnding Boundary
    boundary)) OutputStream Builder
    o

    {- |
    Information about each of the parts of a @multipart/form-data@ form upload.
    Build these with 'simplePart', 'filePart', or 'inputStreamPart'.
    -}
    data Part = Part
        { Part -> ByteString
    partFieldName :: FieldName
        , Part -> Maybe ByteString
    partContentType :: Maybe ContentType
        , Part -> Maybe [Char]
    partFilename :: Maybe FilePath
        , Part -> OutputStream Builder -> IO ()
    partDataHandler :: OutputStream Builder -> IO ()
        }

    {- |
    Given a simple static set of bytes, send them as a part in a multipart form
    upload. You need to specify the name of the field for the form, and optionally
    can supply a MIME content-type.
    -}
    simplePart :: FieldName -> Maybe ContentType -> ByteString -> Part
    simplePart :: ByteString -> Maybe ByteString -> ByteString -> Part
    simplePart ByteString
    name Maybe ByteString
    possibleContentType ByteString
    x' =
        let action :: OutputStream Builder -> IO ()
    action OutputStream Builder
    o = do
                i1 <- ByteString -> IO (InputStream ByteString)
    Streams.fromByteString ByteString
    x'
                i2 <- Streams.map Builder.fromByteString i1
                Streams.supply i2 o
         in ByteString
    -> Maybe ByteString
    -> Maybe [Char]
    -> (OutputStream Builder -> IO ())
    -> Part
    Part ByteString
    name Maybe ByteString
    possibleContentType Maybe [Char]
    forall a. Maybe a
    Nothing OutputStream Builder -> IO ()
    action

    {- |
    The most common case in using multipart form data is to upload a file. Specify
    the name of the field, optionally a MIME content-type, and then the path to
    the file to be transmitted. The filename (without directory) will be used to
    name the file to the server.
    -}
    filePart :: FieldName -> Maybe ContentType -> FilePath -> Part
    filePart :: ByteString -> Maybe ByteString -> [Char] -> Part
    filePart ByteString
    name Maybe ByteString
    possibleContentType [Char]
    path =
        let action :: OutputStream Builder -> IO ()
    action OutputStream Builder
    o = do
                [Char] -> (InputStream ByteString -> IO ()) -> IO ()
    forall a. [Char] -> (InputStream ByteString -> IO a) -> IO a
    Streams.withFileAsInput
                    [Char]
    path
                    ( \InputStream ByteString
    i1 -> do
                        i2 <- (ByteString -> Builder)
    -> InputStream ByteString -> IO (InputStream Builder)
    forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
    Streams.map ByteString -> Builder
    Builder.fromByteString InputStream ByteString
    i1
                        Streams.supply i2 o
                    )

            filename :: [Char]
    filename = [Char] -> [Char]
    takeFileName [Char]
    path
         in ByteString
    -> Maybe ByteString
    -> Maybe [Char]
    -> (OutputStream Builder -> IO ())
    -> Part
    Part ByteString
    name Maybe ByteString
    possibleContentType ([Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    filename) OutputStream Builder -> IO ()
    action

    {- |
    Build a piece of a multipart submission from an 'InputStream'. You need to
    specify a field name for this piece of the submission, and can optionally
    indicate the MIME type and a filename (if what you are sending is going to be
    interpreted as a file).
    -}
    inputStreamPart :: FieldName -> Maybe ContentType -> Maybe FilePath -> InputStream ByteString -> Part
    inputStreamPart :: ByteString
    -> Maybe ByteString
    -> Maybe [Char]
    -> InputStream ByteString
    -> Part
    inputStreamPart ByteString
    name Maybe ByteString
    possibleContentType Maybe [Char]
    possilbeFilename InputStream ByteString
    i1 =
        let action :: OutputStream Builder -> IO ()
    action OutputStream Builder
    o = do
                i2 <- (ByteString -> Builder)
    -> InputStream ByteString -> IO (InputStream Builder)
    forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
    Streams.map ByteString -> Builder
    Builder.fromByteString InputStream ByteString
    i1
                Streams.supply i2 o
         in ByteString
    -> Maybe ByteString
    -> Maybe [Char]
    -> (OutputStream Builder -> IO ())
    -> Part
    Part ByteString
    name Maybe ByteString
    possibleContentType Maybe [Char]
    possilbeFilename OutputStream Builder -> IO ()
    action

    {- |
    Place content on the server at the given URL via an HTTP PUT
    request, specifying the content type and a function to write the
    content to the supplied 'OutputStream'. You might see:

    >     put "http://s3.example.com/bucket42/object149" "text/plain"
    >         (fileBody "hello.txt") (\p i -> do
    >             putStr $ show p
    >             Streams.connect i stdout)
    -}
    put ::
        -- | Resource to PUT to.
        URL ->
        -- | MIME type of the request body being sent.
        ContentType ->
        -- | Handler function to write content to server.
        (OutputStream Builder -> IO α) ->
        -- | Handler function to receive the response from the server.
        (Response -> InputStream ByteString -> IO β) ->
        IO β
    put :: forall α β.
    ByteString
    -> ByteString
    -> (OutputStream Builder -> IO α)
    -> (Response -> InputStream ByteString -> IO β)
    -> IO β
    put ByteString
    r' ByteString
    t OutputStream Builder -> IO α
    body Response -> InputStream ByteString -> IO β
    handler = do
        IO Connection
    -> (Connection -> IO ()) -> (Connection -> IO β) -> IO β
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
            (URI -> IO Connection
    establish URI
    u)
            (Connection -> IO ()
    teardown)
            (Connection -> IO β
    process)
      where
        teardown :: Connection -> IO ()
    teardown = Connection -> IO ()
    closeConnection

        u :: URI
    u = ByteString -> URI
    parseURL ByteString
    r'

        q :: Request
    q = RequestBuilder () -> Request
    forall α. RequestBuilder α -> Request
    buildRequest1 (RequestBuilder () -> Request) -> RequestBuilder () -> Request
    forall a b. (a -> b) -> a -> b
    $ do
            Method -> ByteString -> RequestBuilder ()
    http Method
    PUT (URI -> ByteString
    pathFrom URI
    u)
            ByteString -> RequestBuilder ()
    setAccept ByteString
    "*/*"
            ByteString -> ByteString -> RequestBuilder ()
    setHeader ByteString
    "Content-Type" ByteString
    t

        process :: Connection -> IO β
    process Connection
    c = do
            _ <- Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
    forall α.
    Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
    sendRequest Connection
    c Request
    q OutputStream Builder -> IO α
    body

            x <- receiveResponse c handler
            return x

    {- |
    A special case of 'concatHandler', this function will return the
    entire response body as a single ByteString, but will throw
    'HttpClientError' if the response status code was other than @2xx@.
    -}
    simpleHandler' :: Response -> InputStream ByteString -> IO ByteString
    simpleHandler' :: Response -> InputStream ByteString -> IO ByteString
    simpleHandler' Response
    p InputStream ByteString
    i =
        if StatusCode
    s StatusCode -> StatusCode -> Bool
    forall a. Ord a => a -> a -> Bool
    >= StatusCode
    300
            then HttpClientError -> IO ByteString
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (StatusCode -> ByteString -> HttpClientError
    HttpClientError StatusCode
    s ByteString
    m)
            else Response -> InputStream ByteString -> IO ByteString
    simpleHandler Response
    p InputStream ByteString
    i
      where
        s :: StatusCode
    s = Response -> StatusCode
    getStatusCode Response
    p
        m :: ByteString
    m = Response -> ByteString
    getStatusMessage Response
    p

    concatHandler' :: Response -> InputStream ByteString -> IO ByteString
    concatHandler' :: Response -> InputStream ByteString -> IO ByteString
    concatHandler' = Response -> InputStream ByteString -> IO ByteString
    simpleHandler'

    data HttpClientError = HttpClientError Int ByteString
        deriving (Typeable)

    instance Exception HttpClientError

    instance Show HttpClientError where
        show :: HttpClientError -> [Char]
    show (HttpClientError StatusCode
    s ByteString
    msg) = StatusCode -> [Char]
    forall a. Show a => a -> [Char]
    Prelude.show StatusCode
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> [Char]
    S.unpack ByteString
    msg

    {-
        There should probably also be HttpServerError and maybe even
        HttpRedirectError, but as these names don't seem to show up
        in the runtime when raised, not sure it's worth the bother. It's
        not like we'd want anything different in their Show instances.
    -}

    {- |
    If you've got an object of a type with a 'ToJSON' instance and you need to
    send that object as JSON up to a web service API, this can help.

    You use this partially applied:

    >    sendRequest c q (jsonBody thing)
    -}
    jsonBody :: ToJSON a => a -> OutputStream Builder -> IO ()
    jsonBody :: forall a. ToJSON a => a -> OutputStream Builder -> IO ()
    jsonBody a
    thing OutputStream Builder
    o = do
        let b :: Builder
    b = ByteString -> Builder
    Builder.fromLazyByteString (a -> ByteString
    forall a. ToJSON a => a -> ByteString
    encode a
    thing)
        Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just Builder
    b) OutputStream Builder
    o

    {- |
    If you're working with a data stream that is in @application/json@,
    then chances are you're using @aeson@ to handle the JSON to Haskell
    decoding. If so, then this helper function might be of use.

    >     v <- get "http://api.example.com/v1/" jsonHandler

    This function feeds the input body to the 'Data.Aeson.Parser.json''
    @attoparsec@ Parser in order to get the aeson Value type. This is then
    marshalled to your type represeting the source data, via the FromJSON
    typeclass.

    The above example was actually insufficient; when working with
    @aeson@ you need to fix the type so it knows what FromJSON instance
    to use. Let's say you're getting Person objects, then it would be

    >     v <- get "http://api.example.com/v1/person/461" jsonHandler :: IO Person

    assuming your Person type had a FromJSON instance, of course.

    /Note/

    This function parses a single top level JSON object or array, which
    is all you're supposed to get if it's a valid document. People do
    all kinds of crazy things though, so beware. Also, this function (like the
    "concatHander" convenience) loads the entire response into memory; it's
    not /streaming/; if you're receiving a document which is (say) a very
    long array of objects then you may want to implement your own
    handler function, perhaps using "Streams.parserToInputStream" and
    the 'Data.Aeson.Parser' combinators directly — with a result type of
    InputStream Value, perhaps — by which you could then iterate over
    the Values one at a time in constant space.
    -}

    {-
        This looks simple. It wasn't. The types involved are rediculous to
        disentangle. The biggest problem is that the Parser type used in
        [aeson] is *NOT* the Parser type from [attoparsec]. But the parsing
        function `json` and `json` from Aeson use the attoparsec Parser even
        though the rest of the top level page is all about Aeson's parser as
        used in FromJSON!

        Anyway, `json` and `json'` are [attoparsec] Parser [aeson] Value; we
        run that using the [io-streams] convenience function
        `parseFromStream` which gets us a Value which is the intermediate
        abstract syntax tree for a  JSON document. Then (and this was hard
        to find) to work with that in terms of the FromJSON typeclass, you
        use the `fromJSON` function which has type (FromJSON α => Value ->
        Result α). Then finally, pull the result out of it. Why in Bog's
        name this wasn't just Either I'll never know.
    -}
    jsonHandler ::
        (FromJSON α) =>
        Response ->
        InputStream ByteString ->
        IO α
    jsonHandler :: forall α. FromJSON α => Response -> InputStream ByteString -> IO α
    jsonHandler Response
    _ InputStream ByteString
    i = do
        v <- Parser Value -> InputStream ByteString -> IO Value
    forall r. Parser r -> InputStream ByteString -> IO r
    Streams.parseFromStream Parser Value
    json' InputStream ByteString
    i -- Value
        let r = Value -> Result α
    forall a. FromJSON a => Value -> Result a
    fromJSON Value
    v -- Result
        case r of
            (Success α
    a) -> α -> IO α
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return α
    a
            (Error [Char]
    str) -> [Char] -> IO α
    forall a. HasCallStack => [Char] -> a
    error [Char]
    str