{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE CPP #-}moduleNetwork.HTTP.Conduit.Request(Request(..),RequestBody(..),ContentType,Proxy(..),parseUrl,setUriRelative,browserDecompress,HttpException(..),alwaysDecompress,addProxy,applyBasicAuth,urlEncodedBody,needsGunzip,requestBuilder)whereimportData.Maybe(fromMaybe,isJust)importData.Monoid(mempty,mappend)importData.Default(Default(def))importBlaze.ByteString.Builder(Builder,fromByteString,fromLazyByteString)importBlaze.ByteString.Builder.Char8(fromChar)importqualifiedData.ConduitasCimportqualifiedData.Conduit.ListasCLimportqualifiedData.ByteStringasSimportqualifiedData.ByteString.Char8asS8importqualifiedData.ByteString.LazyasLimportqualifiedNetwork.HTTP.TypesasWimportNetwork.URI(URI(..),URIAuth(..),parseURI,relativeTo,escapeURIString,isAllowedInURI)importControl.Exception(Exception,toException)importControl.Failure(Failure(failure))importCodec.Binary.UTF8.String(encodeString)importqualifiedData.CaseInsensitiveasCIimportqualifiedData.ByteString.Base64asB64importNetwork.HTTP.Conduit.Types(Request(..),RequestBody(..),ContentType,Proxy(..),HttpException(..))importNetwork.HTTP.Conduit.Chunk(chunkIt)importNetwork.HTTP.Conduit.Util(readDec,(<>))-- | Convert a URL into a 'Request'.---- This defaults some of the values in 'Request', such as setting 'method' to-- GET and 'requestHeaders' to @[]@.---- Since this function uses 'Failure', the return monad can be anything that is-- an instance of 'Failure', such as 'IO' or 'Maybe'.parseUrl::FailureHttpExceptionm=>String->m(Requestm')parseUrls=caseparseURI(encodes)ofJusturi->setUridefuriNothing->failure$InvalidUrlExceptions"Invalid URL"whereencode=escapeURIStringisAllowedInURI.encodeString-- | Add a 'URI' to the request. If it is absolute (includes a host name), add-- it as per 'setUri'; if it is relative, merge it with the existing request.setUriRelative::FailureHttpExceptionm=>Requestm'->URI->m(Requestm')setUriRelativerequri=#if MIN_VERSION_network(2,4,0)setUrireq$uri`relativeTo`getUrireq#elsecaseuri`relativeTo`getUrireqofJusturi'->setUrirequri'Nothing->failure$InvalidUrlException(showuri)"Invalid URL"#endif-- | Extract a 'URI' from the request.getUri::Requestm'->URIgetUrireq=URI{uriScheme=ifsecurereqthen"https:"else"http:",uriAuthority=JustURIAuth{uriUserInfo="",uriRegName=S8.unpack$hostreq,uriPort=':':show(portreq)},uriPath=S8.unpack$pathreq,uriQuery=S8.unpack$queryStringreq,uriFragment=""}-- | Validate a 'URI', then add it to the request.setUri::FailureHttpExceptionm=>Requestm'->URI->m(Requestm')setUrirequri=dosec<-parseSchemeuriauth<-maybe(failUri"URL must be absolute")return$uriAuthorityuriifnot.null$uriUserInfoauththenfailUri"URL auth not supported; use applyBasicAuth instead"elsereturn()port'<-parsePortsecauthreturnreq{host=S8.pack$uriRegNameauth,port=port',secure=sec,path=S8.pack$ifnull$uriPathurithen"/"elseuriPathuri,queryString=S8.pack$uriQueryuri}wherefailUri=failure.InvalidUrlException(showuri)parseSchemeURI{uriScheme=scheme}=caseschemeof"http:"->returnFalse"https:"->returnTrue_->failUri"Invalid scheme"parsePortsecURIAuth{uriPort=portStr}=caseportStrof-- If the user specifies a port, then use it':':rest->maybe(failUri"Invalid port")return(readDecrest)-- Otherwise, use the default port_->casesecofFalse{- HTTP -}->return80True{- HTTPS -}->return443instanceDefault(Requestm)wheredef=Request{host="localhost",port=80,secure=False,requestHeaders=[],path="/",queryString=S8.empty,requestBody=RequestBodyLBSL.empty,method="GET",proxy=Nothing,socksProxy=Nothing,rawBody=False,decompress=browserDecompress,redirectCount=10,checkStatus=\s@(W.Statussci_)hs->if200<=sci&&sci<300thenNothingelseJust$toException$StatusCodeExceptionshs,responseTimeout=Just5000000}-- | Always decompress a compressed stream.alwaysDecompress::ContentType->BoolalwaysDecompress=constTrue-- | Decompress a compressed stream unless the content-type is 'application/x-tar'.browserDecompress::ContentType->BoolbrowserDecompress=(/="application/x-tar")-- | Add a Basic Auth header (with the specified user name and password) to the-- given Request. Ignore error handling:---- applyBasicAuth "user" "pass" $ fromJust $ parseUrl urlapplyBasicAuth::S.ByteString->S.ByteString->Requestm->RequestmapplyBasicAuthuserpasswdreq=req{requestHeaders=authHeader:requestHeadersreq}whereauthHeader=(CI.mk"Authorization",basic)basic=S8.append"Basic "(B64.encode$S8.concat[user,":",passwd])-- | Add a proxy to the the Request so that the Request when executed will use-- the provided proxy.addProxy::S.ByteString->Int->Requestm->RequestmaddProxyhstprtreq=req{proxy=Just$Proxyhstprt}-- FIXME add a helper for generating POST bodies-- | Add url-encoded paramters to the 'Request'.---- This sets a new 'requestBody', adds a content-type request header and-- changes the 'method' to POST.urlEncodedBody::Monadm=>[(S.ByteString,S.ByteString)]->Requestm'->RequestmurlEncodedBodyheadersreq=req{requestBody=RequestBodyLBSbody,method="POST",requestHeaders=(ct,"application/x-www-form-urlencoded"):filter(\(x,_)->x/=ct)(requestHeadersreq)}wherect="Content-Type"body=L.fromChunks.return$W.renderSimpleQueryFalseheadersneedsGunzip::Requestm->[W.Header]-- ^ response headers->BoolneedsGunzipreqhs'=not(rawBodyreq)&&("content-encoding","gzip")`elem`hs'&&decompressreq(fromMaybe""$lookup"content-type"hs')requestBuilder::Monadm=>Requestm->C.SourcemBuilderrequestBuilderreq=CL.sourceList[builder]`mappend`bodySourcewheresourceSingle=CL.sourceList.return(contentLength,bodySource)=caserequestBodyreqofRequestBodyLBSlbs->(Just$L.lengthlbs,sourceSingle$fromLazyByteStringlbs)RequestBodyBSbs->(Just$fromIntegral$S.lengthbs,sourceSingle$fromByteStringbs)RequestBodyBuilderib->(Just$i,sourceSingleb)RequestBodySourceisource->(Justi,source)RequestBodySourceChunkedsource->(Nothing,sourceC.$=chunkIt)hh|portreq==80&&not(securereq)=hostreq|portreq==443&&securereq=hostreq|otherwise=hostreq<>S8.pack(':':show(portreq))requestProtocol|securereq=fromByteString"https://"|otherwise=fromByteString"http://"requestHostname|isJust(proxyreq)=requestProtocol<>fromByteStringhh|otherwise=memptycontentLengthHeader(JustcontentLength')=ifmethodreq`elem`["GET","HEAD"]&&contentLength'==0thenidelse(:)("Content-Length",S8.pack$showcontentLength')contentLengthHeaderNothing=(:)("Transfer-Encoding","chunked")acceptEncodingHeader=caselookup"Accept-Encoding"$requestHeadersreqofNothing->(("Accept-Encoding","gzip"):)Just""->filter(\(k,_)->k/="Accept-Encoding")Just_->idhostHeaderx=caselookup"Host"xofNothing->("Host",hh):xJust{}->xheaderPairs::W.RequestHeadersheaderPairs=hostHeader$acceptEncodingHeader$contentLengthHeadercontentLength$requestHeadersreqbuilder::Builderbuilder=fromByteString(methodreq)<>fromByteString" "<>requestHostname<>(caseS8.uncons$pathreqofJust('/',_)->fromByteString$pathreq_->fromChar'/'<>fromByteString(pathreq))<>(caseS8.uncons$queryStringreqofNothing->memptyJust('?',_)->fromByteString$queryStringreq_->fromChar'?'<>fromByteString(queryStringreq))<>fromByteString" HTTP/1.1\r\n"<>foldr(\ab->headerPairToBuildera<>b)(fromByteString"\r\n")headerPairsheaderPairToBuilder(k,v)=fromByteString(CI.originalk)<>fromByteString": "<>fromByteStringv<>fromByteString"\r\n"