{-# LANGUAGE CPP, ScopedTypeVariables, FlexibleContexts, OverloadedStrings #-}-- | This module is designed to work similarly to the Network.Browser module in the HTTP package.-- The idea is that there are two new types defined: 'BrowserState' and 'BrowserAction'. The-- purpose of this module is to make it easy to describe a browsing session, including navigating-- to multiple pages, and have things like cookie jar updates work as expected as you browse-- around.---- BrowserAction is a monad that handles all your browser-related activities. This monad is-- actually implemented as a specialization of the State monad, over the BrowserState type. The-- BrowserState type has various bits of information that a web browser keeps, such as a current-- cookie jar, the number of times to retry a request on failure, HTTP proxy information, etc. In-- the BrowserAction monad, there is one BrowserState at any given time, and you can modify it by-- using the convenience functions in this module.---- A special kind of modification of the current browser state is the action of making a HTTP-- request. This will do the request according to the params in the current BrowserState, as well-- as modifying the current state with, for example, an updated cookie jar and location.---- To use this module, you would bind together a series of BrowserActions (This simulates the user-- clicking on links or using a settings dialogue etc.) to describe your browsing session. When-- you've described your session, you call 'browse' on your top-level BrowserAction to actually-- convert your actions into the ResourceT IO monad.---- Here is an example program:---- > {-# LANGUAGE OverloadedStrings #-}-- > import qualified Data.ByteString.Lazy as LB-- > import qualified Data.Text.Encoding as TE-- > import qualified Data.Text.Lazy.Encoding as TLE-- > import qualified Data.Text.Lazy.IO as TLIO-- > import Data.Conduit-- > import Network.HTTP.Conduit-- > import Network.HTTP.Conduit.Browser-- >-- > -- The web request to log in to a service-- > req1 :: IO (Request (ResourceT IO))-- > req1 = do-- > req <- parseUrl "http://www.myurl.com/login.php"-- > return $ urlEncodedBody [ (TE.encodeUtf8 "name", TE.encodeUtf8 "litherum")-- > , (TE.encodeUtf8 "pass", TE.encodeUtf8 "S33kRe7")-- > ] req-- >-- > -- Once authenticated, run this request-- > req2 :: IO (Request m')-- > req2 = parseUrl "http://www.myurl.com/main.php"-- >-- > -- Bind two BrowserActions together-- > action :: Request (ResourceT IO) -> Request (ResourceT IO) -> BrowserAction (Response LB.ByteString)-- > action r1 r2 = do-- > _ <- makeRequestLbs r1-- > makeRequestLbs r2-- >-- > main :: IO ()-- > main = do-- > man <- newManager def-- > r1 <- req1-- > r2 <- req2-- > out <- runResourceT $ browse man $ do-- > setDefaultHeader "User-Agent" $ Just "A very popular browser"-- > action r1 r2-- > TLIO.putStrLn $ TLE.decodeUtf8 $ responseBody outmoduleNetwork.HTTP.Conduit.Browser(-- * MainBrowserAction,GenericBrowserAction,browse,parseRelativeUrl,makeRequest,makeRequestLbs,downloadFile-- * Browser state-- | You can save and restore the state at will,BrowserState,defaultState,getBrowserState,setBrowserState,withBrowserState-- ** Manager-- | The active manager, managing the connection pool,getManager,setManager-- ** Location-- | The last visited url (similar to the location bar in mainstream browsers).-- Location is updated on every request.---- default: @Nothing@,getLocation,setLocation,withLocation-- ** Cookies-- *** Cookie jar-- | Global cookie jar.-- Cookies in Request's 'cookieJar' are preferred to global cookies if-- there's a name collision.---- default: @'def'@,getCookieJar,setCookieJar,withCookieJar-- *** Cookie filter-- | Each new Set-Cookie the browser encounters will pass through this filter.-- Only cookies that pass the filter (and are already valid) will be allowed into the cookie jar---- default: @const $ const $ return True@,getCookieFilter,setCookieFilter,withCookieFilter-- ** Proxies-- *** HTTP-- | An optional proxy to send all requests through-- if Nothing uses Request's 'proxy'---- default: @Nothing@,getCurrentProxy,setCurrentProxy,withCurrentProxy-- *** SOCKS-- | An optional SOCKS proxy to send all requests through-- if Nothing uses Request's 'socksProxy'---- default: @Nothing@,getCurrentSocksProxy,setCurrentSocksProxy,withCurrentSocksProxy-- ** Redirects-- | The number of redirects to allow.-- if Nothing uses Request's 'redirectCount'---- default: @Nothing@,getMaxRedirects,setMaxRedirects,withMaxRedirects-- ** Retries-- | The number of times to retry a failed connection---- default: @0@,getMaxRetryCount,setMaxRetryCount,withMaxRetryCount-- ** Timeout-- | Number of microseconds to wait for a response.-- if Nothing uses Request's 'responseTimeout'---- default: @Nothing@,getTimeout,setTimeout,withTimeout-- ** Authorities-- | A user-provided function that provides optional authorities.-- This function gets run on all requests before they get sent out.-- The output of this function is applied to the request.---- default: @const Nothing@,getAuthorities,setAuthorities,withAuthorities-- ** Client certificates-- | SSL client certificates---- default: @Nothing@,getClientCertificates,setClientCertificates,withClientCertificates-- ** Headers-- *** Default headers-- | Specifies Headers that should be added to 'Request',-- these will be overriden by any headers specified in 'requestHeaders'.---- > do insertDefaultHeader ("User-Agent", "dog")-- > insertDefaultHeader ("Connection", "keep-alive")-- > makeRequest def{requestHeaders = [("User-Agent", "kitten"), ("Accept", "x-animal/mouse")]}-- > > User-Agent: kitten-- > > Accept: x-animal/mouse-- > > Connection: keep-alive---- default: @[(\"User-Agent\", \"http-conduit-browser\")]@,getDefaultHeaders,setDefaultHeaders,withDefaultHeaders,getDefaultHeader,setDefaultHeader,insertDefaultHeader,deleteDefaultHeader,withDefaultHeader-- *** Override headers-- | Specifies Headers that should be added to 'Request',-- these will override Headers already specified in 'requestHeaders'.---- > do insertOverrideHeader ("User-Agent", "rat")-- > insertOverrideHeader ("Connection", "keep-alive")-- > makeRequest def{requestHeaders = [("User-Agent", "kitten"), ("Accept", "everything/digestible")]}-- > > User-Agent: rat-- > > Accept: everything/digestible-- > > Connection: keep-alive---- default: @[]@,getOverrideHeaders,setOverrideHeaders,withOverrideHeaders,getOverrideHeader,setOverrideHeader,insertOverrideHeader,deleteOverrideHeader,withOverrideHeader-- ** Error handling-- | Function to check the status code. Note that this will run after all redirects are performed.-- if Nothing uses Request's 'checkStatus'---- default: @Nothing@,getCheckStatus,setCheckStatus,withCheckStatus)whereimportNetwork.HTTP.ConduitimportNetwork.HTTP.Conduit.Internal(httpRedirect,getUri,setUri,generateCookie,insertCheckedCookie)importqualifiedNetwork.HTTP.TypesasHTimportNetwork.Socks5(SocksConf)importNetwork.URI(URI(..),parseRelativeReference,relativeTo)importData.Time.Clock(getCurrentTime,UTCTime)importWeb.Cookie(parseSetCookie)importData.Certificate.X509(X509)importNetwork.TLS(PrivateKey)importData.ConduitimportqualifiedData.Conduit.BinaryasCBimportqualifiedData.ByteStringasBSimportqualifiedData.ByteString.LazyasLimportData.Function(on)importData.List(partition,union)importData.Maybe(catMaybes,fromMaybe)importControl.MonadimportControl.Monad.IO.ClassimportControl.Monad.Trans.ClassimportControl.Monad.Trans.StateimportControl.Monad.Trans.Resource(liftResourceT)#if !MIN_VERSION_conduit(0,5,3)importControl.Monad.Trans.Control(MonadBaseControl)#endifimportControl.FailureimportqualifiedControl.Exception.LiftedasLEimportControl.Exception(SomeException,toException)importqualifiedData.MapasMapdataBrowserState=BrowserState{currentLocation::MaybeURI,maxRedirects::MaybeInt,maxRetryCount::Int,timeout::MaybeInt,authorities::Request(ResourceTIO)->Maybe(BS.ByteString,BS.ByteString),browserClientCertificates::Maybe[(X509,MaybePrivateKey)],cookieFilter::Request(ResourceTIO)->Cookie->IOBool,browserCookieJar::CookieJar,currentProxy::MaybeProxy,currentSocksProxy::MaybeSocksConf,overrideHeaders::Map.MapHT.HeaderNameBS.ByteString,defaultHeaders::Map.MapHT.HeaderNameBS.ByteString,browserCheckStatus::Maybe(HT.Status->HT.ResponseHeaders->CookieJar->MaybeSomeException),manager::Manager}defaultState::Manager->BrowserStatedefaultStatem=BrowserState{currentLocation=Nothing,maxRedirects=Nothing,maxRetryCount=0,timeout=Nothing,authorities=constNothing,browserClientCertificates=Nothing,cookieFilter=const$const$returnTrue,browserCookieJar=def,currentProxy=Nothing,currentSocksProxy=Nothing,overrideHeaders=Map.empty,defaultHeaders=Map.singletonHT.hUserAgent"http-conduit-browser",browserCheckStatus=Nothing,manager=m}typeBrowserAction=GenericBrowserAction(ResourceTIO)typeGenericBrowserActionm=StateTBrowserStatem-- | Do the browser action with the given managerbrowse::Monadm=>Manager->GenericBrowserActionma->mabrowsemact=evalStateTact(defaultStatem)-- | Convert an URL relative to current Location into a 'Request'---- Will throw 'InvalidUrlException' on parse failures or if your Location is 'Nothing' (e.g. you haven't made any requests before)parseRelativeUrl::FailureHttpExceptionm=>String->GenericBrowserActionm(Requestm')parseRelativeUrlurl=maybeerruse=<<getscurrentLocationwhereerr=lift$failure$InvalidUrlExceptionurl"Invalid URL"useloc=maybeerr(setUridef)$douri<-parseRelativeReferenceurlrelativeTo'uriloc#if MIN_VERSION_network(2,4,0)relativeTo'x=Just.relativeTox#elserelativeTo'=relativeTo#endif-- | Make a request, using all the state in the current BrowserStatemakeRequest::(MonadBaseControlIOm,MonadResourcem)=>Request(ResourceTIO)->GenericBrowserActionm(Response(ResumableSource(ResourceTIO)BS.ByteString))makeRequestreq=doBrowserState{maxRetryCount=max_retry_count,maxRedirects=max_redirects,timeout=time_out,currentProxy=current_proxy,currentSocksProxy=current_socks_proxy,defaultHeaders=default_headers,overrideHeaders=override_headers,browserCheckStatus=current_check_status,browserClientCertificates=client_certificates}<-getretryHelper(applyOverrideHeadersoverride_headers$applyDefaultHeadersdefault_headers$req{redirectCount=0,proxy=maybe(proxyreq)Justcurrent_proxy,socksProxy=maybe(socksProxyreq)Justcurrent_socks_proxy,checkStatus=\___->Nothing,responseTimeout=maybe(responseTimeoutreq)Justtime_out,clientCertificates=fromMaybe(clientCertificatesreq)client_certificates})max_retry_count(fromMaybe(redirectCountreq)max_redirects)(fromMaybe(checkStatusreq)current_check_status)NothingwhereretryHelperrequest'retry_countmax_redirectscheck_statuse|retry_count<0=caseeofJuste'->LE.throwIOe'Nothing->LE.throwIOTooManyRetries|otherwise=dores<-LE.catch(ifmax_redirects==0thenperformRequestrequest'elserunRedirectionChainrequest'max_redirects)(\(e'::HttpException)->retryHelperrequest'(retry_count-1)max_redirectscheck_status$Just$toExceptione')casecheck_status(responseStatusres)(responseHeadersres)(responseCookieJarres)ofNothing->returnresJuste'->retryHelperrequest'(retry_count-1)max_redirectscheck_status(Juste')runRedirectionChainrequest'redirect_count=httpRedirectredirect_count(\request->dores<-performRequestrequestletmreq=getRedirectedRequestrequest(responseHeadersres)(responseCookieJarres)(HT.statusCode$responseStatusres)return(res,mreq))liftResourceTrequest'performRequestrequest''=dos@(BrowserState{manager=manager',authorities=auths,browserCookieJar=cookie_jar',cookieFilter=cookie_filter})<-getletrequest'=(applyAuthoritiesauthsrequest''){cookieJar=Just$createCookieJar$(union`on`destroyCookieJar)(fromMaybedef$cookieJarrequest'')cookie_jar'}res<-liftResourceT$httprequest'manager'(cookie_jar,_)<-liftIO$donow<-getCurrentTimeupdateMyCookieJarresrequest'nowcookie_jar'cookie_filterput$s{browserCookieJar=cookie_jar,currentLocation=Just$getUrirequest'}returnresapplyAuthorities::(Requesta->Maybe(BS.ByteString,BS.ByteString))->Requesta->RequestaapplyAuthoritiesauthsrequest'=caseauthsrequest'ofJust(user,pass)->applyBasicAuthuserpassrequest'Nothing->request'applyDefaultHeaders::Map.MapHT.HeaderNameBS.ByteString->Requesta->RequestaapplyDefaultHeadersdvrequest=request{requestHeaders=x$requestHeadersrequest}wherexr=Map.toList$Map.union(Map.fromListr)dvapplyOverrideHeaders::Map.MapHT.HeaderNameBS.ByteString->Requesta->RequestaapplyOverrideHeadersovrequest=request{requestHeaders=x$requestHeadersrequest}wherexr=Map.toList$Map.unionov(Map.fromListr)-- | Make a request and pack the result as a lazy bytestring.---- Note: Even though this function returns a lazy bytestring, it does not-- utilize lazy I/O, and therefore the entire response body will live in memory.-- If you want constant memory usage, you'll need to use the conduit package and-- 'makeRequest' directly.makeRequestLbs::(MonadBaseControlIOm,MonadResourcem)=>Request(ResourceTIO)->GenericBrowserActionm(ResponseL.ByteString)makeRequestLbs=liftResourceT.lbsResponse<=<makeRequest-- | Make a request and sink the 'responseBody' to a file.downloadFile::(MonadResourcem,MonadBaseControlIOm)=>FilePath->Request(ResourceTIO)->GenericBrowserActionm()downloadFilefilerequest=dores<-makeRequestrequestliftResourceT$responseBodyres$$+-CB.sinkFilefileupdateMyCookieJar::Responsea->Request(ResourceTIO)->UTCTime->CookieJar->(Request(ResourceTIO)->Cookie->IOBool)->IO(CookieJar,Responsea)updateMyCookieJarresponserequest'nowcookie_jarcookie_filter=dofiltered_cookies<-filterM(cookie_filterrequest')$catMaybes$map(\sc->generateCookiescrequest'nowTrue)set_cookiesreturn(cookieJar'filtered_cookies,response{responseHeaders=other_headers})where(set_cookie_headers,other_headers)=partition((=="Set-Cookie").fst)$responseHeadersresponseset_cookie_data=mapsndset_cookie_headersset_cookies=mapparseSetCookieset_cookie_datacookieJar'=foldl(\cjc->insertCheckedCookieccjTrue)cookie_jargetBrowserState::Monadm=>GenericBrowserActionmBrowserStategetBrowserState=getsetBrowserState::Monadm=>BrowserState->GenericBrowserActionm()setBrowserState=putwithBrowserState::Monadm=>BrowserState->GenericBrowserActionma->GenericBrowserActionmawithBrowserStatesa=docurrent<-getputsout<-aputcurrentreturnoutgetManager::Monadm=>GenericBrowserActionmManagergetManager=get>>=\a->return$managerasetManager::Monadm=>Manager->GenericBrowserActionm()setManagerb=get>>=\a->puta{manager=b}#define RET(x) x#define CONCAT(x,y) RET(x)y#define GENERIC_FIELD(Name, field, Type)\CONCAT(get,Name)::Monadm=>GenericBrowserActionm(Type);\CONCAT(get,Name)=getsfield;\CONCAT(set,Name)::Monadm=>(Type)->GenericBrowserActionm();\CONCAT(set,Name)b=get>>=\a->puta{field=b};\CONCAT(with,Name)::Monadm=>(Type)->GenericBrowserActionma->GenericBrowserActionma;\CONCAT(with,Name)ab=do\current<-CONCAT(get,Name);\CONCAT(set,Name)a;\out<-b;\CONCAT(set,Name)current;\returnout;\GENERIC_FIELD(Location,currentLocation,MaybeURI)GENERIC_FIELD(MaxRedirects,maxRedirects,MaybeInt)GENERIC_FIELD(MaxRetryCount,maxRetryCount,Int)GENERIC_FIELD(Timeout,timeout,MaybeInt)GENERIC_FIELD(Authorities,authorities,Request(ResourceTIO)->Maybe(BS.ByteString,BS.ByteString))GENERIC_FIELD(ClientCertificates,browserClientCertificates,Maybe[(X509,MaybePrivateKey)])GENERIC_FIELD(CookieFilter,cookieFilter,Request(ResourceTIO)->Cookie->IOBool)GENERIC_FIELD(CookieJar,browserCookieJar,CookieJar)GENERIC_FIELD(CurrentProxy,currentProxy,MaybeProxy)GENERIC_FIELD(CurrentSocksProxy,currentSocksProxy,MaybeSocksConf)GENERIC_FIELD(CheckStatus,browserCheckStatus,Maybe(HT.Status->HT.ResponseHeaders->CookieJar->MaybeSomeException))#undef GENERIC_FIELD#undef CONCAT#undef RETgetDefaultHeaders::Monadm=>GenericBrowserActionmHT.RequestHeadersgetDefaultHeaders=gets$Map.toList.defaultHeaderssetDefaultHeaders::Monadm=>HT.RequestHeaders->GenericBrowserActionm()setDefaultHeadersb=get>>=\a->puta{defaultHeaders=Map.fromListb}withDefaultHeaders::Monadm=>HT.RequestHeaders->GenericBrowserActionma->GenericBrowserActionmawithDefaultHeadersab=docurrent<-getDefaultHeaderssetDefaultHeadersaout<-bsetDefaultHeaderscurrentreturnoutgetDefaultHeader::Monadm=>HT.HeaderName->GenericBrowserActionm(MaybeBS.ByteString)getDefaultHeaderb=gets$Map.lookupb.defaultHeaderssetDefaultHeader::Monadm=>HT.HeaderName->MaybeBS.ByteString->GenericBrowserActionm()setDefaultHeaderbNothing=deleteDefaultHeaderbsetDefaultHeaderb(Justc)=insertDefaultHeader(b,c)insertDefaultHeader::Monadm=>HT.Header->GenericBrowserActionm()insertDefaultHeader(b,c)=get>>=\a->puta{defaultHeaders=Map.insertbc(defaultHeadersa)}deleteDefaultHeader::Monadm=>HT.HeaderName->GenericBrowserActionm()deleteDefaultHeaderb=get>>=\a->puta{defaultHeaders=Map.deleteb(defaultHeadersa)}withDefaultHeader::Monadm=>HT.Header->GenericBrowserActionma->GenericBrowserActionmawithDefaultHeader(a,b)c=docurrent<-getDefaultHeaderainsertDefaultHeader(a,b)out<-csetDefaultHeaderacurrentreturnoutgetOverrideHeaders::Monadm=>GenericBrowserActionmHT.RequestHeadersgetOverrideHeaders=gets$Map.toList.overrideHeaderssetOverrideHeaders::Monadm=>HT.RequestHeaders->GenericBrowserActionm()setOverrideHeadersb=get>>=\a->puta{overrideHeaders=Map.fromListb}withOverrideHeaders::Monadm=>HT.RequestHeaders->GenericBrowserActionma->GenericBrowserActionmawithOverrideHeadersab=docurrent<-getOverrideHeaderssetOverrideHeadersaout<-bsetOverrideHeaderscurrentreturnoutgetOverrideHeader::Monadm=>HT.HeaderName->GenericBrowserActionm(MaybeBS.ByteString)getOverrideHeaderb=gets$Map.lookupb.overrideHeaderssetOverrideHeader::Monadm=>HT.HeaderName->MaybeBS.ByteString->GenericBrowserActionm()setOverrideHeaderbNothing=deleteOverrideHeaderbsetOverrideHeaderb(Justc)=insertOverrideHeader(b,c)insertOverrideHeader::Monadm=>HT.Header->GenericBrowserActionm()insertOverrideHeader(b,c)=get>>=\a->puta{overrideHeaders=Map.insertbc(overrideHeadersa)}deleteOverrideHeader::Monadm=>HT.HeaderName->GenericBrowserActionm()deleteOverrideHeaderb=get>>=\a->puta{overrideHeaders=Map.deleteb(overrideHeadersa)}withOverrideHeader::Monadm=>HT.Header->GenericBrowserActionma->GenericBrowserActionmawithOverrideHeader(a,b)c=docurrent<-getOverrideHeaderainsertOverrideHeader(a,b)out<-csetOverrideHeaderacurrentreturnout