{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, CPP, FlexibleContexts #-}
module Network.Browser
( BrowserState
, BrowserAction
, Proxy(..)
, browse
, request
, getBrowserState
, withBrowserState
, setAllowRedirects
, getAllowRedirects
, setMaxRedirects
, getMaxRedirects
, Authority(..)
, getAuthorities
, setAuthorities
, addAuthority
, Challenge(..)
, Qop(..)
, Algorithm(..)
, getAuthorityGen
, setAuthorityGen
, setAllowBasicAuth
, getAllowBasicAuth
, setMaxErrorRetries
, getMaxErrorRetries
, setMaxPoolSize
, getMaxPoolSize
, setMaxAuthAttempts
, getMaxAuthAttempts
, setCookieFilter
, getCookieFilter
, defaultCookieFilter
, userCookieFilter
, Cookie(..)
, getCookies
, setCookies
, addCookie
, setErrHandler
, setOutHandler
, setEventHandler
, BrowserEvent(..)
, BrowserEventType(..)
, RequestID
, setProxy
, getProxy
, setCheckForProxy
, getCheckForProxy
, setDebugLog
, getUserAgent
, setUserAgent
, out
, err
, ioAction
, defaultGETRequest
, defaultGETRequest_
, formToRequest
, uriDefaultTo
, 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 )
defaultCookieFilter :: URI -> Cookie -> IO Bool
defaultCookieFilter :: URI -> Cookie -> IO Bool
defaultCookieFilter URI
_url Cookie
_cky = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show URI
url)
case Cookie -> Maybe String
ckComment Cookie
cky of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
x -> String -> IO ()
putStrLn (String
"Cookie Comment:\n" forall a. [a] -> [a] -> [a]
++ String
x)
let pth :: String
pth = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
'/'forall a. a -> [a] -> [a]
:) (Cookie -> Maybe String
ckPath Cookie
cky)
String -> IO ()
putStrLn (String
"Domain/Path: " forall a. [a] -> [a] -> [a]
++ Cookie -> String
ckDomain Cookie
cky forall a. [a] -> [a] -> [a]
++ String
pth)
String -> IO ()
putStrLn (Cookie -> String
ckName Cookie
cky forall a. [a] -> [a] -> [a]
++ Char
'=' 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]? "
Char
x <- Handle -> IO Char
System.IO.hGetChar Handle
System.IO.stdin
Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
System.IO.stdin BufferMode
System.IO.LineBuffering
Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
System.IO.stdout BufferMode
System.IO.LineBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Char
toLower Char
x forall a. Eq a => a -> a -> Bool
== Char
'y')
addCookie :: Cookie -> BrowserAction t ()
addCookie :: forall t. Cookie -> BrowserAction t ()
addCookie Cookie
c = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b{bsCookies :: [Cookie]
bsCookies = Cookie
c forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Cookie
c) (forall connection. BrowserState connection -> [Cookie]
bsCookies BrowserState t
b) })
setCookies :: [Cookie] -> BrowserAction t ()
setCookies :: forall t. [Cookie] -> BrowserAction t ()
setCookies [Cookie]
cs = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsCookies :: [Cookie]
bsCookies=[Cookie]
cs })
getCookies :: BrowserAction t [Cookie]
getCookies :: forall t. BrowserAction t [Cookie]
getCookies = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> [Cookie]
bsCookies
getCookiesFor :: String -> String -> BrowserAction t [Cookie]
getCookiesFor :: forall t. String -> String -> BrowserAction t [Cookie]
getCookiesFor String
dom String
path =
do [Cookie]
cks <- forall t. BrowserAction t [Cookie]
getCookies
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. (a -> Bool) -> [a] -> [a]
filter Cookie -> Bool
cookiematch [Cookie]
cks)
where
cookiematch :: Cookie -> Bool
cookiematch :: Cookie -> Bool
cookiematch = (String, String) -> Cookie -> Bool
cookieMatch (String
dom,String
path)
setCookieFilter :: (URI -> Cookie -> IO Bool) -> BrowserAction t ()
setCookieFilter :: forall t. (URI -> Cookie -> IO Bool) -> BrowserAction t ()
setCookieFilter URI -> Cookie -> IO Bool
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsCookieFilter :: URI -> Cookie -> IO Bool
bsCookieFilter=URI -> Cookie -> IO Bool
f })
getCookieFilter :: BrowserAction t (URI -> Cookie -> IO Bool)
getCookieFilter :: forall t. BrowserAction t (URI -> Cookie -> IO Bool)
getCookieFilter = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection.
BrowserState connection -> URI -> Cookie -> IO Bool
bsCookieFilter
getAuthFor :: String -> String -> BrowserAction t [Authority]
getAuthFor :: forall t. String -> String -> BrowserAction t [Authority]
getAuthFor String
dom String
pth = forall t. BrowserAction t [Authority]
getAuthorities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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{} = forall (t :: * -> *). Foldable t => t Bool -> Bool
or (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 forall a. Eq a => a -> a -> Bool
== String
dom) Bool -> Bool -> Bool
&& (URI -> String
uriPath URI
s forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
pth)
getAuthorities :: BrowserAction t [Authority]
getAuthorities :: forall t. BrowserAction t [Authority]
getAuthorities = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> [Authority]
bsAuthorities
setAuthorities :: [Authority] -> BrowserAction t ()
setAuthorities :: forall t. [Authority] -> BrowserAction t ()
setAuthorities [Authority]
as = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsAuthorities :: [Authority]
bsAuthorities=[Authority]
as })
addAuthority :: Authority -> BrowserAction t ()
addAuthority :: forall t. Authority -> BrowserAction t ()
addAuthority Authority
a = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsAuthorities :: [Authority]
bsAuthorities=Authority
aforall a. a -> [a] -> [a]
:forall connection. BrowserState connection -> [Authority]
bsAuthorities BrowserState t
b })
getAuthorityGen :: BrowserAction t (URI -> String -> IO (Maybe (String,String)))
getAuthorityGen :: forall t.
BrowserAction t (URI -> String -> IO (Maybe (String, String)))
getAuthorityGen = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection.
BrowserState connection
-> URI -> String -> IO (Maybe (String, String))
bsAuthorityGen
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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsAuthorityGen :: URI -> String -> IO (Maybe (String, String))
bsAuthorityGen=URI -> String -> IO (Maybe (String, String))
f })
setAllowBasicAuth :: Bool -> BrowserAction t ()
setAllowBasicAuth :: forall t. Bool -> BrowserAction t ()
setAllowBasicAuth Bool
ba = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsAllowBasicAuth :: Bool
bsAllowBasicAuth=Bool
ba })
getAllowBasicAuth :: BrowserAction t Bool
getAllowBasicAuth :: forall t. BrowserAction t Bool
getAllowBasicAuth = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Bool
bsAllowBasicAuth
setMaxAuthAttempts :: Maybe Int -> BrowserAction t ()
setMaxAuthAttempts :: forall t. Maybe Int -> BrowserAction t ()
setMaxAuthAttempts Maybe Int
mb
| forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mb forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ BrowserState t
b -> BrowserState t
b{bsMaxAuthAttempts :: Maybe Int
bsMaxAuthAttempts=Maybe Int
mb})
getMaxAuthAttempts :: BrowserAction t (Maybe Int)
getMaxAuthAttempts :: forall t. BrowserAction t (Maybe Int)
getMaxAuthAttempts = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe Int
bsMaxAuthAttempts
setMaxErrorRetries :: Maybe Int -> BrowserAction t ()
setMaxErrorRetries :: forall t. Maybe Int -> BrowserAction t ()
setMaxErrorRetries Maybe Int
mb
| forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mb forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ BrowserState t
b -> BrowserState t
b{bsMaxErrorRetries :: Maybe Int
bsMaxErrorRetries=Maybe Int
mb})
getMaxErrorRetries :: BrowserAction t (Maybe Int)
getMaxErrorRetries :: forall t. BrowserAction t (Maybe Int)
getMaxErrorRetries = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe Int
bsMaxErrorRetries
pickChallenge :: Bool -> [Challenge] -> Maybe Challenge
pickChallenge :: Bool -> [Challenge] -> Maybe Challenge
pickChallenge Bool
allowBasic []
| Bool
allowBasic = forall a. a -> Maybe a
Just (String -> Challenge
ChalBasic String
"/")
pickChallenge Bool
_ [Challenge]
ls = forall a. [a] -> Maybe a
listToMaybe [Challenge]
ls
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 = forall a. Request a -> URI
rqURI Request ty
rq in
do { [Authority]
authlist <- forall t. String -> String -> BrowserAction t [Authority]
getAuthFor (URIAuth -> String
uriAuthToString forall a b. (a -> b) -> a -> b
$ forall ty. Request ty -> URIAuth
reqURIAuth Request ty
rq) (URI -> String
uriPath URI
uri)
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> Maybe a
listToMaybe [Authority]
authlist)
}
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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = do
URI -> String -> IO (Maybe (String, String))
prompt <- forall t.
BrowserAction t (URI -> String -> IO (Maybe (String, String)))
getAuthorityGen
Maybe (String, String)
userdetails <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ URI -> String -> IO (Maybe (String, String))
prompt URI
uri (Challenge -> String
chRealm Challenge
ch)
case Maybe (String, String)
userdetails of
Maybe (String, String)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (String
u,String
p) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just 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) forall a. Eq a => a -> a -> Bool
== 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
}
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
}
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 { "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String -> String
shows (forall connection. BrowserState connection -> [Cookie]
bsCookies BrowserState t
bs) (String
"\n"
forall a. [a] -> [a] -> [a]
++ String
"AllowRedirects: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String -> String
shows (forall connection. BrowserState connection -> Bool
bsAllowRedirects BrowserState t
bs) String
"} ")
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 -> 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
<$ :: forall a b. a -> BrowserAction conn b -> BrowserAction conn a
$c<$ :: forall conn a b. a -> BrowserAction conn b -> BrowserAction conn a
fmap :: forall a b.
(a -> b) -> BrowserAction conn a -> BrowserAction conn b
$cfmap :: forall conn a b.
(a -> b) -> BrowserAction conn a -> BrowserAction conn b
Functor, 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
<* :: forall a b.
BrowserAction conn a
-> BrowserAction conn b -> BrowserAction conn a
$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 b
$c*> :: forall conn a b.
BrowserAction conn a
-> BrowserAction conn b -> BrowserAction conn b
liftA2 :: forall a b c.
(a -> b -> c)
-> BrowserAction conn a
-> BrowserAction conn b
-> BrowserAction conn c
$cliftA2 :: forall conn a b c.
(a -> b -> c)
-> BrowserAction conn a
-> BrowserAction conn b
-> BrowserAction conn c
<*> :: forall a b.
BrowserAction conn (a -> b)
-> BrowserAction conn a -> BrowserAction conn b
$c<*> :: forall conn a b.
BrowserAction conn (a -> b)
-> BrowserAction conn a -> BrowserAction conn b
pure :: forall a. a -> BrowserAction conn a
$cpure :: forall conn a. a -> BrowserAction conn a
Applicative, 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
return :: forall a. a -> BrowserAction conn a
$creturn :: forall conn a. a -> BrowserAction conn a
>> :: 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 b
>>= :: forall a b.
BrowserAction conn a
-> (a -> BrowserAction conn b) -> BrowserAction conn b
$c>>= :: forall conn a b.
BrowserAction conn a
-> (a -> BrowserAction conn b) -> BrowserAction conn b
Monad, 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
liftIO :: forall a. IO a -> BrowserAction conn a
$cliftIO :: forall conn a. IO a -> BrowserAction conn a
MonadIO, MonadState (BrowserState conn)
#if MIN_VERSION_base(4,9,0)
, 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
fail :: forall a. String -> BrowserAction conn a
$cfail :: forall conn 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT BrowserState conn
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn a.
BrowserAction conn a -> StateT (BrowserState conn) IO a
unBA
browse :: BrowserAction conn a -> IO a
browse :: forall conn a. BrowserAction conn a -> IO a
browse = forall conn a. BrowserState conn -> BrowserAction conn a -> IO a
runBA forall t. BrowserState t
defaultBrowserState
defaultBrowserState :: BrowserState t
defaultBrowserState :: forall t. BrowserState t
defaultBrowserState = 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
forall connection. BrowserState connection -> String -> IO ()
bsErr BrowserState connection
res String
"No action for prompting/generating user+password credentials provided (use: setAuthorityGen); returning Nothing"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
, bsAuthorities :: [Authority]
bsAuthorities = []
, bsAllowRedirects :: Bool
bsAllowRedirects = Bool
True
, bsAllowBasicAuth :: Bool
bsAllowBasicAuth = Bool
False
, bsMaxRedirects :: Maybe Int
bsMaxRedirects = forall a. Maybe a
Nothing
, bsMaxErrorRetries :: Maybe Int
bsMaxErrorRetries = forall a. Maybe a
Nothing
, bsMaxAuthAttempts :: Maybe Int
bsMaxAuthAttempts = forall a. Maybe a
Nothing
, bsMaxPoolSize :: Maybe Int
bsMaxPoolSize = forall a. Maybe a
Nothing
, bsConnectionPool :: [connection]
bsConnectionPool = []
, bsCheckProxy :: Bool
bsCheckProxy = Bool
defaultAutoProxyDetect
, bsProxy :: Proxy
bsProxy = Proxy
noProxy
, bsDebug :: Maybe String
bsDebug = forall a. Maybe a
Nothing
, bsEvent :: Maybe (BrowserEvent -> BrowserAction connection ())
bsEvent = forall a. Maybe a
Nothing
, bsRequestID :: Int
bsRequestID = Int
0
, bsUserAgent :: Maybe String
bsUserAgent = forall a. Maybe a
Nothing
}
{-# DEPRECATED getBrowserState "Use Control.Monad.State.get instead." #-}
getBrowserState :: BrowserAction t (BrowserState t)
getBrowserState :: forall conn. BrowserAction conn (BrowserState conn)
getBrowserState = forall s (m :: * -> *). MonadState s m => m s
get
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 = forall conn a.
StateT (BrowserState conn) IO a -> BrowserAction conn a
BA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT (forall a b. a -> b -> a
const BrowserState t
bs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn a.
BrowserAction conn a -> StateT (BrowserState conn) IO a
unBA
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 = forall a. Enum a => a -> a
succ (forall connection. BrowserState connection -> Int
bsRequestID BrowserState connection
st)
in
Int
rid seq :: forall a b. a -> b -> b
`seq` BrowserState connection
st{bsRequestID :: Int
bsRequestID=Int
rid}
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall {connection}.
BrowserState connection -> BrowserState connection
updReqID
BrowserAction t a
act
{-# DEPRECATED ioAction "Use Control.Monad.Trans.liftIO instead." #-}
ioAction :: IO a -> BrowserAction t a
ioAction :: forall a t. IO a -> BrowserAction t a
ioAction = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
setErrHandler :: (String -> IO ()) -> BrowserAction t ()
setErrHandler :: forall t. (String -> IO ()) -> BrowserAction t ()
setErrHandler String -> IO ()
h = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsErr :: String -> IO ()
bsErr=String -> IO ()
h })
setOutHandler :: (String -> IO ()) -> BrowserAction t ()
setOutHandler :: forall t. (String -> IO ()) -> BrowserAction t ()
setOutHandler String -> IO ()
h = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b { bsOut :: String -> IO ()
bsOut=String -> IO ()
h })
out, err :: String -> BrowserAction t ()
out :: forall t. String -> BrowserAction t ()
out String
s = do { String -> IO ()
f <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> String -> IO ()
bsOut ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
f String
s }
err :: forall t. String -> BrowserAction t ()
err String
s = do { String -> IO ()
f <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> String -> IO ()
bsErr ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
f String
s }
setAllowRedirects :: Bool -> BrowserAction t ()
setAllowRedirects :: forall t. Bool -> BrowserAction t ()
setAllowRedirects Bool
bl = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b {bsAllowRedirects :: Bool
bsAllowRedirects=Bool
bl})
getAllowRedirects :: BrowserAction t Bool
getAllowRedirects :: forall t. BrowserAction t Bool
getAllowRedirects = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Bool
bsAllowRedirects
setMaxRedirects :: Maybe Int -> BrowserAction t ()
setMaxRedirects :: forall t. Maybe Int -> BrowserAction t ()
setMaxRedirects Maybe Int
c
| forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
c forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b{bsMaxRedirects :: Maybe Int
bsMaxRedirects=Maybe Int
c})
getMaxRedirects :: BrowserAction t (Maybe Int)
getMaxRedirects :: forall t. BrowserAction t (Maybe Int)
getMaxRedirects = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe Int
bsMaxRedirects
setMaxPoolSize :: Maybe Int -> BrowserAction t ()
setMaxPoolSize :: forall t. Maybe Int -> BrowserAction t ()
setMaxPoolSize Maybe Int
c = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b{bsMaxPoolSize :: Maybe Int
bsMaxPoolSize=Maybe Int
c})
getMaxPoolSize :: BrowserAction t (Maybe Int)
getMaxPoolSize :: forall t. BrowserAction t (Maybe Int)
getMaxPoolSize = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe Int
bsMaxPoolSize
setProxy :: Proxy -> BrowserAction t ()
setProxy :: forall t. Proxy -> BrowserAction t ()
setProxy Proxy
p =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b {bsProxy :: Proxy
bsProxy = Proxy
p, bsCheckProxy :: Bool
bsCheckProxy=Bool
False})
getProxy :: BrowserAction t Proxy
getProxy :: forall t. BrowserAction t Proxy
getProxy = do
Proxy
p <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Proxy
bsProxy
case Proxy
p of
Proxy{} -> forall (m :: * -> *) a. Monad m => a -> m a
return Proxy
p
NoProxy{} -> do
Bool
flg <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Bool
bsCheckProxy
if Bool -> Bool
not Bool
flg
then forall (m :: * -> *) a. Monad m => a -> m a
return Proxy
p
else do
Proxy
np <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> IO Proxy
fetchProxy Bool
True
forall t. Proxy -> BrowserAction t ()
setProxy Proxy
np
forall (m :: * -> *) a. Monad m => a -> m a
return Proxy
np
setCheckForProxy :: Bool -> BrowserAction t ()
setCheckForProxy :: forall t. Bool -> BrowserAction t ()
setCheckForProxy Bool
flg = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ BrowserState t
b -> BrowserState t
b{bsCheckProxy :: Bool
bsCheckProxy=Bool
flg})
getCheckForProxy :: BrowserAction t Bool
getCheckForProxy :: forall t. BrowserAction t Bool
getCheckForProxy = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Bool
bsCheckProxy
setDebugLog :: Maybe String -> BrowserAction t ()
setDebugLog :: forall t. Maybe String -> BrowserAction t ()
setDebugLog Maybe String
v = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b {bsDebug :: Maybe String
bsDebug=Maybe String
v})
setUserAgent :: String -> BrowserAction t ()
setUserAgent :: forall t. String -> BrowserAction t ()
setUserAgent String
ua = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState t
b -> BrowserState t
b{bsUserAgent :: Maybe String
bsUserAgent=forall a. a -> Maybe a
Just String
ua})
getUserAgent :: BrowserAction t String
getUserAgent :: forall t. BrowserAction t String
getUserAgent = do
Maybe String
n <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe String
bsUserAgent
forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
defaultUserAgent forall a. a -> a
id Maybe String
n)
data RequestState
= RequestState
{ RequestState -> Int
reqDenies :: Int
, RequestState -> Int
reqRedirects :: Int
, RequestState -> Int
reqRetries :: Int
, RequestState -> Bool
reqStopOnDeny :: Bool
}
type RequestID = Int
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
}
data BrowserEvent
= BrowserEvent
{ BrowserEvent -> UTCTime
browserTimestamp :: UTCTime
, BrowserEvent -> Int
browserRequestID :: RequestID
, BrowserEvent -> String
browserRequestURI :: String
, BrowserEvent -> BrowserEventType
browserEventType :: BrowserEventType
}
data BrowserEventType
= OpenConnection
| ReuseConnection
| RequestSent
| ResponseEnd ResponseData
| ResponseFinish
setEventHandler :: Maybe (BrowserEvent -> BrowserAction ty ()) -> BrowserAction ty ()
setEventHandler :: forall ty.
Maybe (BrowserEvent -> BrowserAction ty ()) -> BrowserAction ty ()
setEventHandler Maybe (BrowserEvent -> BrowserAction ty ())
mbH = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState ty
b -> BrowserState ty
b { bsEvent :: Maybe (BrowserEvent -> BrowserAction ty ())
bsEvent=Maybe (BrowserEvent -> BrowserAction ty ())
mbH})
buildBrowserEvent :: BrowserEventType -> String -> RequestID -> IO BrowserEvent
buildBrowserEvent :: BrowserEventType -> String -> Int -> IO BrowserEvent
buildBrowserEvent BrowserEventType
bt String
uri Int
reqID = do
UTCTime
ct <- IO UTCTime
getCurrentTime
forall (m :: * -> *) a. Monad m => a -> m a
return BrowserEvent
{ browserTimestamp :: UTCTime
browserTimestamp = UTCTime
ct
, browserRequestID :: Int
browserRequestID = Int
reqID
, browserRequestURI :: String
browserRequestURI = String
uri
, browserEventType :: BrowserEventType
browserEventType = BrowserEventType
bt
}
reportEvent :: BrowserEventType -> String -> BrowserAction t ()
reportEvent :: forall t. BrowserEventType -> String -> BrowserAction t ()
reportEvent BrowserEventType
bt String
uri = do
BrowserState t
st <- forall s (m :: * -> *). MonadState s m => m s
get
case forall connection.
BrowserState connection
-> Maybe (BrowserEvent -> BrowserAction connection ())
bsEvent BrowserState t
st of
Maybe (BrowserEvent -> BrowserAction t ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just BrowserEvent -> BrowserAction t ()
evH -> do
BrowserEvent
evt <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ BrowserEventType -> String -> Int -> IO BrowserEvent
buildBrowserEvent BrowserEventType
bt String
uri (forall connection. BrowserState connection -> Int
bsRequestID BrowserState t
st)
BrowserEvent -> BrowserAction t ()
evH BrowserEvent
evt
defaultMaxRetries :: Int
defaultMaxRetries :: Int
defaultMaxRetries = Int
4
defaultMaxErrorRetries :: Int
defaultMaxErrorRetries :: Int
defaultMaxErrorRetries = Int
4
defaultMaxAuthAttempts :: Int
defaultMaxAuthAttempts :: Int
defaultMaxAuthAttempts = Int
2
defaultAutoProxyDetect :: Bool
defaultAutoProxyDetect :: Bool
defaultAutoProxyDetect = Bool
False
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 = forall t a. BrowserAction t a -> BrowserAction t a
nextRequest forall a b. (a -> b) -> a -> b
$ do
Result (URI, Response ty)
res <- forall ty.
HStream ty =>
ty
-> RequestState
-> Request ty
-> BrowserAction (HandleStream ty) (Result (URI, Response ty))
request' ty
nullVal RequestState
initialState Request ty
req
forall t. BrowserEventType -> String -> BrowserAction t ()
reportEvent BrowserEventType
ResponseFinish (forall a. Show a => a -> String
show (forall a. Request a -> URI
rqURI Request ty
req))
case Result (URI, Response ty)
res of
Right (URI, Response ty)
r -> 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ConnError
e)
forall t. String -> BrowserAction t ()
err String
errStr
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
errStr
where
initialState :: RequestState
initialState = RequestState
nullRequestState
nullVal :: ty
nullVal = forall a. BufferOp a -> a
buf_empty forall bufType. BufferType bufType => BufferOp bufType
bufferOps
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 = forall a. Request a -> URI
rqURI Request ty
rq
forall (m :: * -> *). MonadFail m => URI -> m ()
failHTTPS URI
uri
let uria :: URIAuth
uria = forall ty. Request ty -> URIAuth
reqURIAuth Request ty
rq
[Cookie]
cookies <- forall t. String -> String -> BrowserAction t [Cookie]
getCookiesFor (URIAuth -> String
uriAuthToString URIAuth
uria) (URI -> String
uriPath URI
uri)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cookie]
cookies)
(forall t. String -> BrowserAction t ()
out forall a b. (a -> b) -> a -> b
$ String
"Adding cookies to request. Cookie names: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map Cookie -> String
ckName [Cookie]
cookies))
Request ty
rq' <-
if Bool -> Bool
not (RequestState -> Bool
reqStopOnDeny RequestState
rqState)
then forall (m :: * -> *) a. Monad m => a -> m a
return Request ty
rq
else do
Maybe Authority
auth <- forall ty t. Request ty -> BrowserAction t (Maybe Authority)
anticipateChallenge Request ty
rq
case Maybe Authority
auth of
Maybe Authority
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Request ty
rq
Just Authority
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasHeaders a => HeaderSetter a
insertHeader HeaderName
HdrAuthorization (forall ty. Authority -> Request ty -> String
withAuthority Authority
x Request ty
rq) Request ty
rq)
let rq'' :: Request ty
rq'' = if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cookie]
cookies then forall a. HasHeaders a => [Header] -> a -> a
insertHeaders [[Cookie] -> Header
cookiesToHeader [Cookie]
cookies] Request ty
rq' else Request ty
rq'
Proxy
p <- forall t. BrowserAction t Proxy
getProxy
Maybe String
def_ua <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe String
bsUserAgent
let defaultOpts :: NormalizeRequestOptions ty
defaultOpts =
case Proxy
p of
Proxy
NoProxy -> forall ty. NormalizeRequestOptions ty
defaultNormalizeRequestOptions{normUserAgent :: Maybe String
normUserAgent=Maybe String
def_ua}
Proxy String
_ Maybe Authority
ath ->
forall ty. NormalizeRequestOptions ty
defaultNormalizeRequestOptions
{ normForProxy :: Bool
normForProxy = Bool
True
, normUserAgent :: Maybe String
normUserAgent = Maybe String
def_ua
, normCustoms :: [RequestNormalizer ty]
normCustoms =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []
(\ Authority
authS -> [\ NormalizeRequestOptions ty
_ Request ty
r -> forall a. HasHeaders a => HeaderSetter a
insertHeader HeaderName
HdrProxyAuthorization (forall ty. Authority -> Request ty -> String
withAuthority Authority
authS Request ty
r) Request ty
r])
Maybe Authority
ath
}
let final_req :: Request ty
final_req = forall ty. NormalizeRequestOptions ty -> Request ty -> Request ty
normalizeRequest forall ty. NormalizeRequestOptions ty
defaultOpts Request ty
rq''
forall t. String -> BrowserAction t ()
out (String
"Sending:\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Request ty
final_req)
Result (Response ty)
e_rsp <-
case Proxy
p of
Proxy
NoProxy -> forall ty.
HStream ty =>
URIAuth
-> Request ty
-> BrowserAction (HandleStream ty) (Result (Response ty))
dorequest (forall ty. Request ty -> URIAuth
reqURIAuth Request ty
rq'') Request ty
final_req
Proxy String
str Maybe Authority
_ath -> do
let notURI :: URIAuth
notURI
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pt Bool -> Bool -> 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
}
where (String
hst, String
pt) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char
':'forall a. Eq a => a -> a -> Bool
/=) String
str
let proxyURIAuth :: URIAuth
proxyURIAuth =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe URIAuth
notURI
(\URI
parsed -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe URIAuth
notURI forall a. a -> a
id (URI -> Maybe URIAuth
uriAuthority URI
parsed))
(String -> Maybe URI
parseURI String
str)
forall t. String -> BrowserAction t ()
out forall a b. (a -> b) -> a -> b
$ String
"proxy uri host: " forall a. [a] -> [a] -> [a]
++ URIAuth -> String
uriRegName URIAuth
proxyURIAuth forall a. [a] -> [a] -> [a]
++ String
", port: " forall a. [a] -> [a] -> [a]
++ URIAuth -> String
uriPort URIAuth
proxyURIAuth
forall ty.
HStream ty =>
URIAuth
-> Request ty
-> BrowserAction (HandleStream ty) (Result (Response ty))
dorequest URIAuth
proxyURIAuth Request ty
final_req
Maybe Int
mbMx <- forall t. BrowserAction t (Maybe Int)
getMaxErrorRetries
case Result (Response ty)
e_rsp of
Left ConnError
v
| (RequestState -> Int
reqRetries RequestState
rqState forall a. Ord a => a -> a -> Bool
< forall a. a -> Maybe a -> a
fromMaybe Int
defaultMaxErrorRetries Maybe Int
mbMx) Bool -> Bool -> Bool
&&
(ConnError
v forall a. Eq a => a -> a -> Bool
== ConnError
ErrorReset Bool -> Bool -> Bool
|| ConnError
v forall a. Eq a => a -> a -> Bool
== ConnError
ErrorClosed) -> do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState (HandleStream ty)
b -> BrowserState (HandleStream ty)
b { bsConnectionPool :: [HandleStream ty]
bsConnectionPool=[] })
forall ty.
HStream ty =>
ty
-> RequestState
-> Request ty
-> BrowserAction (HandleStream ty) (Result (URI, Response ty))
request' ty
nullVal RequestState
rqState{reqRetries :: Int
reqRetries=forall a. Enum a => a -> a
succ (RequestState -> Int
reqRetries RequestState
rqState)} Request ty
rq
| Bool
otherwise ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left ConnError
v)
Right Response ty
rsp -> do
forall t. String -> BrowserAction t ()
out (String
"Received:\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Response ty
rsp)
forall t. URI -> String -> [Header] -> BrowserAction t ()
handleCookies URI
uri (URIAuth -> String
uriAuthToString forall a b. (a -> b) -> a -> b
$ forall ty. Request ty -> URIAuth
reqURIAuth Request ty
rq)
(forall a. HasHeaders a => HeaderName -> a -> [Header]
retrieveHeaders HeaderName
HdrSetCookie Response ty
rsp)
forall hTy.
HStream hTy =>
URIAuth -> [Header] -> BrowserAction (HandleStream hTy) ()
handleConnectionClose (forall ty. Request ty -> URIAuth
reqURIAuth Request ty
rq) (forall a. HasHeaders a => HeaderName -> a -> [Header]
retrieveHeaders HeaderName
HdrConnection Response ty
rsp)
Maybe Int
mbMxAuths <- forall t. BrowserAction t (Maybe Int)
getMaxAuthAttempts
case forall a. Response a -> ResponseCode
rspCode Response ty
rsp of
(Int
4,Int
0,Int
1)
| RequestState -> Int
reqDenies RequestState
rqState forall a. Ord a => a -> a -> Bool
> forall a. a -> Maybe a -> a
fromMaybe Int
defaultMaxAuthAttempts Maybe Int
mbMxAuths -> do
forall t. String -> BrowserAction t ()
out String
"401 - credentials again refused; exceeded retry count (2)"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
| Bool
otherwise -> do
forall t. String -> BrowserAction t ()
out String
"401 - credentials not supplied or refused; retrying.."
let hdrs :: [Header]
hdrs = forall a. HasHeaders a => HeaderName -> a -> [Header]
retrieveHeaders HeaderName
HdrWWWAuthenticate Response ty
rsp
Bool
flg <- forall t. BrowserAction t Bool
getAllowBasicAuth
case Bool -> [Challenge] -> Maybe Challenge
pickChallenge Bool
flg (forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (URI -> Header -> Maybe Challenge
headerToChallenge URI
uri) [Header]
hdrs) of
Maybe Challenge
Nothing -> do
forall t. String -> BrowserAction t ()
out String
"no challenge"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Just Challenge
x -> do
Maybe Authority
au <- forall t. URI -> Challenge -> BrowserAction t (Maybe Authority)
challengeToAuthority URI
uri Challenge
x
case Maybe Authority
au of
Maybe Authority
Nothing -> do
forall t. String -> BrowserAction t ()
out String
"no auth"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Just Authority
au' -> do
forall t. String -> BrowserAction t ()
out String
"Retrying request with new credentials"
forall ty.
HStream ty =>
ty
-> RequestState
-> Request ty
-> BrowserAction (HandleStream ty) (Result (URI, Response ty))
request' ty
nullVal
RequestState
rqState{ reqDenies :: Int
reqDenies = forall a. Enum a => a -> a
succ(RequestState -> Int
reqDenies RequestState
rqState)
, reqStopOnDeny :: Bool
reqStopOnDeny = Bool
False
}
(forall a. HasHeaders a => HeaderSetter a
insertHeader HeaderName
HdrAuthorization (forall ty. Authority -> Request ty -> String
withAuthority Authority
au' Request ty
rq) Request ty
rq)
(Int
4,Int
0,Int
7)
| RequestState -> Int
reqDenies RequestState
rqState forall a. Ord a => a -> a -> Bool
> forall a. a -> Maybe a -> a
fromMaybe Int
defaultMaxAuthAttempts Maybe Int
mbMxAuths -> do
forall t. String -> BrowserAction t ()
out String
"407 - proxy authentication required; max deny count exceeeded (2)"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
| Bool
otherwise -> do
forall t. String -> BrowserAction t ()
out String
"407 - proxy authentication required"
let hdrs :: [Header]
hdrs = forall a. HasHeaders a => HeaderName -> a -> [Header]
retrieveHeaders HeaderName
HdrProxyAuthenticate Response ty
rsp
Bool
flg <- forall t. BrowserAction t Bool
getAllowBasicAuth
case Bool -> [Challenge] -> Maybe Challenge
pickChallenge Bool
flg (forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (URI -> Header -> Maybe Challenge
headerToChallenge URI
uri) [Header]
hdrs) of
Maybe Challenge
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Just Challenge
x -> do
Maybe Authority
au <- forall t. URI -> Challenge -> BrowserAction t (Maybe Authority)
challengeToAuthority URI
uri Challenge
x
case Maybe Authority
au of
Maybe Authority
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Just Authority
au' -> do
Proxy
pxy <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Proxy
bsProxy
case Proxy
pxy of
Proxy
NoProxy -> do
forall t. String -> BrowserAction t ()
err String
"Proxy authentication required without proxy!"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Proxy String
px Maybe Authority
_ -> do
forall t. String -> BrowserAction t ()
out String
"Retrying with proxy authentication"
forall t. Proxy -> BrowserAction t ()
setProxy (String -> Maybe Authority -> Proxy
Proxy String
px (forall a. a -> Maybe a
Just Authority
au'))
forall ty.
HStream ty =>
ty
-> RequestState
-> Request ty
-> BrowserAction (HandleStream ty) (Result (URI, Response ty))
request' ty
nullVal
RequestState
rqState{ reqDenies :: Int
reqDenies = forall a. Enum a => a -> a
succ(RequestState -> Int
reqDenies RequestState
rqState)
, reqStopOnDeny :: Bool
reqStopOnDeny = Bool
False
}
Request ty
rq
(Int
3,Int
0,Int
x) | Int
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
2,Int
3,Int
1,Int
7] -> do
forall t. String -> BrowserAction t ()
out (String
"30" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x forall a. [a] -> [a] -> [a]
++ String
" - redirect")
Bool
allow_redirs <- forall t. RequestState -> BrowserAction t Bool
allowRedirect RequestState
rqState
case Bool
allow_redirs of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Bool
_ -> do
case forall a. HasHeaders a => HeaderName -> a -> [Header]
retrieveHeaders HeaderName
HdrLocation Response ty
rsp of
[] -> do
forall t. String -> BrowserAction t ()
err String
"No Location: header in redirect response"
forall (m :: * -> *) a. Monad m => a -> m a
return (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
forall t. String -> BrowserAction t ()
err (String
"Parse of Location: header in a redirect response failed: " forall a. [a] -> [a] -> [a]
++ String
u)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Just URI
newURI
| (Bool -> Bool
not (URI -> Bool
supportedScheme URI
newURI_abs)) -> do
forall t. String -> BrowserAction t ()
err (String
"Unable to handle redirect, unsupported scheme: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show URI
newURI_abs)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri, Response ty
rsp))
| Bool
otherwise -> do
forall t. String -> BrowserAction t ()
out (String
"Redirecting to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show URI
newURI_abs forall a. [a] -> [a] -> [a]
++ String
" ...")
let toGet :: Bool
toGet = Int
x 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 forall a. Request a -> RequestMethod
rqMethod Request ty
rq
rq1 :: Request ty
rq1 = Request ty
rq { rqMethod :: RequestMethod
rqMethod=RequestMethod
method, rqURI :: URI
rqURI=URI
newURI_abs }
rq2 :: Request ty
rq2 = if Bool
toGet then (forall a. HasHeaders a => HeaderSetter a
replaceHeader HeaderName
HdrContentLength String
"0") (Request ty
rq1 {rqBody :: ty
rqBody = ty
nullVal}) else Request ty
rq1
forall ty.
HStream ty =>
ty
-> RequestState
-> Request ty
-> BrowserAction (HandleStream ty) (Result (URI, Response ty))
request' ty
nullVal
RequestState
rqState{ reqDenies :: Int
reqDenies = Int
0
, reqRedirects :: Int
reqRedirects = forall a. Enum a => a -> a
succ(RequestState -> Int
reqRedirects RequestState
rqState)
, reqStopOnDeny :: Bool
reqStopOnDeny = Bool
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 forall a. HasHeaders a => HeaderName -> a -> [Header]
retrieveHeaders HeaderName
HdrLocation Response ty
rsp of
[] -> do
forall t. String -> BrowserAction t ()
err String
"No Location header in proxy redirect response."
forall (m :: * -> *) a. Monad m => a -> m a
return (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
forall t. String -> BrowserAction t ()
err (String
"Parse of Location header in a proxy redirect response failed: " forall a. [a] -> [a] -> [a]
++ String
u)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
Just URI
newuri -> do
forall t. String -> BrowserAction t ()
out (String
"Retrying with proxy " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show URI
newuri forall a. [a] -> [a] -> [a]
++ String
"...")
forall t. Proxy -> BrowserAction t ()
setProxy (String -> Maybe Authority -> Proxy
Proxy (URI -> String
uriToAuthorityString URI
newuri) forall a. Maybe a
Nothing)
forall ty.
HStream ty =>
ty
-> RequestState
-> Request ty
-> BrowserAction (HandleStream ty) (Result (URI, Response ty))
request' ty
nullVal RequestState
rqState{ reqDenies :: Int
reqDenies = Int
0
, reqRedirects :: Int
reqRedirects = Int
0
, reqRetries :: Int
reqRetries = forall a. Enum a => a -> a
succ (RequestState -> Int
reqRetries RequestState
rqState)
, reqStopOnDeny :: Bool
reqStopOnDeny = Bool
True
}
Request ty
rq
ResponseCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (URI
uri,Response ty
rsp))
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
[HandleStream ty]
pool <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> [connection]
bsConnectionPool
let uPort :: Int
uPort = Maybe URI -> URIAuth -> Int
uriAuthPort forall a. Maybe a
Nothing URIAuth
hst
[HandleStream ty]
conn <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\HandleStream ty
c -> HandleStream ty
c forall ty. HandleStream ty -> EndPoint -> IO Bool
`isTCPConnectedTo` String -> Int -> EndPoint
EndPoint (URIAuth -> String
uriRegName URIAuth
hst) Int
uPort) [HandleStream ty]
pool
Result (Response ty)
rsp <-
case [HandleStream ty]
conn of
[] -> do
forall t. String -> BrowserAction t ()
out (String
"Creating new connection to " forall a. [a] -> [a] -> [a]
++ URIAuth -> String
uriAuthToString URIAuth
hst)
forall t. BrowserEventType -> String -> BrowserAction t ()
reportEvent BrowserEventType
OpenConnection (forall a. Show a => a -> String
show (forall a. Request a -> URI
rqURI Request ty
rqst))
HandleStream ty
c <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall bufType.
HStream bufType =>
String -> Int -> IO (HandleStream bufType)
openStream (URIAuth -> String
uriRegName URIAuth
hst) Int
uPort
forall hTy.
HStream hTy =>
HandleStream hTy -> BrowserAction (HandleStream hTy) ()
updateConnectionPool HandleStream ty
c
forall {connection} {m :: * -> *} {ty}.
(MonadState (BrowserState connection) m, MonadIO m, HStream ty) =>
HandleStream ty -> Request ty -> m (Result (Response ty))
dorequest2 HandleStream ty
c Request ty
rqst
(HandleStream ty
c:[HandleStream ty]
_) -> do
forall t. String -> BrowserAction t ()
out (String
"Recovering connection to " forall a. [a] -> [a] -> [a]
++ URIAuth -> String
uriAuthToString URIAuth
hst)
forall t. BrowserEventType -> String -> BrowserAction t ()
reportEvent BrowserEventType
ReuseConnection (forall a. Show a => a -> String
show (forall a. Request a -> URI
rqURI Request ty
rqst))
forall {connection} {m :: * -> *} {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 Result (Response ty)
rsp of
Right (Response ResponseCode
a String
b [Header]
c ty
_) ->
forall t. BrowserEventType -> String -> BrowserAction t ()
reportEvent (ResponseData -> BrowserEventType
ResponseEnd (ResponseCode
a,String
b,[Header]
c)) (forall a. Show a => a -> String
show (forall a. Request a -> URI
rqURI Request ty
rqst)) ; Result (Response ty)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return Result (Response ty)
rsp
where
dorequest2 :: HandleStream ty -> Request ty -> m (Result (Response ty))
dorequest2 HandleStream ty
c Request ty
r = do
Maybe String
dbg <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe String
bsDebug
BrowserState connection
st <- forall s (m :: * -> *). MonadState s m => m s
get
let
onSendComplete :: IO ()
onSendComplete =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())
(\BrowserEvent -> BrowserAction connection ()
evh -> do
BrowserEvent
x <- BrowserEventType -> String -> Int -> IO BrowserEvent
buildBrowserEvent BrowserEventType
RequestSent (forall a. Show a => a -> String
show (forall a. Request a -> URI
rqURI Request ty
r)) (forall connection. BrowserState connection -> Int
bsRequestID BrowserState connection
st)
forall conn a. BrowserState conn -> BrowserAction conn a -> IO a
runBA BrowserState connection
st (BrowserEvent -> BrowserAction connection ()
evh BrowserEvent
x)
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(forall connection.
BrowserState connection
-> Maybe (BrowserEvent -> BrowserAction connection ())
bsEvent BrowserState connection
st)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
sendHTTP_notify HandleStream ty
c Request ty
r IO ()
onSendComplete)
(\ String
f -> do
HandleStream ty
c' <- forall ty.
HStream ty =>
String -> HandleStream ty -> IO (HandleStream ty)
debugByteStream (String
fforall a. [a] -> [a] -> [a]
++Char
'-'forall a. a -> [a] -> [a]
: URIAuth -> String
uriAuthToString URIAuth
hst) HandleStream ty
c
forall ty.
HStream ty =>
HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
sendHTTP_notify HandleStream ty
c' Request ty
r IO ()
onSendComplete)
Maybe String
dbg
updateConnectionPool :: HStream hTy
=> HandleStream hTy
-> BrowserAction (HandleStream hTy) ()
updateConnectionPool :: forall hTy.
HStream hTy =>
HandleStream hTy -> BrowserAction (HandleStream hTy) ()
updateConnectionPool HandleStream hTy
c = do
[HandleStream hTy]
pool <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> [connection]
bsConnectionPool
let len_pool :: Int
len_pool = forall (t :: * -> *) a. Foldable t => t a -> Int
length [HandleStream hTy]
pool
Int
maxPoolSize <- forall a. a -> Maybe a -> a
fromMaybe Int
defaultMaxPoolSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> Maybe Int
bsMaxPoolSize
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len_pool forall a. Ord a => a -> a -> Bool
> Int
maxPoolSize)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall bufType. HStream bufType => HandleStream bufType -> IO ()
close (forall a. [a] -> a
last [HandleStream hTy]
pool))
let pool' :: [HandleStream hTy]
pool'
| Int
len_pool forall a. Ord a => a -> a -> Bool
> Int
maxPoolSize = forall a. [a] -> [a]
init [HandleStream hTy]
pool
| Bool
otherwise = [HandleStream hTy]
pool
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
maxPoolSize forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState (HandleStream hTy)
b -> BrowserState (HandleStream hTy)
b { bsConnectionPool :: [HandleStream hTy]
bsConnectionPool=HandleStream hTy
cforall a. a -> [a] -> [a]
:[HandleStream hTy]
pool' })
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 forall a. Maybe a
Nothing URIAuth
uri)
[HandleStream hTy]
pool <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall connection. BrowserState connection -> [connection]
bsConnectionPool
[Bool]
bad <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\HandleStream hTy
c -> HandleStream hTy
c forall ty. HandleStream ty -> EndPoint -> IO Bool
`isTCPConnectedTo` EndPoint
ep) [HandleStream hTy]
pool
let tmp :: [(Bool, HandleStream hTy)]
tmp = forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
bad [HandleStream hTy]
pool
newpool :: [HandleStream hTy]
newpool = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Bool, HandleStream hTy)]
tmp
toclose :: [HandleStream hTy]
toclose = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> a
fst [(Bool, HandleStream hTy)]
tmp
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HandleStream hTy]
toclose forall bufType. HStream bufType => HandleStream bufType -> IO ()
close
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\BrowserState (HandleStream hTy)
b -> BrowserState (HandleStream hTy)
b { bsConnectionPool :: [HandleStream hTy]
bsConnectionPool = [HandleStream hTy]
newpool })
handleCookies :: URI -> String -> [Header] -> BrowserAction t ()
handleCookies :: forall t. URI -> String -> [Header] -> BrowserAction t ()
handleCookies URI
_ String
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleCookies URI
uri String
dom [Header]
cookieHeaders = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs)
(forall t. String -> BrowserAction t ()
err forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (String
"Errors parsing these cookie values: "forall a. a -> [a] -> [a]
:[String]
errs))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cookie]
newCookies)
(forall t. String -> BrowserAction t ()
out forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String
x Cookie
y -> String
x forall a. [a] -> [a] -> [a]
++ String
"\n " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Cookie
y) String
"Cookies received:" [Cookie]
newCookies)
URI -> Cookie -> IO Bool
filterfn <- forall t. BrowserAction t (URI -> Cookie -> IO Bool)
getCookieFilter
[Cookie]
newCookies' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (URI -> Cookie -> IO Bool
filterfn URI
uri) [Cookie]
newCookies)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cookie]
newCookies')
(forall t. String -> BrowserAction t ()
out forall a b. (a -> b) -> a -> b
$ String
"Accepting cookies with names: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map Cookie -> String
ckName [Cookie]
newCookies'))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Cookie -> BrowserAction t ()
addCookie [Cookie]
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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleConnectionClose URIAuth
uri [Header]
headers = do
let doClose :: Bool
doClose = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== String
"close") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Header -> String
headerToConnType [Header]
headers
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doClose forall a b. (a -> b) -> a -> b
$ forall hTy.
HStream hTy =>
URIAuth -> BrowserAction (HandleStream hTy) ()
cleanConnectionPool URIAuth
uri
where headerToConnType :: Header -> String
headerToConnType (Header HeaderName
_ String
t) = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
t
allowRedirect :: RequestState -> BrowserAction t Bool
allowRedirect :: forall t. RequestState -> BrowserAction t Bool
allowRedirect RequestState
rqState = do
Bool
rd <- forall t. BrowserAction t Bool
getAllowRedirects
Maybe Int
mbMxRetries <- forall t. BrowserAction t (Maybe Int)
getMaxRedirects
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
rd Bool -> Bool -> Bool
&& (RequestState -> Int
reqRedirects RequestState
rqState forall a. Ord a => a -> a -> Bool
<= forall a. a -> Maybe a -> a
fromMaybe Int
defaultMaxRetries Maybe Int
mbMxRetries))
supportedScheme :: URI -> Bool
supportedScheme :: URI -> Bool
supportedScheme URI
u = URI -> String
uriScheme URI
u forall a. Eq a => a -> a -> Bool
== String
"http:"
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
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 :: String
uriQuery= Char
'?' forall a. a -> [a] -> [a]
: String
enc }
}
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 (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
enc) ]
, rqBody :: String
rqBody=String
enc
, rqURI :: URI
rqURI=URI
u
}
RequestMethod
_ -> forall a. HasCallStack => String -> a
error (String
"unexpected request: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RequestMethod
m)