    {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, CPP, FlexibleContexts #-}
    {- |

    Module      :  Network.Browser
    Copyright   :  See LICENSE file
    License     :  BSD

    Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
    Stability   :  experimental
    Portability :  non-portable (not tested)

    Session-level interactions over HTTP.

    The "Network.Browser" goes beyond the basic "Network.HTTP" functionality in
    providing support for more involved, and real, request/response interactions over
    HTTP. Additional features supported are:

    * HTTP Authentication handling

    * Transparent handling of redirects

    * Cookie stores + transmission.

    * Transaction logging

    * Proxy-mediated connections.

    Example use:

    >    do
    >      (_, rsp)
    >         <- Network.Browser.browse $ do
    >               setAllowRedirects True -- handle HTTP redirects
    >               request $ getRequest "http://www.haskell.org/"
    >      return (take 100 (rspBody rsp))

    -}
    module Network.Browser
           ( BrowserState
           , BrowserAction      -- browser monad, effectively a state monad.
           , Proxy(..)

           , browse             -- :: BrowserAction a -> IO a
           , request            -- :: Request -> BrowserAction Response

           , getBrowserState    -- :: BrowserAction t (BrowserState t)
           , withBrowserState   -- :: BrowserState t -> BrowserAction t a -> BrowserAction t a

           , setAllowRedirects  -- :: Bool -> BrowserAction t ()
           , getAllowRedirects  -- :: BrowserAction t Bool

           , setMaxRedirects    -- :: Int -> BrowserAction t ()
           , getMaxRedirects    -- :: BrowserAction t (Maybe Int)

           , Authority(..)
           , getAuthorities
           , setAuthorities
           , addAuthority
           , Challenge(..)
           , Qop(..)
           , Algorithm(..)

           , getAuthorityGen
           , setAuthorityGen
           , setAllowBasicAuth
           , getAllowBasicAuth

           , setMaxErrorRetries  -- :: Maybe Int -> BrowserAction t ()
           , getMaxErrorRetries  -- :: BrowserAction t (Maybe Int)

           , setMaxPoolSize     -- :: Int -> BrowserAction t ()
           , getMaxPoolSize     -- :: BrowserAction t (Maybe Int)

           , setMaxAuthAttempts  -- :: Maybe Int -> BrowserAction t ()
           , getMaxAuthAttempts  -- :: BrowserAction t (Maybe Int)

           , setCookieFilter     -- :: (URI -> Cookie -> IO Bool) -> BrowserAction t ()
           , getCookieFilter     -- :: BrowserAction t (URI -> Cookie -> IO Bool)
           , defaultCookieFilter -- :: URI -> Cookie -> IO Bool
           , userCookieFilter    -- :: URI -> Cookie -> IO Bool

           , Cookie(..)
           , getCookies        -- :: BrowserAction t [Cookie]
           , setCookies        -- :: [Cookie] -> BrowserAction t ()
           , addCookie         -- :: Cookie   -> BrowserAction t ()

           , setErrHandler     -- :: (String -> IO ()) -> BrowserAction t ()
           , setOutHandler     -- :: (String -> IO ()) -> BrowserAction t ()

           , setEventHandler   -- :: (BrowserEvent -> BrowserAction t ()) -> BrowserAction t ()

           , BrowserEvent(..)
           , BrowserEventType(..)
           , RequestID

           , setProxy         -- :: Proxy -> BrowserAction t ()
           , getProxy         -- :: BrowserAction t Proxy

           , setCheckForProxy -- :: Bool -> BrowserAction t ()
           , getCheckForProxy -- :: BrowserAction t Bool

           , setDebugLog      -- :: Maybe String -> BrowserAction t ()

           , getUserAgent     -- :: BrowserAction t String
           , setUserAgent     -- :: String -> BrowserAction t ()

           , out              -- :: String -> BrowserAction t ()
           , err              -- :: String -> BrowserAction t ()
           , ioAction         -- :: IO a -> BrowserAction a

           , defaultGETRequest
           , defaultGETRequest_

           , formToRequest
           , uriDefaultTo

             -- old and half-baked; don't use:
           , Form(..)
           , FormVar
           ) where

    import Network.URI
       ( URI(..)
       , URIAuth(..)
       , parseURI, parseURIReference, relativeTo
       )
    import Network.StreamDebugger (debugByteStream)
    import Network.HTTP hiding ( sendHTTP_notify )
    import Network.HTTP.HandleStream ( sendHTTP_notify )
    import Network.HTTP.Auth
    import Network.HTTP.Cookie
    import Network.HTTP.Proxy

    import Network.Stream ( ConnError(..), Result )
    import Network.BufferType
    #if (MIN_VERSION_base(4,9,0)) && !(MIN_VERSION_base(4,13,0))
    import Control.Monad.Fail
    #endif

    import Data.Char (toLower)
    import Data.List (isPrefixOf)
    import Data.Maybe (fromMaybe, listToMaybe, catMaybes )
    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative (Applicative (..), (<$>))
    #endif
    import Control.Monad (filterM, forM_, when)
    import Control.Monad.IO.Class
       ( MonadIO (..) )
    import Control.Monad.State
       ( MonadState(..), gets, modify, StateT (..), evalStateT, withStateT )

    import qualified System.IO
       ( hSetBuffering, hPutStr, stdout, stdin, hGetChar
       , BufferMode(NoBuffering, LineBuffering)
       )
    import Data.Time.Clock ( UTCTime, getCurrentTime )

    ------------------------------------------------------------------
    ----------------------- Cookie Stuff -----------------------------
    ------------------------------------------------------------------

    -- | @defaultCookieFilter@ is the initial cookie acceptance filter.
    -- It welcomes them all into the store @:-)@
    defaultCookieFilter :: URI -> Cookie -> IO Bool
    defaultCookieFilter :: URI -> Cookie -> IO Bool
    defaultCookieFilter URI
    _url Cookie
    _cky = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    -- | @userCookieFilter@ is a handy acceptance filter, asking the
    -- user if he/she is willing to accept an incoming cookie before
    -- adding it to the store.
    userCookieFilter :: URI -> Cookie -> IO Bool
    userCookieFilter :: URI -> Cookie -> IO Bool
    userCookieFilter URI
    url Cookie
    cky = do
        do String -> IO ()
    putStrLn (String
    "Set-Cookie received when requesting: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URI -> String
    forall a. Show a => a -> String
    show URI
    url)
           case Cookie -> Maybe String
    ckComment Cookie
    cky of
              Maybe String
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Just String
    x  -> String -> IO ()
    putStrLn (String
    "Cookie Comment:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x)
           let pth :: String
    pth = String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" (Char
    '/'Char -> String -> String
    forall a. a -> [a] -> [a]
    :) (Cookie -> Maybe String
    ckPath Cookie
    cky)
           String -> IO ()
    putStrLn (String
    "Domain/Path: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Cookie -> String
    ckDomain Cookie
    cky String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pth)
           String -> IO ()
    putStrLn (Cookie -> String
    ckName Cookie
    cky String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    '=' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Cookie -> String
    ckValue Cookie
    cky)
           Handle -> BufferMode -> IO ()
    System.IO.hSetBuffering Handle
    System.IO.stdout BufferMode
    System.IO.NoBuffering
           Handle -> BufferMode -> IO ()
    System.IO.hSetBuffering Handle
    System.IO.stdin BufferMode
    System.IO.NoBuffering
           Handle -> String -> IO ()
    System.IO.hPutStr Handle
    System.IO.stdout String
    "Accept [y/n]? "
           x <- Handle -> IO Char
    System.IO.hGetChar Handle
    System.IO.stdin
           System.IO.hSetBuffering System.IO.stdin System.IO.LineBuffering
           System.IO.hSetBuffering System.IO.stdout System.IO.LineBuffering
           return (toLower x == 'y')

    -- | @addCookie c@ adds a cookie to the browser state, removing duplicates.
    addCookie :: Cookie -> BrowserAction t ()
    addCookie :: forall t. Cookie -> BrowserAction t ()
    addCookie Cookie
    c = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b{bsCookies = c : filter (/=c) (bsCookies b) })

    -- | @setCookies cookies@ replaces the set of cookies known to
    -- the browser to @cookies@. Useful when wanting to restore cookies
    -- used across 'browse' invocations.
    setCookies :: [Cookie] -> BrowserAction t ()
    setCookies :: forall t. [Cookie] -> BrowserAction t ()
    setCookies [Cookie]
    cs = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsCookies=cs })

    -- | @getCookies@ returns the current set of cookies known to
    -- the browser.
    getCookies :: BrowserAction t [Cookie]
    getCookies :: forall t. BrowserAction t [Cookie]
    getCookies = (BrowserState t -> [Cookie]) -> BrowserAction t [Cookie]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> [Cookie]
    forall connection. BrowserState connection -> [Cookie]
    bsCookies

    -- ...get domain specific cookies...
    -- ... this needs changing for consistency with rfc2109...
    -- ... currently too broad.
    getCookiesFor :: String -> String -> BrowserAction t [Cookie]
    getCookiesFor :: forall t. String -> String -> BrowserAction t [Cookie]
    getCookiesFor String
    dom String
    path =
        do cks <- BrowserAction t [Cookie]
    forall t. BrowserAction t [Cookie]
    getCookies
           return (filter cookiematch cks)
        where
            cookiematch :: Cookie -> Bool
            cookiematch :: Cookie -> Bool
    cookiematch = (String, String) -> Cookie -> Bool
    cookieMatch (String
    dom,String
    path)

    -- | @setCookieFilter fn@ sets the cookie acceptance filter to @fn@.
    setCookieFilter :: (URI -> Cookie -> IO Bool) -> BrowserAction t ()
    setCookieFilter :: forall t. (URI -> Cookie -> IO Bool) -> BrowserAction t ()
    setCookieFilter URI -> Cookie -> IO Bool
    f = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsCookieFilter=f })

    -- | @getCookieFilter@ returns the current cookie acceptance filter.
    getCookieFilter :: BrowserAction t (URI -> Cookie -> IO Bool)
    getCookieFilter :: forall t. BrowserAction t (URI -> Cookie -> IO Bool)
    getCookieFilter = (BrowserState t -> URI -> Cookie -> IO Bool)
    -> BrowserAction t (URI -> Cookie -> IO Bool)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> URI -> Cookie -> IO Bool
    forall connection.
    BrowserState connection -> URI -> Cookie -> IO Bool
    bsCookieFilter

    ------------------------------------------------------------------
    ----------------------- Authorisation Stuff ----------------------
    ------------------------------------------------------------------

    {-

    The browser handles 401 responses in the following manner:
      1) extract all WWW-Authenticate headers from a 401 response
      2) rewrite each as a Challenge object, using "headerToChallenge"
      3) pick a challenge to respond to, usually the strongest
         challenge understood by the client, using "pickChallenge"
      4) generate a username/password combination using the browsers
         "bsAuthorityGen" function (the default behaviour is to ask
         the user)
      5) build an Authority object based upon the challenge and user
         data, store this new Authority in the browser state
      6) convert the Authority to a request header and add this
         to a request using "withAuthority"
      7) send the amended request

    Note that by default requests are annotated with authority headers
    before the first sending, based upon previously generated Authority
    objects (which contain domain information).  Once a specific authority
    is added to a rejected request this predictive annotation is suppressed.

    407 responses are handled in a similar manner, except
       a) Authorities are not collected, only a single proxy authority
          is kept by the browser
       b) If the proxy used by the browser (type Proxy) is NoProxy, then
          a 407 response will generate output on the "err" stream and
          the response will be returned.

    Notes:
     - digest authentication so far ignores qop, so fails to authenticate
       properly with qop=auth-int challenges
     - calculates a1 more than necessary
     - doesn't reverse authenticate
     - doesn't properly receive AuthenticationInfo headers, so fails
       to use next-nonce etc

    -}

    -- | Return authorities for a given domain and path.
    -- Assumes "dom" is lower case
    getAuthFor :: String -> String -> BrowserAction t [Authority]
    getAuthFor :: forall t. String -> String -> BrowserAction t [Authority]
    getAuthFor String
    dom String
    pth = BrowserAction t [Authority]
    forall t. BrowserAction t [Authority]
    getAuthorities BrowserAction t [Authority]
    -> ([Authority] -> BrowserAction t [Authority])
    -> BrowserAction t [Authority]
    forall a b.
    BrowserAction t a -> (a -> BrowserAction t b) -> BrowserAction t b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Authority] -> BrowserAction t [Authority]
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Authority] -> BrowserAction t [Authority])
    -> ([Authority] -> [Authority])
    -> [Authority]
    -> BrowserAction t [Authority]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Authority -> Bool) -> [Authority] -> [Authority]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Authority -> Bool
    match)
       where
        match :: Authority -> Bool
        match :: Authority -> Bool
    match au :: Authority
    au@AuthBasic{}  = URI -> Bool
    matchURI (Authority -> URI
    auSite Authority
    au)
        match au :: Authority
    au@AuthDigest{} = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ((URI -> Bool) -> [URI] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map URI -> Bool
    matchURI (Authority -> [URI]
    auDomain Authority
    au))

        matchURI :: URI -> Bool
        matchURI :: URI -> Bool
    matchURI URI
    s = (URI -> String
    uriToAuthorityString URI
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    dom) Bool -> Bool -> Bool
    && (URI -> String
    uriPath URI
    s String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    pth)

    -- | @getAuthorities@ return the current set of @Authority@s known
    -- to the browser.
    getAuthorities :: BrowserAction t [Authority]
    getAuthorities :: forall t. BrowserAction t [Authority]
    getAuthorities = (BrowserState t -> [Authority]) -> BrowserAction t [Authority]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> [Authority]
    forall connection. BrowserState connection -> [Authority]
    bsAuthorities

    -- @setAuthorities as@ replaces the Browser's known set
    -- of 'Authority's to @as@.
    setAuthorities :: [Authority] -> BrowserAction t ()
    setAuthorities :: forall t. [Authority] -> BrowserAction t ()
    setAuthorities [Authority]
    as = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsAuthorities=as })

    -- @addAuthority a@ adds 'Authority' @a@ to the Browser's
    -- set of known authorities.
    addAuthority :: Authority -> BrowserAction t ()
    addAuthority :: forall t. Authority -> BrowserAction t ()
    addAuthority Authority
    a = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsAuthorities=a:bsAuthorities b })

    -- | @getAuthorityGen@ returns the current authority generator
    getAuthorityGen :: BrowserAction t (URI -> String -> IO (Maybe (String,String)))
    getAuthorityGen :: forall t.
    BrowserAction t (URI -> String -> IO (Maybe (String, String)))
    getAuthorityGen = (BrowserState t -> URI -> String -> IO (Maybe (String, String)))
    -> BrowserAction t (URI -> String -> IO (Maybe (String, String)))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> URI -> String -> IO (Maybe (String, String))
    forall connection.
    BrowserState connection
    -> URI -> String -> IO (Maybe (String, String))
    bsAuthorityGen

    -- | @setAuthorityGen genAct@ sets the auth generator to @genAct@.
    setAuthorityGen :: (URI -> String -> IO (Maybe (String,String))) -> BrowserAction t ()
    setAuthorityGen :: forall t.
    (URI -> String -> IO (Maybe (String, String)))
    -> BrowserAction t ()
    setAuthorityGen URI -> String -> IO (Maybe (String, String))
    f = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsAuthorityGen=f })

    -- | @setAllowBasicAuth onOff@ enables\/disables HTTP Basic Authentication.
    setAllowBasicAuth :: Bool -> BrowserAction t ()
    setAllowBasicAuth :: forall t. Bool -> BrowserAction t ()
    setAllowBasicAuth Bool
    ba = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsAllowBasicAuth=ba })

    getAllowBasicAuth :: BrowserAction t Bool
    getAllowBasicAuth :: forall t. BrowserAction t Bool
    getAllowBasicAuth = (BrowserState t -> Bool) -> BrowserAction t Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Bool
    forall connection. BrowserState connection -> Bool
    bsAllowBasicAuth

    -- | @setMaxAuthAttempts mbMax@ sets the maximum number of authentication attempts
    -- to do. If @Nothing@, revert to default max.
    setMaxAuthAttempts :: Maybe Int -> BrowserAction t ()
    setMaxAuthAttempts :: forall t. Maybe Int -> BrowserAction t ()
    setMaxAuthAttempts Maybe Int
    mb
     | Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 Maybe Int
    mb Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = () -> BrowserAction t ()
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
     | Bool
    otherwise          = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\ BrowserState t
    b -> BrowserState t
    b{bsMaxAuthAttempts=mb})

    -- | @getMaxAuthAttempts@ returns the current max auth attempts. If @Nothing@,
    -- the browser's default is used.
    getMaxAuthAttempts :: BrowserAction t (Maybe Int)
    getMaxAuthAttempts :: forall t. BrowserAction t (Maybe Int)
    getMaxAuthAttempts = (BrowserState t -> Maybe Int) -> BrowserAction t (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Maybe Int
    forall connection. BrowserState connection -> Maybe Int
    bsMaxAuthAttempts

    -- | @setMaxErrorRetries mbMax@ sets the maximum number of attempts at
    -- transmitting a request. If @Nothing@, rever to default max.
    setMaxErrorRetries :: Maybe Int -> BrowserAction t ()
    setMaxErrorRetries :: forall t. Maybe Int -> BrowserAction t ()
    setMaxErrorRetries Maybe Int
    mb
     | Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 Maybe Int
    mb Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = () -> BrowserAction t ()
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
     | Bool
    otherwise          = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\ BrowserState t
    b -> BrowserState t
    b{bsMaxErrorRetries=mb})

    -- | @getMaxErrorRetries@ returns the current max number of error retries.
    getMaxErrorRetries :: BrowserAction t (Maybe Int)
    getMaxErrorRetries :: forall t. BrowserAction t (Maybe Int)
    getMaxErrorRetries = (BrowserState t -> Maybe Int) -> BrowserAction t (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Maybe Int
    forall connection. BrowserState connection -> Maybe Int
    bsMaxErrorRetries

    -- TO BE CHANGED!!!
    pickChallenge :: Bool -> [Challenge] -> Maybe Challenge
    pickChallenge :: Bool -> [Challenge] -> Maybe Challenge
    pickChallenge Bool
    allowBasic []
     | Bool
    allowBasic = Challenge -> Maybe Challenge
    forall a. a -> Maybe a
    Just (String -> Challenge
    ChalBasic String
    "/") -- manufacture a challenge if one missing; more robust.
    pickChallenge Bool
    _ [Challenge]
    ls = [Challenge] -> Maybe Challenge
    forall a. [a] -> Maybe a
    listToMaybe [Challenge]
    ls

    -- | Retrieve a likely looking authority for a Request.
    anticipateChallenge :: Request ty -> BrowserAction t (Maybe Authority)
    anticipateChallenge :: forall ty t. Request ty -> BrowserAction t (Maybe Authority)
    anticipateChallenge Request ty
    rq =
        let uri :: URI
    uri = Request ty -> URI
    forall a. Request a -> URI
    rqURI Request ty
    rq in
        do { authlist <- String -> String -> BrowserAction t [Authority]
    forall t. String -> String -> BrowserAction t [Authority]
    getAuthFor (URIAuth -> String
    uriAuthToString (URIAuth -> String) -> URIAuth -> String
    forall a b. (a -> b) -> a -> b
    $ Request ty -> URIAuth
    forall ty. Request ty -> URIAuth
    reqURIAuth Request ty
    rq) (URI -> String
    uriPath URI
    uri)
           ; return (listToMaybe authlist)
           }

    -- | Asking the user to respond to a challenge
    challengeToAuthority :: URI -> Challenge -> BrowserAction t (Maybe Authority)
    challengeToAuthority :: forall t. URI -> Challenge -> BrowserAction t (Maybe Authority)
    challengeToAuthority URI
    uri Challenge
    ch
     | Bool -> Bool
    not (Challenge -> Bool
    answerable Challenge
    ch) = Maybe Authority -> BrowserAction t (Maybe Authority)
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Authority
    forall a. Maybe a
    Nothing
     | Bool
    otherwise = do
          -- prompt user for authority
        prompt <- BrowserAction t (URI -> String -> IO (Maybe (String, String)))
    forall t.
    BrowserAction t (URI -> String -> IO (Maybe (String, String)))
    getAuthorityGen
        userdetails <- liftIO $ prompt uri (chRealm ch)
        case userdetails of
         Maybe (String, String)
    Nothing    -> Maybe Authority -> BrowserAction t (Maybe Authority)
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Authority
    forall a. Maybe a
    Nothing
         Just (String
    u,String
    p) -> Maybe Authority -> BrowserAction t (Maybe Authority)
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Authority -> Maybe Authority
    forall a. a -> Maybe a
    Just (Authority -> Maybe Authority) -> Authority -> Maybe Authority
    forall a b. (a -> b) -> a -> b
    $ Challenge -> String -> String -> Authority
    buildAuth Challenge
    ch String
    u String
    p)
     where
      answerable :: Challenge -> Bool
      answerable :: Challenge -> Bool
    answerable ChalBasic{} = Bool
    True
      answerable Challenge
    chall       = (Challenge -> Maybe Algorithm
    chAlgorithm Challenge
    chall) Maybe Algorithm -> Maybe Algorithm -> Bool
    forall a. Eq a => a -> a -> Bool
    == Algorithm -> Maybe Algorithm
    forall a. a -> Maybe a
    Just Algorithm
    AlgMD5

      buildAuth :: Challenge -> String -> String -> Authority
      buildAuth :: Challenge -> String -> String -> Authority
    buildAuth (ChalBasic String
    r) String
    u String
    p =
           AuthBasic { auSite :: URI
    auSite=URI
    uri
                     , auRealm :: String
    auRealm=String
    r
                     , auUsername :: String
    auUsername=String
    u
                     , auPassword :: String
    auPassword=String
    p
                     }

        -- note to self: this is a pretty stupid operation
        -- to perform isn't it? ChalX and AuthX are so very
        -- similar.
      buildAuth (ChalDigest String
    r [URI]
    d String
    n Maybe String
    o Bool
    _stale Maybe Algorithm
    a [Qop]
    q) String
    u String
    p =
                AuthDigest { auRealm :: String
    auRealm=String
    r
                           , auUsername :: String
    auUsername=String
    u
                           , auPassword :: String
    auPassword=String
    p
                           , auDomain :: [URI]
    auDomain=[URI]
    d
                           , auNonce :: String
    auNonce=String
    n
                           , auOpaque :: Maybe String
    auOpaque=Maybe String
    o
                           , auAlgorithm :: Maybe Algorithm
    auAlgorithm=Maybe Algorithm
    a
                           , auQop :: [Qop]
    auQop=[Qop]
    q
                           }

    ------------------------------------------------------------------
    ------------------ Browser State Actions -------------------------
    ------------------------------------------------------------------

    -- | @BrowserState@ is the (large) record type tracking the current
    -- settings of the browser.
    data BrowserState connection
     = BS { forall connection. BrowserState connection -> String -> IO ()
    bsErr, forall connection. BrowserState connection -> String -> IO ()
    bsOut      :: String -> IO ()
          , forall connection. BrowserState connection -> [Cookie]
    bsCookies         :: [Cookie]
          , forall connection.
    BrowserState connection -> URI -> Cookie -> IO Bool
    bsCookieFilter    :: URI -> Cookie -> IO Bool
          , forall connection.
    BrowserState connection
    -> URI -> String -> IO (Maybe (String, String))
    bsAuthorityGen    :: URI -> String -> IO (Maybe (String,String))
          , forall connection. BrowserState connection -> [Authority]
    bsAuthorities     :: [Authority]
          , forall connection. BrowserState connection -> Bool
    bsAllowRedirects  :: Bool
          , forall connection. BrowserState connection -> Bool
    bsAllowBasicAuth  :: Bool
          , forall connection. BrowserState connection -> Maybe Int
    bsMaxRedirects    :: Maybe Int
          , forall connection. BrowserState connection -> Maybe Int
    bsMaxErrorRetries :: Maybe Int
          , forall connection. BrowserState connection -> Maybe Int
    bsMaxAuthAttempts :: Maybe Int
          , forall connection. BrowserState connection -> Maybe Int
    bsMaxPoolSize     :: Maybe Int
          , forall connection. BrowserState connection -> [connection]
    bsConnectionPool  :: [connection]
          , forall connection. BrowserState connection -> Bool
    bsCheckProxy      :: Bool
          , forall connection. BrowserState connection -> Proxy
    bsProxy           :: Proxy
          , forall connection. BrowserState connection -> Maybe String
    bsDebug           :: Maybe String
          , forall connection.
    BrowserState connection
    -> Maybe (BrowserEvent -> BrowserAction connection ())
    bsEvent           :: Maybe (BrowserEvent -> BrowserAction connection ())
          , forall connection. BrowserState connection -> Int
    bsRequestID       :: RequestID
          , forall connection. BrowserState connection -> Maybe String
    bsUserAgent       :: Maybe String
          }

    instance Show (BrowserState t) where
        show :: BrowserState t -> String
    show BrowserState t
    bs =  String
    "BrowserState { "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Cookie] -> String -> String
    forall a. Show a => a -> String -> String
    shows (BrowserState t -> [Cookie]
    forall connection. BrowserState connection -> [Cookie]
    bsCookies BrowserState t
    bs) (String
    "\n"
               {- ++ show (bsAuthorities bs) ++ "\n"-}
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "AllowRedirects: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String -> String
    forall a. Show a => a -> String -> String
    shows (BrowserState t -> Bool
    forall connection. BrowserState connection -> Bool
    bsAllowRedirects BrowserState t
    bs) String
    "} ")

    -- | @BrowserAction@ is the IO monad, but carrying along a 'BrowserState'.
    newtype BrowserAction conn a
     = BA { forall conn a.
    BrowserAction conn a -> StateT (BrowserState conn) IO a
    unBA :: StateT (BrowserState conn) IO a }
     deriving
     ( (forall a b.
     (a -> b) -> BrowserAction conn a -> BrowserAction conn b)
    -> (forall a b. a -> BrowserAction conn b -> BrowserAction conn a)
    -> Functor (BrowserAction conn)
    forall a b. a -> BrowserAction conn b -> BrowserAction conn a
    forall a b.
    (a -> b) -> BrowserAction conn a -> BrowserAction conn b
    forall conn a b. a -> BrowserAction conn b -> BrowserAction conn a
    forall conn a b.
    (a -> b) -> BrowserAction conn a -> BrowserAction conn b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall conn a b.
    (a -> b) -> BrowserAction conn a -> BrowserAction conn b
    fmap :: forall a b.
    (a -> b) -> BrowserAction conn a -> BrowserAction conn b
    $c<$ :: forall conn a b. a -> BrowserAction conn b -> BrowserAction conn a
    <$ :: forall a b. a -> BrowserAction conn b -> BrowserAction conn a
    Functor, Functor (BrowserAction conn)
    Functor (BrowserAction conn) =>
    (forall a. a -> BrowserAction conn a)
    -> (forall a b.
        BrowserAction conn (a -> b)
        -> BrowserAction conn a -> BrowserAction conn b)
    -> (forall a b c.
        (a -> b -> c)
        -> BrowserAction conn a
        -> BrowserAction conn b
        -> BrowserAction conn c)
    -> (forall a b.
        BrowserAction conn a
        -> BrowserAction conn b -> BrowserAction conn b)
    -> (forall a b.
        BrowserAction conn a
        -> BrowserAction conn b -> BrowserAction conn a)
    -> Applicative (BrowserAction conn)
    forall conn. Functor (BrowserAction conn)
    forall a. a -> BrowserAction conn a
    forall conn a. a -> BrowserAction conn a
    forall a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn a
    forall a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    forall a b.
    BrowserAction conn (a -> b)
    -> BrowserAction conn a -> BrowserAction conn b
    forall conn a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn a
    forall conn a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    forall conn a b.
    BrowserAction conn (a -> b)
    -> BrowserAction conn a -> BrowserAction conn b
    forall a b c.
    (a -> b -> c)
    -> BrowserAction conn a
    -> BrowserAction conn b
    -> BrowserAction conn c
    forall conn a b c.
    (a -> b -> c)
    -> BrowserAction conn a
    -> BrowserAction conn b
    -> BrowserAction conn c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall conn a. a -> BrowserAction conn a
    pure :: forall a. a -> BrowserAction conn a
    $c<*> :: forall conn a b.
    BrowserAction conn (a -> b)
    -> BrowserAction conn a -> BrowserAction conn b
    <*> :: forall a b.
    BrowserAction conn (a -> b)
    -> BrowserAction conn a -> BrowserAction conn b
    $cliftA2 :: forall conn a b c.
    (a -> b -> c)
    -> BrowserAction conn a
    -> BrowserAction conn b
    -> BrowserAction conn c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> BrowserAction conn a
    -> BrowserAction conn b
    -> BrowserAction conn c
    $c*> :: forall conn a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    *> :: forall a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    $c<* :: forall conn a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn a
    <* :: forall a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn a
    Applicative, Applicative (BrowserAction conn)
    Applicative (BrowserAction conn) =>
    (forall a b.
     BrowserAction conn a
     -> (a -> BrowserAction conn b) -> BrowserAction conn b)
    -> (forall a b.
        BrowserAction conn a
        -> BrowserAction conn b -> BrowserAction conn b)
    -> (forall a. a -> BrowserAction conn a)
    -> Monad (BrowserAction conn)
    forall conn. Applicative (BrowserAction conn)
    forall a. a -> BrowserAction conn a
    forall conn a. a -> BrowserAction conn a
    forall a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    forall a b.
    BrowserAction conn a
    -> (a -> BrowserAction conn b) -> BrowserAction conn b
    forall conn a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    forall conn a b.
    BrowserAction conn a
    -> (a -> BrowserAction conn b) -> BrowserAction conn b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall conn a b.
    BrowserAction conn a
    -> (a -> BrowserAction conn b) -> BrowserAction conn b
    >>= :: forall a b.
    BrowserAction conn a
    -> (a -> BrowserAction conn b) -> BrowserAction conn b
    $c>> :: forall conn a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    >> :: forall a b.
    BrowserAction conn a
    -> BrowserAction conn b -> BrowserAction conn b
    $creturn :: forall conn a. a -> BrowserAction conn a
    return :: forall a. a -> BrowserAction conn a
    Monad, Monad (BrowserAction conn)
    Monad (BrowserAction conn) =>
    (forall a. IO a -> BrowserAction conn a)
    -> MonadIO (BrowserAction conn)
    forall conn. Monad (BrowserAction conn)
    forall a. IO a -> BrowserAction conn a
    forall conn a. IO a -> BrowserAction conn a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall conn a. IO a -> BrowserAction conn a
    liftIO :: forall a. IO a -> BrowserAction conn a
    MonadIO, MonadState (BrowserState conn)
    #if MIN_VERSION_base(4,9,0)
     , Monad (BrowserAction conn)
    Monad (BrowserAction conn) =>
    (forall a. String -> BrowserAction conn a)
    -> MonadFail (BrowserAction conn)
    forall conn. Monad (BrowserAction conn)
    forall a. String -> BrowserAction conn a
    forall conn a. String -> BrowserAction conn a
    forall (m :: * -> *).
    Monad m =>
    (forall a. String -> m a) -> MonadFail m
    $cfail :: forall conn a. String -> BrowserAction conn a
    fail :: forall a. String -> BrowserAction conn a
    MonadFail
    #endif
     )

    runBA :: BrowserState conn -> BrowserAction conn a -> IO a
    runBA :: forall conn a. BrowserState conn -> BrowserAction conn a -> IO a
    runBA BrowserState conn
    bs = (StateT (BrowserState conn) IO a -> BrowserState conn -> IO a)
    -> BrowserState conn -> StateT (BrowserState conn) IO a -> IO a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT (BrowserState conn) IO a -> BrowserState conn -> IO a
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT BrowserState conn
    bs (StateT (BrowserState conn) IO a -> IO a)
    -> (BrowserAction conn a -> StateT (BrowserState conn) IO a)
    -> BrowserAction conn a
    -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BrowserAction conn a -> StateT (BrowserState conn) IO a
    forall conn a.
    BrowserAction conn a -> StateT (BrowserState conn) IO a
    unBA

    -- | @browse act@ is the toplevel action to perform a 'BrowserAction'.
    -- Example use: @browse (request (getRequest yourURL))@.
    browse :: BrowserAction conn a -> IO a
    browse :: forall conn a. BrowserAction conn a -> IO a
    browse = BrowserState conn -> BrowserAction conn a -> IO a
    forall conn a. BrowserState conn -> BrowserAction conn a -> IO a
    runBA BrowserState conn
    forall t. BrowserState t
    defaultBrowserState

    -- | The default browser state has the settings
    defaultBrowserState :: BrowserState t
    defaultBrowserState :: forall t. BrowserState t
    defaultBrowserState = BrowserState t
    forall t. BrowserState t
    res
     where
       res :: BrowserState connection
    res = BS
         { bsErr :: String -> IO ()
    bsErr              = String -> IO ()
    putStrLn
         , bsOut :: String -> IO ()
    bsOut              = String -> IO ()
    putStrLn
         , bsCookies :: [Cookie]
    bsCookies          = []
         , bsCookieFilter :: URI -> Cookie -> IO Bool
    bsCookieFilter     = URI -> Cookie -> IO Bool
    defaultCookieFilter
         , bsAuthorityGen :: URI -> String -> IO (Maybe (String, String))
    bsAuthorityGen     = \ URI
    _uri String
    _realm -> do
              BrowserState connection -> String -> IO ()
    forall connection. BrowserState connection -> String -> IO ()
    bsErr BrowserState connection
    res String
    "No action for prompting/generating user+password credentials provided (use: setAuthorityGen); returning Nothing"
              Maybe (String, String) -> IO (Maybe (String, String))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (String, String)
    forall a. Maybe a
    Nothing
         , bsAuthorities :: [Authority]
    bsAuthorities      = []
         , bsAllowRedirects :: Bool
    bsAllowRedirects   = Bool
    True
         , bsAllowBasicAuth :: Bool
    bsAllowBasicAuth   = Bool
    False
         , bsMaxRedirects :: Maybe Int
    bsMaxRedirects     = Maybe Int
    forall a. Maybe a
    Nothing
         , bsMaxErrorRetries :: Maybe Int
    bsMaxErrorRetries  = Maybe Int
    forall a. Maybe a
    Nothing
         , bsMaxAuthAttempts :: Maybe Int
    bsMaxAuthAttempts  = Maybe Int
    forall a. Maybe a
    Nothing
         , bsMaxPoolSize :: Maybe Int
    bsMaxPoolSize      = Maybe Int
    forall a. Maybe a
    Nothing
         , bsConnectionPool :: [connection]
    bsConnectionPool   = []
         , bsCheckProxy :: Bool
    bsCheckProxy       = Bool
    defaultAutoProxyDetect
         , bsProxy :: Proxy
    bsProxy            = Proxy
    noProxy
         , bsDebug :: Maybe String
    bsDebug            = Maybe String
    forall a. Maybe a
    Nothing
         , bsEvent :: Maybe (BrowserEvent -> BrowserAction connection ())
    bsEvent            = Maybe (BrowserEvent -> BrowserAction connection ())
    forall a. Maybe a
    Nothing
         , bsRequestID :: Int
    bsRequestID        = Int
    0
         , bsUserAgent :: Maybe String
    bsUserAgent        = Maybe String
    forall a. Maybe a
    Nothing
         }

    {-# DEPRECATED getBrowserState "Use Control.Monad.State.get instead." #-}
    -- | @getBrowserState@ returns the current browser config. Useful
    -- for restoring state across 'BrowserAction's.
    getBrowserState :: BrowserAction t (BrowserState t)
    getBrowserState :: forall conn. BrowserAction conn (BrowserState conn)
    getBrowserState = BrowserAction t (BrowserState t)
    forall s (m :: * -> *). MonadState s m => m s
    get

    -- | @withBrowserAction st act@ performs @act@ with 'BrowserState' @st@.
    withBrowserState :: BrowserState t -> BrowserAction t a -> BrowserAction t a
    withBrowserState :: forall t a.
    BrowserState t -> BrowserAction t a -> BrowserAction t a
    withBrowserState BrowserState t
    bs = StateT (BrowserState t) IO a -> BrowserAction t a
    forall conn a.
    StateT (BrowserState conn) IO a -> BrowserAction conn a
    BA (StateT (BrowserState t) IO a -> BrowserAction t a)
    -> (BrowserAction t a -> StateT (BrowserState t) IO a)
    -> BrowserAction t a
    -> BrowserAction t a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (BrowserState t -> BrowserState t)
    -> StateT (BrowserState t) IO a -> StateT (BrowserState t) IO a
    forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
    withStateT (BrowserState t -> BrowserState t -> BrowserState t
    forall a b. a -> b -> a
    const BrowserState t
    bs) (StateT (BrowserState t) IO a -> StateT (BrowserState t) IO a)
    -> (BrowserAction t a -> StateT (BrowserState t) IO a)
    -> BrowserAction t a
    -> StateT (BrowserState t) IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BrowserAction t a -> StateT (BrowserState t) IO a
    forall conn a.
    BrowserAction conn a -> StateT (BrowserState conn) IO a
    unBA

    -- | @nextRequest act@ performs the browser action @act@ as
    -- the next request, i.e., setting up a new request context
    -- before doing so.
    nextRequest :: BrowserAction t a -> BrowserAction t a
    nextRequest :: forall t a. BrowserAction t a -> BrowserAction t a
    nextRequest BrowserAction t a
    act = do
      let updReqID :: BrowserState connection -> BrowserState connection
    updReqID BrowserState connection
    st =
           let
            rid :: Int
    rid = Int -> Int
    forall a. Enum a => a -> a
    succ (BrowserState connection -> Int
    forall connection. BrowserState connection -> Int
    bsRequestID BrowserState connection
    st)
           in
           Int
    rid Int -> BrowserState connection -> BrowserState connection
    forall a b. a -> b -> b
    `seq` BrowserState connection
    st{bsRequestID=rid}
      (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify BrowserState t -> BrowserState t
    forall {connection}.
    BrowserState connection -> BrowserState connection
    updReqID
      BrowserAction t a
    act

    -- | Lifts an IO action into the 'BrowserAction' monad.
    {-# DEPRECATED ioAction "Use Control.Monad.Trans.liftIO instead." #-}
    ioAction :: IO a -> BrowserAction t a
    ioAction :: forall a t. IO a -> BrowserAction t a
    ioAction = IO a -> BrowserAction t a
    forall a. IO a -> BrowserAction t a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO

    -- | @setErrHandler@ sets the IO action to call when
    -- the browser reports running errors. To disable any
    -- such, set it to @const (return ())@.
    setErrHandler :: (String -> IO ()) -> BrowserAction t ()
    setErrHandler :: forall t. (String -> IO ()) -> BrowserAction t ()
    setErrHandler String -> IO ()
    h = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsErr=h })

    -- | @setOutHandler@ sets the IO action to call when
    -- the browser chatters info on its running. To disable any
    -- such, set it to @const (return ())@.
    setOutHandler :: (String -> IO ()) -> BrowserAction t ()
    setOutHandler :: forall t. (String -> IO ()) -> BrowserAction t ()
    setOutHandler String -> IO ()
    h = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b { bsOut=h })

    out, err :: String -> BrowserAction t ()
    out :: forall t. String -> BrowserAction t ()
    out String
    s = do { f <- (BrowserState t -> String -> IO ())
    -> BrowserAction t (String -> IO ())
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> String -> IO ()
    forall connection. BrowserState connection -> String -> IO ()
    bsOut ; liftIO $ f s }
    err :: forall t. String -> BrowserAction t ()
    err String
    s = do { f <- (BrowserState t -> String -> IO ())
    -> BrowserAction t (String -> IO ())
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> String -> IO ()
    forall connection. BrowserState connection -> String -> IO ()
    bsErr ; liftIO $ f s }

    -- | @setAllowRedirects onOff@ toggles the willingness to
    -- follow redirects (HTTP responses with 3xx status codes).
    setAllowRedirects :: Bool -> BrowserAction t ()
    setAllowRedirects :: forall t. Bool -> BrowserAction t ()
    setAllowRedirects Bool
    bl = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b {bsAllowRedirects=bl})

    -- | @getAllowRedirects@ returns current setting of the do-chase-redirects flag.
    getAllowRedirects :: BrowserAction t Bool
    getAllowRedirects :: forall t. BrowserAction t Bool
    getAllowRedirects = (BrowserState t -> Bool) -> BrowserAction t Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Bool
    forall connection. BrowserState connection -> Bool
    bsAllowRedirects

    -- | @setMaxRedirects maxCount@ sets the maximum number of forwarding hops
    -- we are willing to jump through. A no-op if the count is negative; if zero,
    -- the max is set to whatever default applies. Notice that setting the max
    -- redirects count does /not/ enable following of redirects itself; use
    -- 'setAllowRedirects' to do so.
    setMaxRedirects :: Maybe Int -> BrowserAction t ()
    setMaxRedirects :: forall t. Maybe Int -> BrowserAction t ()
    setMaxRedirects Maybe Int
    c
     | Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 Maybe Int
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0  = () -> BrowserAction t ()
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
     | Bool
    otherwise          = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b{bsMaxRedirects=c})

    -- | @getMaxRedirects@ returns the current setting for the max-redirect count.
    -- If @Nothing@, the "Network.Browser"'s default is used.
    getMaxRedirects :: BrowserAction t (Maybe Int)
    getMaxRedirects :: forall t. BrowserAction t (Maybe Int)
    getMaxRedirects = (BrowserState t -> Maybe Int) -> BrowserAction t (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Maybe Int
    forall connection. BrowserState connection -> Maybe Int
    bsMaxRedirects

    -- | @setMaxPoolSize maxCount@ sets the maximum size of the connection pool
    -- that is used to cache connections between requests
    setMaxPoolSize :: Maybe Int -> BrowserAction t ()
    setMaxPoolSize :: forall t. Maybe Int -> BrowserAction t ()
    setMaxPoolSize Maybe Int
    c = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b{bsMaxPoolSize=c})

    -- | @getMaxPoolSize@ gets the maximum size of the connection pool
    -- that is used to cache connections between requests.
    -- If @Nothing@, the "Network.Browser"'s default is used.
    getMaxPoolSize :: BrowserAction t (Maybe Int)
    getMaxPoolSize :: forall t. BrowserAction t (Maybe Int)
    getMaxPoolSize = (BrowserState t -> Maybe Int) -> BrowserAction t (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Maybe Int
    forall connection. BrowserState connection -> Maybe Int
    bsMaxPoolSize

    -- | @setProxy p@ will disable proxy usage if @p@ is @NoProxy@.
    -- If @p@ is @Proxy proxyURL mbAuth@, then @proxyURL@ is interpreted
    -- as the URL of the proxy to use, possibly authenticating via
    -- 'Authority' information in @mbAuth@.
    setProxy :: Proxy -> BrowserAction t ()
    setProxy :: forall t. Proxy -> BrowserAction t ()
    setProxy Proxy
    p =
       -- Note: if user _explicitly_ sets the proxy, we turn
       -- off any auto-detection of proxies.
      (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b {bsProxy = p, bsCheckProxy=False})

    -- | @getProxy@ returns the current proxy settings. If
    -- the auto-proxy flag is set to @True@, @getProxy@ will
    -- perform the necessary
    getProxy :: BrowserAction t Proxy
    getProxy :: forall t. BrowserAction t Proxy
    getProxy = do
      p <- (BrowserState t -> Proxy) -> BrowserAction t Proxy
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Proxy
    forall connection. BrowserState connection -> Proxy
    bsProxy
      case p of
          -- Note: if there is a proxy, no need to perform any auto-detect.
          -- Presumably this is the user's explicit and preferred proxy server.
        Proxy{} -> Proxy -> BrowserAction t Proxy
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Proxy
    p
        NoProxy{} -> do
         flg <- (BrowserState t -> Bool) -> BrowserAction t Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Bool
    forall connection. BrowserState connection -> Bool
    bsCheckProxy
         if not flg
          then return p
          else do
           np <- liftIO $ fetchProxy True{-issue warning on stderr if ill-formed...-}
            -- note: this resets the check-proxy flag; a one-off affair.
           setProxy np
           return np

    -- | @setCheckForProxy flg@ sets the one-time check for proxy
    -- flag to @flg@. If @True@, the session will try to determine
    -- the proxy server is locally configured. See 'Network.HTTP.Proxy.fetchProxy'
    -- for details of how this done.
    setCheckForProxy :: Bool -> BrowserAction t ()
    setCheckForProxy :: forall t. Bool -> BrowserAction t ()
    setCheckForProxy Bool
    flg = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\ BrowserState t
    b -> BrowserState t
    b{bsCheckProxy=flg})

    -- | @getCheckForProxy@ returns the current check-proxy setting.
    -- Notice that this may not be equal to @True@ if the session has
    -- set it to that via 'setCheckForProxy' and subsequently performed
    -- some HTTP protocol interactions. i.e., the flag return represents
    -- whether a proxy will be checked for again before any future protocol
    -- interactions.
    getCheckForProxy :: BrowserAction t Bool
    getCheckForProxy :: forall t. BrowserAction t Bool
    getCheckForProxy = (BrowserState t -> Bool) -> BrowserAction t Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Bool
    forall connection. BrowserState connection -> Bool
    bsCheckProxy

    -- | @setDebugLog mbFile@ turns off debug logging iff @mbFile@
    -- is @Nothing@. If set to @Just fStem@, logs of browser activity
    -- is appended to files of the form @fStem-url-authority@, i.e.,
    -- @fStem@ is just the prefix for a set of log files, one per host/authority.
    setDebugLog :: Maybe String -> BrowserAction t ()
    setDebugLog :: forall t. Maybe String -> BrowserAction t ()
    setDebugLog Maybe String
    v = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b {bsDebug=v})

    -- | @setUserAgent ua@ sets the current @User-Agent:@ string to @ua@. It
    -- will be used if no explicit user agent header is found in subsequent requests.
    --
    -- A common form of user agent string is @\"name\/version (details)\"@. For
    -- example @\"cabal-install/0.10.2 (HTTP 4000.1.2)\"@. Including the version
    -- of this HTTP package can be helpful if you ever need to track down HTTP
    -- compatibility quirks. This version is available via 'httpPackageVersion'.
    -- For more info see <http://en.wikipedia.org/wiki/User_agent>.
    --
    setUserAgent :: String -> BrowserAction t ()
    setUserAgent :: forall t. String -> BrowserAction t ()
    setUserAgent String
    ua = (BrowserState t -> BrowserState t) -> BrowserAction t ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState t
    b -> BrowserState t
    b{bsUserAgent=Just ua})

    -- | @getUserAgent@ returns the current @User-Agent:@ default string.
    getUserAgent :: BrowserAction t String
    getUserAgent :: forall t. BrowserAction t String
    getUserAgent  = do
      n <- (BrowserState t -> Maybe String) -> BrowserAction t (Maybe String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState t -> Maybe String
    forall connection. BrowserState connection -> Maybe String
    bsUserAgent
      return (maybe defaultUserAgent id n)

    -- | @RequestState@ is an internal tallying type keeping track of various
    -- per-connection counters, like the number of authorization attempts and
    -- forwards we've gone through.
    data RequestState
      = RequestState
          { RequestState -> Int
    reqDenies     :: Int   -- ^ number of 401 responses so far
          , RequestState -> Int
    reqRedirects  :: Int   -- ^ number of redirects so far
          , RequestState -> Int
    reqRetries    :: Int   -- ^ number of retries so far
          , RequestState -> Bool
    reqStopOnDeny :: Bool  -- ^ whether to pre-empt 401 response
          }

    type RequestID = Int -- yeah, it will wrap around.

    nullRequestState :: RequestState
    nullRequestState :: RequestState
    nullRequestState = RequestState
          { reqDenies :: Int
    reqDenies     = Int
    0
          , reqRedirects :: Int
    reqRedirects  = Int
    0
          , reqRetries :: Int
    reqRetries    = Int
    0
          , reqStopOnDeny :: Bool
    reqStopOnDeny = Bool
    True
          }

    -- | @BrowserEvent@ is the event record type that a user-defined handler, set
    -- via 'setEventHandler', will be passed. It indicates various state changes
    -- encountered in the processing of a given 'RequestID', along with timestamps
    -- at which they occurred.
    data BrowserEvent
     = BrowserEvent
          { BrowserEvent -> UTCTime
    browserTimestamp  :: UTCTime
          , BrowserEvent -> Int
    browserRequestID  :: RequestID
          , BrowserEvent -> String
    browserRequestURI :: {-URI-}String
          , BrowserEvent -> BrowserEventType
    browserEventType  :: BrowserEventType
          }

    -- | 'BrowserEventType' is the enumerated list of events that the browser
    -- internals will report to a user-defined event handler.
    data BrowserEventType
     = OpenConnection
     | ReuseConnection
     | RequestSent
     | ResponseEnd ResponseData
     | ResponseFinish
    {- not yet, you will have to determine these via the ResponseEnd event.
     | Redirect
     | AuthChallenge
     | AuthResponse
    -}

    -- | @setEventHandler onBrowserEvent@ configures event handling.
    -- If @onBrowserEvent@ is @Nothing@, event handling is turned off;
    -- setting it to @Just onEv@ causes the @onEv@ IO action to be
    -- notified of browser events during the processing of a request
    -- by the Browser pipeline.
    setEventHandler :: Maybe (BrowserEvent -> BrowserAction ty ()) -> BrowserAction ty ()
    setEventHandler :: forall ty.
    Maybe (BrowserEvent -> BrowserAction ty ()) -> BrowserAction ty ()
    setEventHandler Maybe (BrowserEvent -> BrowserAction ty ())
    mbH = (BrowserState ty -> BrowserState ty) -> BrowserAction ty ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState ty
    b -> BrowserState ty
    b { bsEvent=mbH})

    buildBrowserEvent :: BrowserEventType -> {-URI-}String -> RequestID -> IO BrowserEvent
    buildBrowserEvent :: BrowserEventType -> String -> Int -> IO BrowserEvent
    buildBrowserEvent BrowserEventType
    bt String
    uri Int
    reqID = do
      ct <- IO UTCTime
    getCurrentTime
      return BrowserEvent
             { browserTimestamp  = ct
             , browserRequestID  = reqID
             , browserRequestURI = uri
             , browserEventType  = bt
             }

    reportEvent :: BrowserEventType -> {-URI-}String -> BrowserAction t ()
    reportEvent :: forall t. BrowserEventType -> String -> BrowserAction t ()
    reportEvent BrowserEventType
    bt String
    uri = do
      st <- BrowserAction t (BrowserState t)
    forall s (m :: * -> *). MonadState s m => m s
    get
      case bsEvent st of
        Maybe (BrowserEvent -> BrowserAction t ())
    Nothing -> () -> BrowserAction t ()
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just BrowserEvent -> BrowserAction t ()
    evH -> do
           evt <- IO BrowserEvent -> BrowserAction t BrowserEvent
    forall a. IO a -> BrowserAction t a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO BrowserEvent -> BrowserAction t BrowserEvent)
    -> IO BrowserEvent -> BrowserAction t BrowserEvent
    forall a b. (a -> b) -> a -> b
    $ BrowserEventType -> String -> Int -> IO BrowserEvent
    buildBrowserEvent BrowserEventType
    bt String
    uri (BrowserState t -> Int
    forall connection. BrowserState connection -> Int
    bsRequestID BrowserState t
    st)
           evH evt -- if it fails, we fail.

    -- | The default number of hops we are willing not to go beyond for
    -- request forwardings.
    defaultMaxRetries :: Int
    defaultMaxRetries :: Int
    defaultMaxRetries = Int
    4

    -- | The default number of error retries we are willing to perform.
    defaultMaxErrorRetries :: Int
    defaultMaxErrorRetries :: Int
    defaultMaxErrorRetries = Int
    4

    -- | The default maximum HTTP Authentication attempts we will make for
    -- a single request.
    defaultMaxAuthAttempts :: Int
    defaultMaxAuthAttempts :: Int
    defaultMaxAuthAttempts = Int
    2

    -- | The default setting for auto-proxy detection.
    -- You may change this within a session via 'setAutoProxyDetect'.
    -- To avoid initial backwards compatibility issues, leave this as @False@.
    defaultAutoProxyDetect :: Bool
    defaultAutoProxyDetect :: Bool
    defaultAutoProxyDetect = Bool
    False

    -- | @request httpRequest@ tries to submit the 'Request' @httpRequest@
    -- to some HTTP server (possibly going via a /proxy/, see 'setProxy'.)
    -- Upon successful delivery, the URL where the response was fetched from
    -- is returned along with the 'Response' itself.
    request :: HStream ty
            => Request ty
            -> BrowserAction (HandleStream ty) (URI,Response ty)
    request :: forall ty.
    HStream ty =>
    Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
    request Request ty
    req = BrowserAction (HandleStream ty) (URI, Response ty)
    -> BrowserAction (HandleStream ty) (URI, Response ty)
    forall t a. BrowserAction t a -> BrowserAction t a
    nextRequest (BrowserAction (HandleStream ty) (URI, Response ty)
     -> BrowserAction (HandleStream ty) (URI, Response ty))
    -> BrowserAction (HandleStream ty) (URI, Response ty)
    -> BrowserAction (HandleStream ty) (URI, Response ty)
    forall a b. (a -> b) -> a -> b
    $ do
      res <- ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal RequestState
    initialState Request ty
    req
      reportEvent ResponseFinish (show (rqURI req))
      case res of
        Right (URI, Response ty)
    r -> (URI, Response ty)
    -> BrowserAction (HandleStream ty) (URI, Response ty)
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (URI, Response ty)
    r
        Left ConnError
    e  -> do
         let errStr :: String
    errStr = (String
    "Network.Browser.request: Error raised " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ConnError -> String
    forall a. Show a => a -> String
    show ConnError
    e)
         String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err String
    errStr
         String -> BrowserAction (HandleStream ty) (URI, Response ty)
    forall a. String -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    Prelude.fail String
    errStr
     where
      initialState :: RequestState
    initialState = RequestState
    nullRequestState
      nullVal :: ty
    nullVal      = BufferOp ty -> ty
    forall a. BufferOp a -> a
    buf_empty BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps

    -- | Internal helper function, explicitly carrying along per-request
    -- counts.
    request' :: HStream ty
             => ty
             -> RequestState
             -> Request ty
             -> BrowserAction (HandleStream ty) (Result (URI,Response ty))
    request' :: forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal RequestState
    rqState Request ty
    rq = do
       let uri :: URI
    uri = Request ty -> URI
    forall a. Request a -> URI
    rqURI Request ty
    rq
       URI -> BrowserAction (HandleStream ty) ()
    forall (m :: * -> *). MonadFail m => URI -> m ()
    failHTTPS URI
    uri
       let uria :: URIAuth
    uria = Request ty -> URIAuth
    forall ty. Request ty -> URIAuth
    reqURIAuth Request ty
    rq
         -- add cookies to request
       cookies <- String -> String -> BrowserAction (HandleStream ty) [Cookie]
    forall t. String -> String -> BrowserAction t [Cookie]
    getCookiesFor (URIAuth -> String
    uriAuthToString URIAuth
    uria) (URI -> String
    uriPath URI
    uri)
    {- Not for now:
       (case uriUserInfo uria of
         "" -> id
         xs ->
           case chopAtDelim ':' xs of
             (_,[])    -> id
             (usr,pwd) -> withAuth
                              AuthBasic{ auUserName = usr
                                       , auPassword = pwd
                                       , auRealm    = "/"
                                       , auSite     = uri
                                       }) $ do
    -}
       when (not $ null cookies)
            (out $ "Adding cookies to request.  Cookie names: "  ++ unwords (map ckName cookies))
        -- add credentials to request
       rq' <-
        if not (reqStopOnDeny rqState)
         then return rq
         else do
           auth <- anticipateChallenge rq
           case auth of
             Maybe Authority
    Nothing -> Request ty -> BrowserAction (HandleStream ty) (Request ty)
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Request ty
    rq
             Just Authority
    x  -> Request ty -> BrowserAction (HandleStream ty) (Request ty)
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HeaderSetter (Request ty)
    forall a. HasHeaders a => HeaderSetter a
    insertHeader HeaderName
    HdrAuthorization (Authority -> Request ty -> String
    forall ty. Authority -> Request ty -> String
    withAuthority Authority
    x Request ty
    rq) Request ty
    rq)
       let rq'' = if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Cookie] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Cookie]
    cookies then [Header] -> Request ty -> Request ty
    forall a. HasHeaders a => [Header] -> a -> a
    insertHeaders [[Cookie] -> Header
    cookiesToHeader [Cookie]
    cookies] Request ty
    rq' else Request ty
    rq'
       p <- getProxy
       def_ua <- gets bsUserAgent
       let defaultOpts =
             case Proxy
    p of
               Proxy
    NoProxy     -> NormalizeRequestOptions ty
    forall ty. NormalizeRequestOptions ty
    defaultNormalizeRequestOptions{normUserAgent=def_ua}
               Proxy String
    _ Maybe Authority
    ath ->
                  NormalizeRequestOptions (ZonkAny 0)
    forall ty. NormalizeRequestOptions ty
    defaultNormalizeRequestOptions
                    { normForProxy  = True
                    , normUserAgent = def_ua
                    , normCustoms   =
                        maybe []
                              (\ Authority
    authS -> [\ NormalizeRequestOptions ty
    _ Request ty
    r -> HeaderSetter (Request ty)
    forall a. HasHeaders a => HeaderSetter a
    insertHeader HeaderName
    HdrProxyAuthorization (Authority -> Request ty -> String
    forall ty. Authority -> Request ty -> String
    withAuthority Authority
    authS Request ty
    r) Request ty
    r])
                              ath
                    }
       let final_req = NormalizeRequestOptions ty -> Request ty -> Request ty
    forall ty. NormalizeRequestOptions ty -> Request ty -> Request ty
    normalizeRequest NormalizeRequestOptions ty
    forall ty. NormalizeRequestOptions ty
    defaultOpts Request ty
    rq''
       out ("Sending:\n" ++ show final_req)
       e_rsp <-
         case p of
           Proxy
    NoProxy        -> URIAuth
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (Response ty))
    forall ty.
    HStream ty =>
    URIAuth
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (Response ty))
    dorequest (Request ty -> URIAuth
    forall ty. Request ty -> URIAuth
    reqURIAuth Request ty
    rq'') Request ty
    final_req
           Proxy String
    str Maybe Authority
    _ath -> do
              let notURI :: URIAuth
    notURI
                   | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    pt Bool -> Bool -> Bool
    || String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    hst =
                     URIAuth{ uriUserInfo :: String
    uriUserInfo = String
    ""
                            , uriRegName :: String
    uriRegName  = String
    str
                            , uriPort :: String
    uriPort     = String
    ""
                            }
                   | Bool
    otherwise =
                     URIAuth{ uriUserInfo :: String
    uriUserInfo = String
    ""
                            , uriRegName :: String
    uriRegName  = String
    hst
                            , uriPort :: String
    uriPort     = String
    pt
                            }
                      -- If the ':' is dropped from port below, dorequest will assume port 80. Leave it!
                     where (String
    hst, String
    pt) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char
    ':'Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) String
    str
               -- Proxy can take multiple forms - look for http://host:port first,
               -- then host:port. Fall back to just the string given (probably a host name).
              let proxyURIAuth :: URIAuth
    proxyURIAuth =
                    URIAuth -> (URI -> URIAuth) -> Maybe URI -> URIAuth
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe URIAuth
    notURI
                          (\URI
    parsed -> URIAuth -> (URIAuth -> URIAuth) -> Maybe URIAuth -> URIAuth
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe URIAuth
    notURI URIAuth -> URIAuth
    forall a. a -> a
    id (URI -> Maybe URIAuth
    uriAuthority URI
    parsed))
                          (String -> Maybe URI
    parseURI String
    str)

              String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String -> BrowserAction (HandleStream ty) ())
    -> String -> BrowserAction (HandleStream ty) ()
    forall a b. (a -> b) -> a -> b
    $ String
    "proxy uri host: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URIAuth -> String
    uriRegName URIAuth
    proxyURIAuth String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", port: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URIAuth -> String
    uriPort URIAuth
    proxyURIAuth
              URIAuth
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (Response ty))
    forall ty.
    HStream ty =>
    URIAuth
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (Response ty))
    dorequest URIAuth
    proxyURIAuth Request ty
    final_req
       mbMx <- getMaxErrorRetries
       case e_rsp of
        Left ConnError
    v
         | (RequestState -> Int
    reqRetries RequestState
    rqState Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    defaultMaxErrorRetries Maybe Int
    mbMx) Bool -> Bool -> Bool
    &&
           (ConnError
    v ConnError -> ConnError -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConnError
    ErrorReset Bool -> Bool -> Bool
    || ConnError
    v ConnError -> ConnError -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConnError
    ErrorClosed) -> do
           --empty connnection pool in case connection has become invalid
           (BrowserState (HandleStream ty) -> BrowserState (HandleStream ty))
    -> BrowserAction (HandleStream ty) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\BrowserState (HandleStream ty)
    b -> BrowserState (HandleStream ty)
    b { bsConnectionPool=[] })
           ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal RequestState
    rqState{reqRetries=succ (reqRetries rqState)} Request ty
    rq
         | Bool
    otherwise ->
           Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConnError -> Result (URI, Response ty)
    forall a b. a -> Either a b
    Left ConnError
    v)
        Right Response ty
    rsp -> do
         String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String
    "Received:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Response ty -> String
    forall a. Show a => a -> String
    show Response ty
    rsp)
          -- add new cookies to browser state
         URI -> String -> [Header] -> BrowserAction (HandleStream ty) ()
    forall t. URI -> String -> [Header] -> BrowserAction t ()
    handleCookies URI
    uri (URIAuth -> String
    uriAuthToString (URIAuth -> String) -> URIAuth -> String
    forall a b. (a -> b) -> a -> b
    $ Request ty -> URIAuth
    forall ty. Request ty -> URIAuth
    reqURIAuth Request ty
    rq)
                           (HeaderName -> Response ty -> [Header]
    forall a. HasHeaders a => HeaderName -> a -> [Header]
    retrieveHeaders HeaderName
    HdrSetCookie Response ty
    rsp)
         -- Deal with "Connection: close" in response.
         URIAuth -> [Header] -> BrowserAction (HandleStream ty) ()
    forall hTy.
    HStream hTy =>
    URIAuth -> [Header] -> BrowserAction (HandleStream hTy) ()
    handleConnectionClose (Request ty -> URIAuth
    forall ty. Request ty -> URIAuth
    reqURIAuth Request ty
    rq) (HeaderName -> Response ty -> [Header]
    forall a. HasHeaders a => HeaderName -> a -> [Header]
    retrieveHeaders HeaderName
    HdrConnection Response ty
    rsp)
         mbMxAuths <- BrowserAction (HandleStream ty) (Maybe Int)
    forall t. BrowserAction t (Maybe Int)
    getMaxAuthAttempts
         case rspCode rsp of
          (Int
    4,Int
    0,Int
    1) -- Credentials not sent or refused.
            | RequestState -> Int
    reqDenies RequestState
    rqState Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    defaultMaxAuthAttempts Maybe Int
    mbMxAuths -> do
              String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "401 - credentials again refused; exceeded retry count (2)"
              Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
            | Bool
    otherwise -> do
              String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "401 - credentials not supplied or refused; retrying.."
              let hdrs :: [Header]
    hdrs = HeaderName -> Response ty -> [Header]
    forall a. HasHeaders a => HeaderName -> a -> [Header]
    retrieveHeaders HeaderName
    HdrWWWAuthenticate Response ty
    rsp
              flg <- BrowserAction (HandleStream ty) Bool
    forall t. BrowserAction t Bool
    getAllowBasicAuth
              case pickChallenge flg (catMaybes $ map (headerToChallenge uri) hdrs) of
                Maybe Challenge
    Nothing -> do
                  String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "no challenge"
                  Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))   {- do nothing -}
                Just Challenge
    x  -> do
                  au <- URI
    -> Challenge -> BrowserAction (HandleStream ty) (Maybe Authority)
    forall t. URI -> Challenge -> BrowserAction t (Maybe Authority)
    challengeToAuthority URI
    uri Challenge
    x
                  case au of
                    Maybe Authority
    Nothing  -> do
                      String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "no auth"
                      Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp)) {- do nothing -}
                    Just Authority
    au' -> do
                      String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "Retrying request with new credentials"
                      ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal
                               RequestState
    rqState{ reqDenies     = succ(reqDenies rqState)
                                      , reqStopOnDeny = False
                                      }
                               (HeaderSetter (Request ty)
    forall a. HasHeaders a => HeaderSetter a
    insertHeader HeaderName
    HdrAuthorization (Authority -> Request ty -> String
    forall ty. Authority -> Request ty -> String
    withAuthority Authority
    au' Request ty
    rq) Request ty
    rq)

          (Int
    4,Int
    0,Int
    7)  -- Proxy Authentication required
            | RequestState -> Int
    reqDenies RequestState
    rqState Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    defaultMaxAuthAttempts Maybe Int
    mbMxAuths -> do
              String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "407 - proxy authentication required; max deny count exceeeded (2)"
              Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
            | Bool
    otherwise -> do
              String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "407 - proxy authentication required"
              let hdrs :: [Header]
    hdrs = HeaderName -> Response ty -> [Header]
    forall a. HasHeaders a => HeaderName -> a -> [Header]
    retrieveHeaders HeaderName
    HdrProxyAuthenticate Response ty
    rsp
              flg <- BrowserAction (HandleStream ty) Bool
    forall t. BrowserAction t Bool
    getAllowBasicAuth
              case pickChallenge flg (catMaybes $ map (headerToChallenge uri) hdrs) of
                Maybe Challenge
    Nothing -> Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))   {- do nothing -}
                Just Challenge
    x  -> do
                  au <- URI
    -> Challenge -> BrowserAction (HandleStream ty) (Maybe Authority)
    forall t. URI -> Challenge -> BrowserAction t (Maybe Authority)
    challengeToAuthority URI
    uri Challenge
    x
                  case au of
                   Maybe Authority
    Nothing  -> Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))  {- do nothing -}
                   Just Authority
    au' -> do
                     pxy <- (BrowserState (HandleStream ty) -> Proxy)
    -> BrowserAction (HandleStream ty) Proxy
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState (HandleStream ty) -> Proxy
    forall connection. BrowserState connection -> Proxy
    bsProxy
                     case pxy of
                       Proxy
    NoProxy -> do
                         String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err String
    "Proxy authentication required without proxy!"
                         Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
                       Proxy String
    px Maybe Authority
    _ -> do
                         String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out String
    "Retrying with proxy authentication"
                         Proxy -> BrowserAction (HandleStream ty) ()
    forall t. Proxy -> BrowserAction t ()
    setProxy (String -> Maybe Authority -> Proxy
    Proxy String
    px (Authority -> Maybe Authority
    forall a. a -> Maybe a
    Just Authority
    au'))
                         ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal
                                  RequestState
    rqState{ reqDenies     = succ(reqDenies rqState)
                                         , reqStopOnDeny = False
                                         }
                                  Request ty
    rq

          (Int
    3,Int
    0,Int
    x) | Int
    x Int -> [Int] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int
    2,Int
    3,Int
    1,Int
    7]  ->  do
            String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String
    "30" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    " - redirect")
            allow_redirs <- RequestState -> BrowserAction (HandleStream ty) Bool
    forall t. RequestState -> BrowserAction t Bool
    allowRedirect RequestState
    rqState
            case allow_redirs of
              Bool
    False -> Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
              Bool
    _ -> do
               case HeaderName -> Response ty -> [Header]
    forall a. HasHeaders a => HeaderName -> a -> [Header]
    retrieveHeaders HeaderName
    HdrLocation Response ty
    rsp of
                [] -> do
                  String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err String
    "No Location: header in redirect response"
                  Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
                (Header HeaderName
    _ String
    u:[Header]
    _) ->
                  case String -> Maybe URI
    parseURIReference String
    u of
                    Maybe URI
    Nothing -> do
                      String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err (String
    "Parse of Location: header in a redirect response failed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    u)
                      Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
                    Just URI
    newURI
                     | {-uriScheme newURI_abs /= uriScheme uri && -}(Bool -> Bool
    not (URI -> Bool
    supportedScheme URI
    newURI_abs)) -> do
                        String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err (String
    "Unable to handle redirect, unsupported scheme: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URI -> String
    forall a. Show a => a -> String
    show URI
    newURI_abs)
                        Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri, Response ty
    rsp))
                     | Bool
    otherwise -> do
                        String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String
    "Redirecting to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URI -> String
    forall a. Show a => a -> String
    show URI
    newURI_abs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ...")

                        -- Redirect using GET request method, depending on
                        -- response code.
                        let toGet :: Bool
    toGet = Int
    x Int -> [Int] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int
    2,Int
    3]
                            method :: RequestMethod
    method = if Bool
    toGet then RequestMethod
    GET else Request ty -> RequestMethod
    forall a. Request a -> RequestMethod
    rqMethod Request ty
    rq
                            rq1 :: Request ty
    rq1 = Request ty
    rq { rqMethod=method, rqURI=newURI_abs }
                            rq2 :: Request ty
    rq2 = if Bool
    toGet then (HeaderSetter (Request ty)
    forall a. HasHeaders a => HeaderSetter a
    replaceHeader HeaderName
    HdrContentLength String
    "0") (Request ty
    rq1 {rqBody = nullVal}) else Request ty
    rq1

                        ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal
                                RequestState
    rqState{ reqDenies     = 0
                                       , reqRedirects  = succ(reqRedirects rqState)
                                       , reqStopOnDeny = True
                                       }
                                 Request ty
    rq2
                     where
                       newURI_abs :: URI
    newURI_abs = URI -> URI -> URI
    uriDefaultTo URI
    newURI URI
    uri

          (Int
    3,Int
    0,Int
    5) ->
            case HeaderName -> Response ty -> [Header]
    forall a. HasHeaders a => HeaderName -> a -> [Header]
    retrieveHeaders HeaderName
    HdrLocation Response ty
    rsp of
             [] -> do
               String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err String
    "No Location header in proxy redirect response."
               Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
             (Header HeaderName
    _ String
    u:[Header]
    _) ->
               case String -> Maybe URI
    parseURIReference String
    u of
                Maybe URI
    Nothing -> do
                 String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    err (String
    "Parse of Location header in a proxy redirect response failed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    u)
                 Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))
                Just URI
    newuri -> do
                 String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String
    "Retrying with proxy " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URI -> String
    forall a. Show a => a -> String
    show URI
    newuri String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "...")
                 Proxy -> BrowserAction (HandleStream ty) ()
    forall t. Proxy -> BrowserAction t ()
    setProxy (String -> Maybe Authority -> Proxy
    Proxy (URI -> String
    uriToAuthorityString URI
    newuri) Maybe Authority
    forall a. Maybe a
    Nothing)
                 ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall ty.
    HStream ty =>
    ty
    -> RequestState
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    request' ty
    nullVal RequestState
    rqState{ reqDenies     = 0
                                         , reqRedirects  = 0
                                         , reqRetries    = succ (reqRetries rqState)
                                         , reqStopOnDeny = True
                                         }
                                         Request ty
    rq
          ResponseCode
    _       -> Result (URI, Response ty)
    -> BrowserAction (HandleStream ty) (Result (URI, Response ty))
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((URI, Response ty) -> Result (URI, Response ty)
    forall a b. b -> Either a b
    Right (URI
    uri,Response ty
    rsp))

    -- | The internal request handling state machine.
    dorequest :: (HStream ty)
              => URIAuth
              -> Request ty
              -> BrowserAction (HandleStream ty)
                               (Result (Response ty))
    dorequest :: forall ty.
    HStream ty =>
    URIAuth
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (Response ty))
    dorequest URIAuth
    hst Request ty
    rqst = do
      pool <- (BrowserState (HandleStream ty) -> [HandleStream ty])
    -> BrowserAction (HandleStream ty) [HandleStream ty]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState (HandleStream ty) -> [HandleStream ty]
    forall connection. BrowserState connection -> [connection]
    bsConnectionPool
      let uPort = Maybe URI -> URIAuth -> Int
    uriAuthPort Maybe URI
    forall a. Maybe a
    Nothing{-ToDo: feed in complete URL-} URIAuth
    hst
      conn <- liftIO $ filterM (\HandleStream ty
    c -> HandleStream ty
    c HandleStream ty -> EndPoint -> IO Bool
    forall ty. HandleStream ty -> EndPoint -> IO Bool
    `isTCPConnectedTo` String -> Int -> EndPoint
    EndPoint (URIAuth -> String
    uriRegName URIAuth
    hst) Int
    uPort) pool
      rsp <-
        case conn of
          [] -> do
            String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String
    "Creating new connection to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URIAuth -> String
    uriAuthToString URIAuth
    hst)
            BrowserEventType -> String -> BrowserAction (HandleStream ty) ()
    forall t. BrowserEventType -> String -> BrowserAction t ()
    reportEvent BrowserEventType
    OpenConnection (URI -> String
    forall a. Show a => a -> String
    show (Request ty -> URI
    forall a. Request a -> URI
    rqURI Request ty
    rqst))
            c <- IO (HandleStream ty)
    -> BrowserAction (HandleStream ty) (HandleStream ty)
    forall a. IO a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (HandleStream ty)
     -> BrowserAction (HandleStream ty) (HandleStream ty))
    -> IO (HandleStream ty)
    -> BrowserAction (HandleStream ty) (HandleStream ty)
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> IO (HandleStream ty)
    forall bufType.
    HStream bufType =>
    String -> Int -> IO (HandleStream bufType)
    openStream (URIAuth -> String
    uriRegName URIAuth
    hst) Int
    uPort
            updateConnectionPool c
            dorequest2 c rqst
          (HandleStream ty
    c:[HandleStream ty]
    _) -> do
            String -> BrowserAction (HandleStream ty) ()
    forall t. String -> BrowserAction t ()
    out (String
    "Recovering connection to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URIAuth -> String
    uriAuthToString URIAuth
    hst)
            BrowserEventType -> String -> BrowserAction (HandleStream ty) ()
    forall t. BrowserEventType -> String -> BrowserAction t ()
    reportEvent BrowserEventType
    ReuseConnection (URI -> String
    forall a. Show a => a -> String
    show (Request ty -> URI
    forall a. Request a -> URI
    rqURI Request ty
    rqst))
            HandleStream ty
    -> Request ty
    -> BrowserAction (HandleStream ty) (Result (Response ty))
    forall {m :: * -> *} {connection} {ty}.
    (MonadState (BrowserState connection) m, MonadIO m, HStream ty) =>
    HandleStream ty -> Request ty -> m (Result (Response ty))
    dorequest2 HandleStream ty
    c Request ty
    rqst
      case rsp of
         Right (Response ResponseCode
    a String
    b [Header]
    c ty
    _) ->
             BrowserEventType -> String -> BrowserAction (HandleStream ty) ()
    forall t. BrowserEventType -> String -> BrowserAction t ()
    reportEvent (ResponseData -> BrowserEventType
    ResponseEnd (ResponseCode
    a,String
    b,[Header]
    c)) (URI -> String
    forall a. Show a => a -> String
    show (Request ty -> URI
    forall a. Request a -> URI
    rqURI Request ty
    rqst)) ; Result (Response ty)
    _ -> () -> BrowserAction (HandleStream ty) ()
    forall a. a -> BrowserAction (HandleStream ty) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      return rsp
     where
      dorequest2 :: HandleStream ty -> Request ty -> m (Result (Response ty))
    dorequest2 HandleStream ty
    c Request ty
    r = do
        dbg <- (BrowserState connection -> Maybe String) -> m (Maybe String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState connection -> Maybe String
    forall connection. BrowserState connection -> Maybe String
    bsDebug
        st  <- get
        let
         onSendComplete =
           IO ()
    -> ((BrowserEvent -> BrowserAction connection ()) -> IO ())
    -> Maybe (BrowserEvent -> BrowserAction connection ())
    -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                 (\BrowserEvent -> BrowserAction connection ()
    evh -> do
                    x <- BrowserEventType -> String -> Int -> IO BrowserEvent
    buildBrowserEvent BrowserEventType
    RequestSent (URI -> String
    forall a. Show a => a -> String
    show (Request ty -> URI
    forall a. Request a -> URI
    rqURI Request ty
    r)) (BrowserState connection -> Int
    forall connection. BrowserState connection -> Int
    bsRequestID BrowserState connection
    st)
                    runBA st (evh x)
                    return ())
                 (BrowserState connection
    -> Maybe (BrowserEvent -> BrowserAction connection ())
    forall connection.
    BrowserState connection
    -> Maybe (BrowserEvent -> BrowserAction connection ())
    bsEvent BrowserState connection
    st)
        liftIO $
          maybe (sendHTTP_notify c r onSendComplete)
                (\ String
    f -> do
                   c' <- String -> HandleStream ty -> IO (HandleStream ty)
    forall ty.
    HStream ty =>
    String -> HandleStream ty -> IO (HandleStream ty)
    debugByteStream (String
    fString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Char
    '-'Char -> String -> String
    forall a. a -> [a] -> [a]
    : URIAuth -> String
    uriAuthToString URIAuth
    hst) HandleStream ty
    c
                   sendHTTP_notify c' r onSendComplete)
                dbg

    updateConnectionPool :: HStream hTy
                         => HandleStream hTy
                         -> BrowserAction (HandleStream hTy) ()
    updateConnectionPool :: forall hTy.
    HStream hTy =>
    HandleStream hTy -> BrowserAction (HandleStream hTy) ()
    updateConnectionPool HandleStream hTy
    c = do
       pool <- (BrowserState (HandleStream hTy) -> [HandleStream hTy])
    -> BrowserAction (HandleStream hTy) [HandleStream hTy]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState (HandleStream hTy) -> [HandleStream hTy]
    forall connection. BrowserState connection -> [connection]
    bsConnectionPool
       let len_pool = [HandleStream hTy] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [HandleStream hTy]
    pool
       maxPoolSize <- fromMaybe defaultMaxPoolSize <$> gets bsMaxPoolSize
       when (len_pool > maxPoolSize)
            (liftIO $ close (last pool))
       let pool'
            | Int
    len_pool Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxPoolSize = [HandleStream hTy] -> [HandleStream hTy]
    forall a. HasCallStack => [a] -> [a]
    init [HandleStream hTy]
    pool
            | Bool
    otherwise              = [HandleStream hTy]
    pool
       when (maxPoolSize > 0) $ modify (\BrowserState (HandleStream hTy)
    b -> BrowserState (HandleStream hTy)
    b { bsConnectionPool=c:pool' })
       return ()

    -- | Default maximum number of open connections we are willing to have active.
    defaultMaxPoolSize :: Int
    defaultMaxPoolSize :: Int
    defaultMaxPoolSize = Int
    5

    cleanConnectionPool :: HStream hTy
                        => URIAuth -> BrowserAction (HandleStream hTy) ()
    cleanConnectionPool :: forall hTy.
    HStream hTy =>
    URIAuth -> BrowserAction (HandleStream hTy) ()
    cleanConnectionPool URIAuth
    uri = do
      let ep :: EndPoint
    ep = String -> Int -> EndPoint
    EndPoint (URIAuth -> String
    uriRegName URIAuth
    uri) (Maybe URI -> URIAuth -> Int
    uriAuthPort Maybe URI
    forall a. Maybe a
    Nothing URIAuth
    uri)
      pool <- (BrowserState (HandleStream hTy) -> [HandleStream hTy])
    -> BrowserAction (HandleStream hTy) [HandleStream hTy]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets BrowserState (HandleStream hTy) -> [HandleStream hTy]
    forall connection. BrowserState connection -> [connection]
    bsConnectionPool
      bad <- liftIO $ mapM (\HandleStream hTy
    c -> HandleStream hTy
    c HandleStream hTy -> EndPoint -> IO Bool
    forall ty. HandleStream ty -> EndPoint -> IO Bool
    `isTCPConnectedTo` EndPoint
    ep) pool
      let tmp = [Bool] -> [HandleStream hTy] -> [(Bool, HandleStream hTy)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Bool]
    bad [HandleStream hTy]
    pool
          newpool = ((Bool, HandleStream hTy) -> HandleStream hTy)
    -> [(Bool, HandleStream hTy)] -> [HandleStream hTy]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, HandleStream hTy) -> HandleStream hTy
    forall a b. (a, b) -> b
    snd ([(Bool, HandleStream hTy)] -> [HandleStream hTy])
    -> [(Bool, HandleStream hTy)] -> [HandleStream hTy]
    forall a b. (a -> b) -> a -> b
    $ ((Bool, HandleStream hTy) -> Bool)
    -> [(Bool, HandleStream hTy)] -> [(Bool, HandleStream hTy)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((Bool, HandleStream hTy) -> Bool)
    -> (Bool, HandleStream hTy)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, HandleStream hTy) -> Bool
    forall a b. (a, b) -> a
    fst) [(Bool, HandleStream hTy)]
    tmp
          toclose = ((Bool, HandleStream hTy) -> HandleStream hTy)
    -> [(Bool, HandleStream hTy)] -> [HandleStream hTy]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, HandleStream hTy) -> HandleStream hTy
    forall a b. (a, b) -> b
    snd ([(Bool, HandleStream hTy)] -> [HandleStream hTy])
    -> [(Bool, HandleStream hTy)] -> [HandleStream hTy]
    forall a b. (a -> b) -> a -> b
    $ ((Bool, HandleStream hTy) -> Bool)
    -> [(Bool, HandleStream hTy)] -> [(Bool, HandleStream hTy)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool, HandleStream hTy) -> Bool
    forall a b. (a, b) -> a
    fst [(Bool, HandleStream hTy)]
    tmp
      liftIO $ forM_ toclose close
      modify (\BrowserState (HandleStream hTy)
    b -> BrowserState (HandleStream hTy)
    b { bsConnectionPool = newpool })

    handleCookies :: URI -> String -> [Header] -> BrowserAction t ()
    handleCookies :: forall t. URI -> String -> [Header] -> BrowserAction t ()
    handleCookies URI
    _   String
    _              [] = () -> BrowserAction t ()
    forall a. a -> BrowserAction t a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- cut short the silliness.
    handleCookies URI
    uri String
    dom [Header]
    cookieHeaders = do
      Bool -> BrowserAction t () -> BrowserAction t ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    errs)
           (String -> BrowserAction t ()
    forall t. String -> BrowserAction t ()
    err (String -> BrowserAction t ()) -> String -> BrowserAction t ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines (String
    "Errors parsing these cookie values: "String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    errs))
      Bool -> BrowserAction t () -> BrowserAction t ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Cookie] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Cookie]
    newCookies)
           (String -> BrowserAction t ()
    forall t. String -> BrowserAction t ()
    out (String -> BrowserAction t ()) -> String -> BrowserAction t ()
    forall a b. (a -> b) -> a -> b
    $ (String -> Cookie -> String) -> String -> [Cookie] -> String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\String
    x Cookie
    y -> String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Cookie -> String
    forall a. Show a => a -> String
    show Cookie
    y) String
    "Cookies received:" [Cookie]
    newCookies)
      filterfn    <- BrowserAction t (URI -> Cookie -> IO Bool)
    forall t. BrowserAction t (URI -> Cookie -> IO Bool)
    getCookieFilter
      newCookies' <- liftIO (filterM (filterfn uri) newCookies)
      when (not $ null newCookies')
           (out $ "Accepting cookies with names: " ++ unwords (map ckName newCookies'))
      mapM_ addCookie newCookies'
     where
      ([String]
    errs, [Cookie]
    newCookies) = String -> [Header] -> ([String], [Cookie])
    processCookieHeaders String
    dom [Header]
    cookieHeaders

    handleConnectionClose :: HStream hTy
                          => URIAuth -> [Header]
                          -> BrowserAction (HandleStream hTy) ()
    handleConnectionClose :: forall hTy.
    HStream hTy =>
    URIAuth -> [Header] -> BrowserAction (HandleStream hTy) ()
    handleConnectionClose URIAuth
    _ [] = () -> BrowserAction (HandleStream hTy) ()
    forall a. a -> BrowserAction (HandleStream hTy) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    handleConnectionClose URIAuth
    uri [Header]
    headers = do
      let doClose :: Bool
    doClose = (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "close") ([String] -> Bool) -> [String] -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Header -> String) -> [Header] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Header -> String
    headerToConnType [Header]
    headers
      Bool
    -> BrowserAction (HandleStream hTy) ()
    -> BrowserAction (HandleStream hTy) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    doClose (BrowserAction (HandleStream hTy) ()
     -> BrowserAction (HandleStream hTy) ())
    -> BrowserAction (HandleStream hTy) ()
    -> BrowserAction (HandleStream hTy) ()
    forall a b. (a -> b) -> a -> b
    $ URIAuth -> BrowserAction (HandleStream hTy) ()
    forall hTy.
    HStream hTy =>
    URIAuth -> BrowserAction (HandleStream hTy) ()
    cleanConnectionPool URIAuth
    uri
      where headerToConnType :: Header -> String
    headerToConnType (Header HeaderName
    _ String
    t) = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    t

    ------------------------------------------------------------------
    ----------------------- Miscellaneous ----------------------------
    ------------------------------------------------------------------

    allowRedirect :: RequestState -> BrowserAction t Bool
    allowRedirect :: forall t. RequestState -> BrowserAction t Bool
    allowRedirect RequestState
    rqState = do
      rd <- BrowserAction t Bool
    forall t. BrowserAction t Bool
    getAllowRedirects
      mbMxRetries <- getMaxRedirects
      return (rd && (reqRedirects rqState <= fromMaybe defaultMaxRetries mbMxRetries))

    -- | Return @True@ iff the package is able to handle requests and responses
    -- over it.
    supportedScheme :: URI -> Bool
    supportedScheme :: URI -> Bool
    supportedScheme URI
    u = URI -> String
    uriScheme URI
    u String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "http:"

    -- | @uriDefaultTo a b@ returns a URI that is consistent with the first
    -- argument URI @a@ when read in the context of the second URI @b@.
    -- If the second argument is not sufficient context for determining
    -- a full URI then anarchy reins.
    uriDefaultTo :: URI -> URI -> URI
    #if MIN_VERSION_network(2,4,0)
    uriDefaultTo :: URI -> URI -> URI
    uriDefaultTo URI
    a URI
    b = URI
    a URI -> URI -> URI
    `relativeTo` URI
    b
    #else
    uriDefaultTo a b = maybe a id (a `relativeTo` b)
    #endif

    -- This form junk is completely untested...

    type FormVar = (String,String)

    data Form = Form RequestMethod URI [FormVar]

    formToRequest :: Form -> Request_String
    formToRequest :: Form -> Request_String
    formToRequest (Form RequestMethod
    m URI
    u [(String, String)]
    vs) =
        let enc :: String
    enc = [(String, String)] -> String
    urlEncodeVars [(String, String)]
    vs
        in case RequestMethod
    m of
            RequestMethod
    GET -> Request { rqMethod :: RequestMethod
    rqMethod=RequestMethod
    GET
                           , rqHeaders :: [Header]
    rqHeaders=[ HeaderName -> String -> Header
    Header HeaderName
    HdrContentLength String
    "0" ]
                           , rqBody :: String
    rqBody=String
    ""
                           , rqURI :: URI
    rqURI=URI
    u { uriQuery= '?' : enc }  -- What about old query?
                           }
            RequestMethod
    POST -> Request { rqMethod :: RequestMethod
    rqMethod=RequestMethod
    POST
                            , rqHeaders :: [Header]
    rqHeaders=[ HeaderName -> String -> Header
    Header HeaderName
    HdrContentType String
    "application/x-www-form-urlencoded",
                                          HeaderName -> String -> Header
    Header HeaderName
    HdrContentLength (Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    enc) ]
                            , rqBody :: String
    rqBody=String
    enc
                            , rqURI :: URI
    rqURI=URI
    u
                            }
            RequestMethod
    _ -> String -> Request_String
    forall a. HasCallStack => String -> a
    error (String
    "unexpected request: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ RequestMethod -> String
    forall a. Show a => a -> String
    show RequestMethod
    m)