{-# 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 -> [Char]
show ProxyProtocol
HTTPProxy  = [Char]
"http"
    show ProxyProtocol
HTTPSProxy = [Char]
"https"

data ProxySettings = ProxySettings { ProxySettings -> Proxy
_proxyHost :: Proxy,
                                     ProxySettings -> Maybe (UserName, UserName)
_proxyAuth :: Maybe (UserName, Password) }
                                     deriving Int -> ProxySettings -> ShowS
[ProxySettings] -> ShowS
ProxySettings -> [Char]
(Int -> ProxySettings -> ShowS)
-> (ProxySettings -> [Char])
-> ([ProxySettings] -> ShowS)
-> Show ProxySettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProxySettings -> ShowS
showsPrec :: Int -> ProxySettings -> ShowS
$cshow :: ProxySettings -> [Char]
show :: ProxySettings -> [Char]
$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 = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ProxyProtocol -> [Char]
forall a. Show a => a -> [Char]
show ProxyProtocol
proto [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"_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 [([Char], [Char])]
getEnvironment
  let lenv = [(Text, [Char])] -> Map Text [Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Char])] -> Map Text [Char])
-> [(Text, [Char])] -> Map Text [Char]
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> (Text, [Char]))
-> [([Char], [Char])] -> [(Text, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> Text) -> ([Char], [Char]) -> (Text, [Char])
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 (([Char] -> Text) -> ([Char], [Char]) -> (Text, [Char]))
-> ([Char] -> Text) -> ([Char], [Char]) -> (Text, [Char])
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) [([Char], [Char])]
env
      lookupEnvVar Text
n = [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> [Char]
T.unpack Text
n) [([Char], [Char])]
env Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
A.<|> Text -> Map Text [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
n Map Text [Char]
lenv
      noProxyDomains = Maybe [Char] -> [UserName]
domainSuffixes (Text -> Maybe [Char]
lookupEnvVar Text
"no_proxy")

  case lookupEnvVar name of
      Maybe [Char]
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 [Char]
""  -> (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 [Char]
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 ([Char] -> Text
T.pack [Char]
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 [Char] -> Maybe URI
U.parseURI [Char]
str of
                  Just URI
u | [Char] -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
allowedScheme (URI -> [Char]
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
_      -> [Char] -> Maybe URI
U.parseURI ([Char] -> Maybe URI) -> [Char] -> Maybe URI
forall a b. (a -> b) -> a -> b
$ [Char]
"http://" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
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
                      [Char]
"" -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
80
                      Char
':':[Char]
rest ->
                          case Reader Int
forall a. Integral a => Reader a
decimal Reader Int -> Reader Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
rest of
                              Right (Int
p, Text
"") -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p
                              Either [Char] (Int, Text)
_             -> Maybe Int
forall a. Maybe a
Nothing
                      [Char]
_ -> 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 [Char] -> [UserName]
domainSuffixes Maybe [Char]
Nothing = []
        domainSuffixes (Just [Char]
"") = []
        domainSuffixes (Just [Char]
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
',' ([Char] -> UserName
S8.pack ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
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'))