    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleContexts  #-}

    {-
    Copyright (c) 2002, Warrick Gray
    Copyright (c) 2002-2005, Ian Lynagh
    Copyright (c) 2003-2006, Bjorn Bringert
    Copyright (c) 2004, Andre Furtado
    Copyright (c) 2004-2005, Dominic Steinitz
    Copyright (c) 2007, Robin Bate Boerop
    Copyright (c) 2008-2010, Sigbjorn Finne
    Copyright (c) 2009, Eric Kow
    Copyright (c) 2010, Antoine Latter
    Copyright (c) 2004, 2010-2011, Ganesh Sittampalam
    Copyright (c) 2011, Duncan Coutts
    Copyright (c) 2011, Matthew Gruen
    Copyright (c) 2011, Jeremy Yallop
    Copyright (c) 2011, Eric Hesselink
    Copyright (c) 2011, Yi Huang
    Copyright (c) 2011, Tom Lokhorst
    Copyright (c) 2017, Vassil Keremidchiev

    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions are
    met:

        * Redistributions of source code must retain the above copyright
          notice, this list of conditions and the following disclaimer.

        * Redistributions in binary form must reproduce the above
          copyright notice, this list of conditions and the following
          disclaimer in the documentation and/or other materials provided
          with the distribution.

        * The names of contributors may not be used to endorse or promote
          products derived from this software without specific prior
          written permission.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
    A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
    OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
    OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    -}

    module Network.HTTP.Proxy(  ProxyProtocol(..), EnvHelper(..),
                                systemProxyHelper, envHelper,
                                httpProtocol,
                                ProxySettings ) where

    import qualified Control.Applicative         as A
    import           Control.Arrow               (first)
    import           Control.Monad               (guard)
    import qualified Data.ByteString.Char8       as S8
    import           Data.Char                   (toLower)
    import qualified Data.Map                    as Map
    import qualified Data.Text                   as T
    import           Data.Text.Read              (decimal)
    import           Network.HTTP.Client.Request (applyBasicProxyAuth,
                                                  extractBasicAuthInfo)
    import           Network.HTTP.Client.Types   (HttpExceptionContent (..),
                                                  Proxy (..), Request (..),
                                                  throwHttp)
    import qualified Network.URI                 as U
    import           System.Environment          (getEnvironment)

    #if defined(mingw32_HOST_OS)
    import           Control.Exception           (IOException, bracket, catch, try)
    import           Control.Monad               (join, liftM, mplus, when)
    import           Data.List                   (isInfixOf, isPrefixOf)
    import           Foreign                     (Storable (peek, sizeOf), alloca,
                                                  castPtr, toBool)
    import           Network.URI                 (parseAbsoluteURI)
    import           Safe                        (readDef)
    import           System.IO
    import           System.Win32.Registry       (hKEY_CURRENT_USER, rEG_DWORD,
                                                  regCloseKey, regOpenKey,
                                                  regQueryValue, regQueryValueEx)
    import           System.Win32.Types          (DWORD, HKEY)
    #endif

    type EnvName     = T.Text
    type HostAddress = S8.ByteString
    type UserName    = S8.ByteString
    type Password    = S8.ByteString

    -- There are other proxy protocols like SOCKS, FTP, etc.
    data ProxyProtocol = HTTPProxy | HTTPSProxy

    instance Show ProxyProtocol where
        show :: ProxyProtocol -> String
    show ProxyProtocol
    HTTPProxy  = String
    "http"
        show ProxyProtocol
    HTTPSProxy = String
    "https"

    data ProxySettings = ProxySettings { ProxySettings -> Proxy
    _proxyHost :: Proxy,
                                         ProxySettings -> Maybe (UserName, UserName)
    _proxyAuth :: Maybe (UserName, Password) }
                                         deriving Int -> ProxySettings -> ShowS
    [ProxySettings] -> ShowS
    ProxySettings -> String
    (Int -> ProxySettings -> ShowS)
    -> (ProxySettings -> String)
    -> ([ProxySettings] -> ShowS)
    -> Show ProxySettings
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ProxySettings -> ShowS
    showsPrec :: Int -> ProxySettings -> ShowS
    $cshow :: ProxySettings -> String
    show :: ProxySettings -> String
    $cshowList :: [ProxySettings] -> ShowS
    showList :: [ProxySettings] -> ShowS
    Show

    httpProtocol :: Bool -> ProxyProtocol
    httpProtocol :: Bool -> ProxyProtocol
    httpProtocol Bool
    True  = ProxyProtocol
    HTTPSProxy
    httpProtocol Bool
    False = ProxyProtocol
    HTTPProxy

    data EnvHelper = EHFromRequest
                   | EHNoProxy
                   | EHUseProxy Proxy

    headJust :: [Maybe a] -> Maybe a
    headJust :: forall a. [Maybe a] -> Maybe a
    headJust []               = Maybe a
    forall a. Maybe a
    Nothing
    headJust (Maybe a
    Nothing:[Maybe a]
    xs)     = [Maybe a] -> Maybe a
    forall a. [Maybe a] -> Maybe a
    headJust [Maybe a]
    xs
    headJust ((y :: Maybe a
    y@(Just a
    _)):[Maybe a]
    _) = Maybe a
    y

    systemProxyHelper :: Maybe T.Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
    systemProxyHelper :: Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
    systemProxyHelper Maybe Text
    envOveride ProxyProtocol
    prot EnvHelper
    eh = do
        let envName' :: Maybe Text -> Text
    envName' Maybe Text
    Nothing     = ProxyProtocol -> Text
    envName ProxyProtocol
    prot
            envName' (Just Text
    name) = Text
    name

        modifier <- Text -> IO (UserName -> Maybe ProxySettings)
    envHelper (Maybe Text -> Text
    envName' Maybe Text
    envOveride)

    -- Under Windows try first env. variables override then Windows proxy settings
    #if defined(mingw32_HOST_OS)
        modifier' <- systemProxy prot
        let modifiers = [modifier, modifier']
    #else
        let modifiers = [UserName -> Maybe ProxySettings
    modifier]
    #endif

        let chooseMod :: Request -> Maybe ProxySettings
            chooseMod Request
    req = [Maybe ProxySettings] -> Maybe ProxySettings
    forall a. [Maybe a] -> Maybe a
    headJust ([Maybe ProxySettings] -> Maybe ProxySettings)
    -> ([UserName -> Maybe ProxySettings] -> [Maybe ProxySettings])
    -> [UserName -> Maybe ProxySettings]
    -> Maybe ProxySettings
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((UserName -> Maybe ProxySettings) -> Maybe ProxySettings)
    -> [UserName -> Maybe ProxySettings] -> [Maybe ProxySettings]
    forall a b. (a -> b) -> [a] -> [b]
    map (\UserName -> Maybe ProxySettings
    m -> UserName -> Maybe ProxySettings
    m (UserName -> Maybe ProxySettings)
    -> (Request -> UserName) -> Request -> Maybe ProxySettings
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> UserName
    host (Request -> Maybe ProxySettings) -> Request -> Maybe ProxySettings
    forall a b. (a -> b) -> a -> b
    $ Request
    req) ([UserName -> Maybe ProxySettings] -> Maybe ProxySettings)
    -> [UserName -> Maybe ProxySettings] -> Maybe ProxySettings
    forall a b. (a -> b) -> a -> b
    $ [UserName -> Maybe ProxySettings]
    modifiers

            noEnvProxy = case EnvHelper
    eh of
                EnvHelper
    EHFromRequest -> Request -> Request
    forall a. a -> a
    id
                EnvHelper
    EHNoProxy     -> \Request
    req -> Request
    req { proxy = Nothing }
                EHUseProxy Proxy
    p  -> \Request
    req -> Request
    req { proxy = Just p  }

        let result Request
    req = Maybe ProxySettings -> Request
    toRequest (Maybe ProxySettings -> Request)
    -> (Request -> Maybe ProxySettings) -> Request -> Request
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> Maybe ProxySettings
    chooseMod (Request -> Request) -> Request -> Request
    forall a b. (a -> b) -> a -> b
    $ Request
    req where
                toRequest :: Maybe ProxySettings -> Request
    toRequest Maybe ProxySettings
    Nothing                            = Request -> Request
    noEnvProxy Request
    req
                toRequest (Just (ProxySettings Proxy
    p Maybe (UserName, UserName)
    muserpass)) = (Request -> Request)
    -> ((UserName, UserName) -> Request -> Request)
    -> Maybe (UserName, UserName)
    -> Request
    -> Request
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Request -> Request
    forall a. a -> a
    id ((UserName -> UserName -> Request -> Request)
    -> (UserName, UserName) -> Request -> Request
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry UserName -> UserName -> Request -> Request
    applyBasicProxyAuth) Maybe (UserName, UserName)
    muserpass
                                            Request
    req { proxy = Just p }
        return result

    #if defined(mingw32_HOST_OS)
    windowsProxyString :: ProxyProtocol -> IO (Maybe (String, String))
    windowsProxyString proto = do
        mProxy <- registryProxyString
        return $ do
            (proxies, exceptions) <- mProxy
            protoProxy <- parseWindowsProxy proto proxies
            return (protoProxy, exceptions)

    registryProxyLoc :: (HKEY,String)
    registryProxyLoc = (hive, path)
      where
        -- some sources say proxy settings should be at
        -- HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows
        --                   \CurrentVersion\Internet Settings\ProxyServer
        -- but if the user sets them with IE connection panel they seem to
        -- end up in the following place:
        hive  = hKEY_CURRENT_USER
        path = "Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"

    -- read proxy settings from the windows registry; this is just a best
    -- effort and may not work on all setups.
    registryProxyString :: IO (Maybe (String, String))
    registryProxyString = catch
      (bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do
        enable <- toBool . maybe 0 id A.<$> regQueryValueDWORD hkey "ProxyEnable"
        if enable
            then do
    #if MIN_VERSION_Win32(2, 6, 0) && !MIN_VERSION_Win32(2, 8, 0)
                server <- regQueryValue hkey "ProxyServer"
                exceptions <- try $ regQueryValue hkey "ProxyOverride" :: IO (Either IOException String)
    #else
                server <- regQueryValue hkey (Just "ProxyServer")
                exceptions <- try $ regQueryValue hkey (Just "ProxyOverride") :: IO (Either IOException String)
    #endif
                return $ Just (server, either (const "") id exceptions)
            else return Nothing)
      hideError where
          hideError :: IOException -> IO (Maybe (String, String))
          hideError _ = return Nothing

    -- the proxy string is in the format "http=x.x.x.x:yyyy;https=...;ftp=...;socks=..."
    -- even though the following article indicates otherwise
    -- https://support.microsoft.com/en-us/kb/819961
    --
    -- to be sure, parse strings where each entry in the ';'-separated list above is
    -- either in the format "protocol=..." or "protocol://..."
    parseWindowsProxy :: ProxyProtocol -> String -> Maybe String
    parseWindowsProxy proto s =
      case proxies of
        x:_ -> Just x
        _   -> Nothing
      where
        parts = split ';' s
        pr x = case break (== '=') x of
          (p, []) -> p  -- might be in format http://
          (p, u)  -> p ++ "://" ++ drop 1 u

        protoPrefix = (show proto) ++ "://"
        proxies = filter (isPrefixOf protoPrefix) . map pr $ parts

        split :: Eq a => a -> [a] -> [[a]]
        split _ [] = []
        split a xs = case break (a ==) xs of
          (ys, [])   -> [ys]
          (ys, _:zs) -> ys:split a zs

    -- Extract proxy settings from Windows registry. This is a standard way in Windows OS.
    systemProxy :: ProxyProtocol -> IO (HostAddress -> Maybe ProxySettings)
    systemProxy proto = do
        let isURLlocal "127.0.0.1" = True
            isURLlocal "localhost" = True
            isURLlocal _           = False

            hasLocal exceptions = "<local>" `isInfixOf` exceptions

        settings <- fetchProxy proto
        return $ \url -> do
            (proxy, exceptions) <- settings

            -- Skip proxy for local hosts if it's enabled in IE settings
            -- TODO Implement skipping for address patterns, like (*.google.com)
            if (isURLlocal url && hasLocal exceptions) || (url `S8.isInfixOf` (S8.pack exceptions)) then Nothing
            else Just proxy

    -- | @fetchProxy flg@ gets the local proxy settings and parse the string
    -- into a @Proxy@ value.
    -- Proxy settings are sourced from IE/WinInet's proxy
    -- setting in the Registry.
    fetchProxy :: ProxyProtocol -> IO (Maybe (ProxySettings, String))
    fetchProxy proto = do
        mstr <- windowsProxyString proto
        case mstr of
          Nothing               -> return Nothing
          Just (proxy, except)  -> case parseProxy proto proxy of
              Just p  -> return $ Just (p, except)
              Nothing ->
                  throwHttp . InvalidProxySettings . T.pack . unlines $
                          [ "Invalid http proxy uri: " ++ show proxy
                          , "proxy uri must be http with a hostname"
                          , "ignoring http proxy, trying a direct connection"
                          ]

    -- | @parseProxy str@ translates a proxy server string into a @ProxySettings@ value;
    -- returns @Nothing@ if not well-formed.
    parseProxy :: ProxyProtocol -> String -> Maybe ProxySettings
    parseProxy proto str = join
                     . fmap (uri2proxy proto)
                     $ parseHttpURI str
                     `mplus` parseHttpURI (protoPrefix ++ str)
        where
         protoPrefix = (show proto) ++ "://"
         parseHttpURI str' =
          case parseAbsoluteURI str' of
            Just uri@U.URI{U.uriAuthority = Just{}} -> Just (fixUserInfo uri)
            _                                       -> Nothing

           -- Note: we need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@
           -- which lack the @\"http://\"@ URI scheme. The problem is that
           -- @\"wwwcache.example.com:80\"@ is in fact a valid URI but with scheme
           -- @\"wwwcache.example.com:\"@, no authority part and a path of @\"80\"@.
           --
           -- So our strategy is to try parsing as normal uri first and if it lacks the
           -- 'uriAuthority' then we try parsing again with a @\"http://\"@ prefix.
           --

    -- | @dropWhileTail p ls@ chops off trailing elements from @ls@
    -- until @p@ returns @False@.
    dropWhileTail :: (a -> Bool) -> [a] -> [a]
    dropWhileTail f ls =
        case foldr chop Nothing ls of { Just xs -> xs; Nothing -> [] }
         where
           chop x (Just xs) = Just (x:xs)
           chop x _
            | f x       = Nothing
            | otherwise = Just [x]

    -- | @chopAtDelim elt ls@ breaks up @ls@ into two at first occurrence
    -- of @elt@; @elt@ is elided too. If @elt@ does not occur, the second
    -- list is empty and the first is equal to @ls@.
    chopAtDelim :: Eq a => a -> [a] -> ([a],[a])
    chopAtDelim elt xs =
        case break (==elt) xs of
        (_,[])    -> (xs,[])
        (as,_:bs) -> (as,bs)

    -- | tidy up user portion, don't want the trailing "\@".
    fixUserInfo :: U.URI -> U.URI
    fixUserInfo uri = uri{ U.uriAuthority = f `fmap` U.uriAuthority uri }
        where
         f a@U.URIAuth{U.uriUserInfo=s} = a{U.uriUserInfo=dropWhileTail (=='@') s}

    defaultHTTPport :: ProxyProtocol -> Int
    defaultHTTPport HTTPProxy  = 80
    defaultHTTPport HTTPSProxy = 443

    uri2proxy :: ProxyProtocol -> U.URI -> Maybe ProxySettings
    uri2proxy proto uri@U.URI{ U.uriAuthority = Just (U.URIAuth auth' hst prt) } =
        if (show proto ++ ":") == U.uriScheme uri then
            Just (ProxySettings (Proxy (S8.pack hst) (port prt)) auth) else Nothing
        where
         port (':':xs) = readDef (defaultHTTPport proto) xs
         port _        = (defaultHTTPport proto)

         auth =
           case auth' of
             [] -> Nothing
             as -> Just ((S8.pack . U.unEscapeString $ usr), (S8.pack . U.unEscapeString $ pwd))
              where
               (usr,pwd) = chopAtDelim ':' as

    uri2proxy _ _ = Nothing

    regQueryValueDWORD :: HKEY -> String -> IO (Maybe DWORD)
    regQueryValueDWORD hkey name = alloca $ \ptr -> do
      key <- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))
      if key == rEG_DWORD then
          Just A.<$> peek ptr
      else return Nothing

    -- defined(mingw32_HOST_OS)
    #endif

    envName :: ProxyProtocol -> EnvName
    envName :: ProxyProtocol -> Text
    envName ProxyProtocol
    proto = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ ProxyProtocol -> String
    forall a. Show a => a -> String
    show ProxyProtocol
    proto String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "_proxy"

    -- Extract proxy settings from environment variables. This is a standard way in Linux.
    envHelper :: EnvName -> IO (HostAddress -> Maybe ProxySettings)
    envHelper :: Text -> IO (UserName -> Maybe ProxySettings)
    envHelper Text
    name = do
      env <- IO [(String, String)]
    getEnvironment
      let lenv = [(Text, String)] -> Map Text String
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Text, String)] -> Map Text String)
    -> [(Text, String)] -> Map Text String
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> (Text, String))
    -> [(String, String)] -> [(Text, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> Text) -> (String, String) -> (Text, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((String -> Text) -> (String, String) -> (Text, String))
    -> (String -> Text) -> (String, String) -> (Text, String)
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.toLower (Text -> Text) -> (String -> Text) -> String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack) [(String, String)]
    env
          lookupEnvVar Text
    n = String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (Text -> String
    T.unpack Text
    n) [(String, String)]
    env Maybe String -> Maybe String -> Maybe String
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    A.<|> Text -> Map Text String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    n Map Text String
    lenv
          noProxyDomains = Maybe String -> [UserName]
    domainSuffixes (Text -> Maybe String
    lookupEnvVar Text
    "no_proxy")

      case lookupEnvVar name of
          Maybe String
    Nothing  -> (UserName -> Maybe ProxySettings)
    -> IO (UserName -> Maybe ProxySettings)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((UserName -> Maybe ProxySettings)
     -> IO (UserName -> Maybe ProxySettings))
    -> (Maybe ProxySettings -> UserName -> Maybe ProxySettings)
    -> Maybe ProxySettings
    -> IO (UserName -> Maybe ProxySettings)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe ProxySettings -> UserName -> Maybe ProxySettings
    forall a b. a -> b -> a
    const (Maybe ProxySettings -> IO (UserName -> Maybe ProxySettings))
    -> Maybe ProxySettings -> IO (UserName -> Maybe ProxySettings)
    forall a b. (a -> b) -> a -> b
    $ Maybe ProxySettings
    forall a. Maybe a
    Nothing
          Just String
    ""  -> (UserName -> Maybe ProxySettings)
    -> IO (UserName -> Maybe ProxySettings)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((UserName -> Maybe ProxySettings)
     -> IO (UserName -> Maybe ProxySettings))
    -> (Maybe ProxySettings -> UserName -> Maybe ProxySettings)
    -> Maybe ProxySettings
    -> IO (UserName -> Maybe ProxySettings)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe ProxySettings -> UserName -> Maybe ProxySettings
    forall a b. a -> b -> a
    const (Maybe ProxySettings -> IO (UserName -> Maybe ProxySettings))
    -> Maybe ProxySettings -> IO (UserName -> Maybe ProxySettings)
    forall a b. (a -> b) -> a -> b
    $ Maybe ProxySettings
    forall a. Maybe a
    Nothing
          Just String
    str -> do
              let invalid :: IO a
    invalid = HttpExceptionContent -> IO a
    forall a. HttpExceptionContent -> IO a
    throwHttp (HttpExceptionContent -> IO a) -> HttpExceptionContent -> IO a
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> HttpExceptionContent
    InvalidProxyEnvironmentVariable Text
    name (String -> Text
    T.pack String
    str)
              (p, muserpass) <- IO (Proxy, Maybe (UserName, UserName))
    -> ((Proxy, Maybe (UserName, UserName))
        -> IO (Proxy, Maybe (UserName, UserName)))
    -> Maybe (Proxy, Maybe (UserName, UserName))
    -> IO (Proxy, Maybe (UserName, UserName))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO (Proxy, Maybe (UserName, UserName))
    forall {a}. IO a
    invalid (Proxy, Maybe (UserName, UserName))
    -> IO (Proxy, Maybe (UserName, UserName))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Proxy, Maybe (UserName, UserName))
     -> IO (Proxy, Maybe (UserName, UserName)))
    -> Maybe (Proxy, Maybe (UserName, UserName))
    -> IO (Proxy, Maybe (UserName, UserName))
    forall a b. (a -> b) -> a -> b
    $ do
                  let allowedScheme :: a -> Bool
    allowedScheme a
    x = a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    "http:"
                  uri <- case String -> Maybe URI
    U.parseURI String
    str of
                      Just URI
    u | String -> Bool
    forall {a}. (Eq a, IsString a) => a -> Bool
    allowedScheme (URI -> String
    U.uriScheme URI
    u) -> URI -> Maybe URI
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return URI
    u
                      Maybe URI
    _      -> String -> Maybe URI
    U.parseURI (String -> Maybe URI) -> String -> Maybe URI
    forall a b. (a -> b) -> a -> b
    $ String
    "http://" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    str

                  guard $ allowedScheme $ U.uriScheme uri
                  guard $ null (U.uriPath uri) || U.uriPath uri == "/"
                  guard $ null $ U.uriQuery uri
                  guard $ null $ U.uriFragment uri

                  auth <- U.uriAuthority uri
                  port' <-
                      case U.uriPort auth of
                          String
    "" -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    80
                          Char
    ':':String
    rest ->
                              case Reader Int
    forall a. Integral a => Reader a
    decimal Reader Int -> Reader Int
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    rest of
                                  Right (Int
    p, Text
    "") -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    p
                                  Either String (Int, Text)
    _             -> Maybe Int
    forall a. Maybe a
    Nothing
                          String
    _ -> Maybe Int
    forall a. Maybe a
    Nothing

                  Just (Proxy (S8.pack $ U.uriRegName auth) port', extractBasicAuthInfo uri)
              return $ \UserName
    hostRequest ->
                  if UserName
    hostRequest UserName -> [UserName] -> Bool
    forall {t :: * -> *}. Foldable t => UserName -> t UserName -> Bool
    `hasDomainSuffixIn` [UserName]
    noProxyDomains
                  then Maybe ProxySettings
    forall a. Maybe a
    Nothing
                  else ProxySettings -> Maybe ProxySettings
    forall a. a -> Maybe a
    Just (ProxySettings -> Maybe ProxySettings)
    -> ProxySettings -> Maybe ProxySettings
    forall a b. (a -> b) -> a -> b
    $ Proxy -> Maybe (UserName, UserName) -> ProxySettings
    ProxySettings Proxy
    p Maybe (UserName, UserName)
    muserpass
      where prefixed :: UserName -> UserName
    prefixed UserName
    s | UserName -> Char
    S8.head UserName
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.' = UserName
    s
                       | Bool
    otherwise = Char -> UserName -> UserName
    S8.cons Char
    '.' UserName
    s
            domainSuffixes :: Maybe String -> [UserName]
    domainSuffixes Maybe String
    Nothing = []
            domainSuffixes (Just String
    "") = []
            domainSuffixes (Just String
    no_proxy) = [UserName -> UserName
    prefixed (UserName -> UserName) -> UserName -> UserName
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> UserName -> UserName
    S8.dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') UserName
    suffix | UserName
    suffix <- Char -> UserName -> [UserName]
    S8.split Char
    ',' (String -> UserName
    S8.pack ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    no_proxy)), Bool -> Bool
    not (UserName -> Bool
    S8.null UserName
    suffix)]
            hasDomainSuffixIn :: UserName -> t UserName -> Bool
    hasDomainSuffixIn UserName
    host' = (UserName -> Bool) -> t UserName -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (UserName -> UserName -> Bool
    `S8.isSuffixOf` UserName -> UserName
    prefixed ((Char -> Char) -> UserName -> UserName
    S8.map Char -> Char
    toLower UserName
    host'))