{-# LANGUAGE RecordWildCards #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE OverloadedStrings #-}moduleNetwork.HTTP.Conduit.Response(Response(..),getRedirectedRequest,getResponse,lbsResponse)whereimportControl.Arrow(first)importControl.Monad(liftM)importControl.Exception(throwIO)importControl.Monad.IO.Class(liftIO)importqualifiedData.ByteString.Char8asS8importqualifiedData.ByteString.LazyasLimportqualifiedData.CaseInsensitiveasCIimportData.Conduithiding(Sink,Conduit)importData.Conduit.Internal(ResumableSource(..),Pipe(..))importqualifiedData.Conduit.ZlibasCZimportqualifiedData.Conduit.BinaryasCBimportqualifiedData.Conduit.ListasCLimportqualifiedNetwork.HTTP.TypesasWimportNetwork.URI(parseURIReference)importNetwork.HTTP.Conduit.Types(Response(..))importNetwork.HTTP.Conduit.ManagerimportNetwork.HTTP.Conduit.RequestimportNetwork.HTTP.Conduit.UtilimportNetwork.HTTP.Conduit.ParserimportNetwork.HTTP.Conduit.ChunkimportData.Void(Void,absurd)importSystem.Timeout.Lifted(timeout)importControl.Monad.Trans.Control(MonadBaseControl)-- | If a request is a redirection (status code 3xx) this function will create-- a new request from the old request, the server headers returned with the-- redirection, and the redirection code itself. This function returns 'Nothing'-- if the code is not a 3xx, there is no 'location' header included, or if the-- redirected response couldn't be parsed with 'parseUrl'.---- If a user of this library wants to know the url chain that results from a-- specific request, that user has to re-implement the redirect-following logic-- themselves. An example of that might look like this:---- > myHttp req man = E.catch (runResourceT $ http req' man >> return [req'])-- > (\ (StatusCodeException status headers) -> do-- > l <- myHttp (fromJust $ nextRequest status headers) man-- > return $ req' : l)-- > where req' = req { redirectCount = 0 }-- > nextRequest status headers = getRedirectedRequest req' headers $ W.statusCode statusgetRedirectedRequest::Requestm->W.ResponseHeaders->Int->Maybe(Requestm)getRedirectedRequestreqhscode|300<=code&&code<400=dol'<-lookup"location"hsreq'<-setUriRelativereq=<<parseURIReference(S8.unpackl')return$ifcode==302||code==303-- According to the spec, this should *only* be for status code-- 303. However, almost all clients mistakenly implement it for-- 302 as well. So we have to be wrong like everyone else...thenreq'{method="GET",requestBody=RequestBodyBS""}elsereq'|otherwise=Nothing-- | Convert a 'Response' that has a 'Source' body to one with a lazy-- 'L.ByteString' body.lbsResponse::Monadm=>Response(ResumableSourcemS8.ByteString)->m(ResponseL.ByteString)lbsResponseres=dobss<-responseBodyres$$+-CL.consumereturnres{responseBody=L.fromChunksbss}-- | This function can\'t be a Conduit, since it would lose leftovers.checkHeaderLength::MonadResourcem=>Int->PipeS8.ByteStringS8.ByteStringVoidumr->PipeS8.ByteStringS8.ByteStringVoidumrcheckHeaderLengthlenNeedInput{}|len<=0=liftIO$throwIOOverlongHeaderscheckHeaderLengthlen(NeedInputpushIcloseI)=NeedInput(\bs->checkHeaderLength(len-S8.lengthbs)(pushIbs))closeIcheckHeaderLengthlen(PipeMmsink)=PipeM(liftM(checkHeaderLengthlen)msink)checkHeaderLength_s@Done{}=scheckHeaderLength_(HaveOutput__o)=absurdocheckHeaderLengthlen(Leftoverpi)=Leftover(checkHeaderLengthlenp)igetResponse::(MonadResourcem,MonadBaseControlIOm)=>ConnReleasem->Requestm->SourcemS8.ByteString->m(Response(ResumableSourcemS8.ByteString))getResponseconnReleasereq@(Request{..})src1=dolettimeout'=caseresponseTimeoutofNothing->idJustuseconds->\ma->dox<-timeoutusecondsmacasexofNothing->liftIO$throwIOResponseTimeoutJusty->returny(src2,((vbs,sc,sm),hs))<-timeout'$src1$$+checkHeaderLength4096sinkHeadersletversion=ifvbs=="1.1"thenW.http11elseW.http10lets=W.Statusscsmleths'=map(firstCI.mk)hsletmcl=lookup"content-length"hs'>>=readDec.S8.unpack-- should we put this connection back into the connection manager?lettoPut=Just"close"/=lookup"connection"hs'letcleanupbodyConsumed=connRelease$iftoPut&&bodyConsumedthenReuseelseDontReuse-- RFC 2616 section 4.4_1 defines responses that must not include a bodybody<-ifhasNoBodymethodsc||mcl==Just0thendocleanupTrue(rsrc,())<-return()$$+return()returnrsrcelsedoletsrc3=if("transfer-encoding","chunked")`elem`hs'thenfmapResume($=chunkedConduitrawBody)src2elsecasemclofJustlen->fmapResume($=CB.isolatelen)src2Nothing->src2letsrc4=ifneedsGunzipreqhs'thenfmapResume($=CZ.ungzip)src3elsesrc3return$addCleanup'cleanupsrc4return$Responsesversionhs'bodywherefmapResumef(ResumableSourcesrcm)=ResumableSource(fsrc)maddCleanup'f(ResumableSourcesrcm)=ResumableSource(addCleanupfsrc)(m>>fFalse)