---------------------------------------------------------------------------------- |-- Module : Network.URL-- Copyright : (c) Galois, Inc. 2007, 2008-- License : BSD3---- Maintainer : Iavor S. Diatchki-- Stability : Provisional-- Portability : Portable---- Provides a convenient way for working with HTTP URLs.-- Based on RFC 1738.-- See also: RFC 3986moduleNetwork.URL(URL(..),URLType(..),Host(..),Protocol(..),secure,secure_prot,exportURL,importURL,exportHost,add_param,decString,encString,ok_host,ok_url,ok_param,ok_path,exportParams,importParams)whereimportData.Word(Word8)importData.Char(isAlpha,isAscii,isDigit)importData.List(intersperse)importNumeric(readHex,showHex)importControl.MonadimportCodec.Binary.UTF8.StringasUTF8-- | Contains information about the connection to the host.dataHost=Host{protocol::Protocol,host::String,port::MaybeInteger}deriving(Eq,Ord,Show)-- | The type of known protocols.dataProtocol=HTTPBool|FTPBool|RawProtStringderiving(Eq,Ord,Show)-- | Is this a \"secure\" protocol. This works only for known protocols,-- for 'RawProt' values we return 'False'.secure_prot::Protocol->Boolsecure_prot(HTTPs)=ssecure_prot(FTPs)=ssecure_prot(RawProt_)=False-- | Does this host use a \"secure\" protocol (e.g., https).secure::Host->Boolsecurex=secure_prot(protocolx)-- | Different types of URL.dataURLType=AbsoluteHost-- ^ Has a host|HostRelative-- ^ Does not have a host|PathRelative-- ^ Relative to another URLderiving(Eq,Ord,Show)-- | A type for working with URL.-- The parameters are in @application\/x-www-form-urlencoded@ format:-- <http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1>dataURL=URL{url_type::URLType,url_path::String,url_params::[(String,String)]}deriving(Eq,Ord,Show)-- | Add a (key,value) parameter to a URL.add_param::URL->(String,String)->URLadd_paramurlx=url{url_params=x:url_paramsurl}-- | Convert a list of \"bytes\" to a URL.importURL::String->MaybeURLimportURLcs0=do(ho,cs5)<-frontcs0(pa,cs6)<-the_pathcs5as<-the_argscs6returnURL{url_type=ho,url_path=pa,url_params=as}wherefront('/':cs)=return(HostRelative,cs)frontcs=casethe_protcsofJust(pr,cs1)->dolet(ho,cs2)=the_hostcs1(po,cs3)<-the_portcs2cs4<-casecs3of[]->return[]'/':cs5->returncs5_->Nothingreturn(AbsoluteHost{protocol=pr,host=ho,port=po},cs4)_->return(PathRelative,cs)the_prot::String->Maybe(Protocol,String)the_proturlStr=casebreak(':'==)urlStrof(as@(_:_),':':'/':'/':bs)->Just(prot,bs)whereprot=caseasof"https"->HTTPTrue"http"->HTTPFalse"ftps"->FTPTrue"ftp"->FTPFalse_->RawProtas_->Nothingthe_hostcs=spanok_hostcsthe_port(':':cs)=casespanisDigitcsof([],_)->Nothing(xs,ds)->Just(Just(readxs),ds)the_portcs5=return(Nothing,cs5)the_pathcs=dolet(as,bs)=breakend_pathcss<-decStringFalseasreturn(s,bs)whereend_pathc=c=='#'||c=='?'the_args('?':cs)=importParamscsthe_args_=return[]importParams::String->Maybe[(String,String)]importParams[]=return[]importParamsds=mapMa_param(breaks('&'==)ds)wherea_paramcs=dolet(as,bs)=break('='==)csk<-decStringTrueasv<-casebsof""->return""_:xs->decStringTruexsreturn(k,v)-- | Convert the host part of a URL to a list of \"bytes\".exportHost::Host->StringexportHostabsol=the_prot++"://"++hostabsol++the_portwherethe_prot=exportProt(protocolabsol)the_port=maybe""(\x->":"++showx)(portabsol)-- | Convert the host part of a URL to a list of \"bytes\".-- WARNING: We output \"raw\" protocols as they are.exportProt::Protocol->StringexportProtprot=caseprotofHTTPTrue->"https"HTTPFalse->"http"FTPTrue->"ftps"FTPFalse->"ftp"RawProts->s-- | Convert a URL to a list of \"bytes\".-- We represent non-ASCII characters using UTF8.exportURL::URL->StringexportURLurl=absol++the_path++the_paramswhereabsol=caseurl_typeurlofAbsolutehst->exportHosthst++"/"HostRelative->"/"PathRelative->""the_path=encStringFalseok_path(url_pathurl)the_params=caseurl_paramsurlof[]->""xs->"?"++exportParamsxsexportParams::[(String,String)]->StringexportParamsps=concat(intersperse"&"$mapa_paramps)wherea_param(k,mv)=encStringTrueok_paramk++casemvof""->""v->'=':encStringTrueok_paramv-- | Convert a string to bytes by escaping the characters that-- do not satisfy the input predicate. The first argument specifies-- if we should replace spaces with +.encString::Bool->(Char->Bool)->String->StringencStringplpys=foldrenc1[]yswhereenc1' 'xs|pl='+':xsenc1xxs=ifpxthenx:xselseencCharx++xs-- | %-encode a character. Uses UTF8 to represent characters as bytes.encChar::Char->StringencCharc=concatMapencByte(UTF8.encode[c])-- | %-encode a byte.encByte::Word8->StringencByteb='%':caseshowHexb""ofd@[_]->'0':dd->d-- | Decode a list of \"bytes\" to a string.-- Performs % and UTF8 decoding.decString::Bool->String->MaybeStringdecStringbxs=fmapUTF8.decode(decStrBytesbxs)-- Convert a list of \"bytes\" to actual bytes.-- Performs %-decoding. The boolean specifies if we should turn pluses into-- spaces.decStrBytes::Bool->String->Maybe[Word8]decStrBytes_[]=Just[]decStrBytesp('%':cs)=do(n,cs1)<-decBytecsfmap(n:)(decStrBytespcs1)decStrBytesp(c:cs)=letb=ifp&&c=='+'then32-- spaceelsefromIntegral(fromEnumc)in(b:)`fmap`decStrBytespcs-- truncates "large bytes".-- | Parse a percent-encoded byte.decByte::String->Maybe(Word8,String)decByte(x:y:cs)=casereadHex[x,y]of[(n,"")]->Just(n,cs)_->NothingdecByte_=Nothing-- Classification of characters.-- Note that these only return True for ASCII characters; this is important.--------------------------------------------------------------------------------ok_host::Char->Boolok_hostc=isDigitc||isAlphaASCIIc||c=='.'||c=='-'ok_param::Char->Boolok_paramc=ok_hostc||c`elem`"~;:@$_!*'(),"-- | Characters that can appear non % encoded in the path part of the URLok_path::Char->Boolok_pathc=ok_paramc||c`elem`"/=&"-- XXX: others? check RFC-- | Characters that may appear in the textual representation of a URLok_url::Char->Boolok_urlc=isDigitc||isAlphaASCIIc||c`elem`".-;:@$_!*'(),/=&?~%"-- Misc--------------------------------------------------------------------------------isAlphaASCII::Char->BoolisAlphaASCIIx=isAsciix&&isAlphaxbreaks::(a->Bool)->[a]->[[a]]breakspxs=casebreakpxsof(as,[])->[as](as,_:bs)->as:breakspbs