-- | An internal Snap module containing HTTP types.---- /N.B./ this is an internal interface, please don't write user code that-- depends on it. Most of these declarations (except for the-- unsafe/encapsulation-breaking ones) are re-exported from "Snap.Types".{-# LANGUAGE BangPatterns #-}{-# LANGUAGE EmptyDataDecls #-}{-# LANGUAGE ForeignFunctionInterface #-}{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE TypeSynonymInstances #-}moduleSnap.Internal.Http.Typeswhere------------------------------------------------------------------------------importControl.Applicativehiding(empty)importControl.Monad(liftM,when)importqualifiedData.AttoparsecasAttoimportData.Attoparsechiding(many,Result(..))importData.BitsimportData.ByteString(ByteString)importData.ByteString.Internal(c2w,w2c)importqualifiedData.ByteString.Nums.Careless.HexasCvtimportqualifiedData.ByteStringasSimportData.CharimportData.DList(DList)importqualifiedData.DListasDLimportData.IORefimportData.Map(Map)importqualifiedData.MapasMapimportData.MonoidimportData.Serialize.BuilderimportData.Time.ClockimportData.Time.FormatimportData.WordimportForeignhiding(new)importForeign.C.StringimportForeign.C.TypesimportPreludehiding(take)importSystem.Locale(defaultTimeLocale)------------------------------------------------------------------------------importData.CIByteStringimportqualifiedSnap.IterateeasI------------------------------------------------------------------------------foreignimportccallunsafe"set_c_locale"set_c_locale::IO()------------------------------------------------------------------------------foreignimportccallunsafe"c_parse_http_time"c_parse_http_time::CString->IOCTime------------------------------------------------------------------------------foreignimportccallunsafe"c_format_http_time"c_format_http_time::CTime->CString->IO()------------------------------------------------------------------------------typeEnumeratora=I.EnumeratorIOa-------------------------------------------------------------------------------- | A type alias for a case-insensitive key-value mapping.typeHeaders=MapCIByteString[ByteString]-------------------------------------------------------------------------------- | A typeclass for datatypes which contain HTTP headers.classHasHeadersawhere-- | Modify the datatype's headers.updateHeaders::(Headers->Headers)->a->a-- | Retrieve the headers from a datatype that has headers.headers::a->Headers-------------------------------------------------------------------------------- | Adds a header key-value-pair to the 'HasHeaders' datatype. If a header with-- the same name already exists, the new value is appended to the headers list.addHeader::(HasHeadersa)=>CIByteString->ByteString->a->aaddHeaderkv=updateHeaders$Map.insertWith'(++)k[v]-------------------------------------------------------------------------------- | Sets a header key-value-pair in a 'HasHeaders' datatype. If a header with-- the same name already exists, it is overwritten with the new value.setHeader::(HasHeadersa)=>CIByteString->ByteString->a->asetHeaderkv=updateHeaders$Map.insertk[v]-------------------------------------------------------------------------------- | Gets all of the values for a given header.getHeaders::(HasHeadersa)=>CIByteString->a->Maybe[ByteString]getHeaderska=Map.lookupk$headersa-------------------------------------------------------------------------------- | Gets a header value out of a 'HasHeaders' datatype. If many headers came-- in with the same name, they will be catenated together.getHeader::(HasHeadersa)=>CIByteString->a->MaybeByteStringgetHeaderka=liftM(S.intercalate" ")(Map.lookupk$headersa)-------------------------------------------------------------------------------- | Enumerates the HTTP method values (see-- <http://tools.ietf.org/html/rfc2068.html#section-5.1.1>).dataMethod=GET|HEAD|POST|PUT|DELETE|TRACE|OPTIONS|CONNECTderiving(Show,Read,Ord,Eq)------------------------------------------------------------------------------typeHttpVersion=(Int,Int)-------------------------------------------------------------------------------- | A datatype representing an HTTP cookie.dataCookie=Cookie{-- | The name of the cookie.cookieName::!ByteString-- | The cookie's string value.,cookieValue::!ByteString-- | The cookie's expiration value, if it has one.,cookieExpires::!(MaybeUTCTime)-- | The cookie's \"domain\" value, if it has one.,cookieDomain::!(MaybeByteString)-- | The cookie path.,cookiePath::!(MaybeByteString)}deriving(Eq,Show)-------------------------------------------------------------------------------- | A type alias for the HTTP parameters mapping. Each parameter-- key maps to a list of ByteString values; if a parameter is specified-- multiple times (e.g.: \"@GET /foo?param=bar1&param=bar2@\"), looking up-- \"@param@\" in the mapping will give you @[\"bar1\", \"bar2\"]@.typeParams=MapByteString[ByteString]-------------------------------------------------------------------------------- request type------------------------------------------------------------------------------dataSomeEnumerator=SomeEnumerator(foralla.Enumeratora)-------------------------------------------------------------------------------- | Contains all of the information about an incoming HTTP request.dataRequest=Request{-- | The server name of the request, as it came in from the request's-- @Host:@ header.rqServerName::!ByteString-- | Returns the port number the HTTP server is listening on.,rqServerPort::!Int-- | The remote IP address.,rqRemoteAddr::!ByteString-- | The remote TCP port number.,rqRemotePort::!Int-- | The local IP address for this request.,rqLocalAddr::!ByteString-- | Returns the port number the HTTP server is listening on.,rqLocalPort::!Int-- | Returns the HTTP server's idea of its local hostname.,rqLocalHostname::!ByteString-- | Returns @True@ if this is an @HTTPS@ session (currently always-- @False@).,rqIsSecure::!Bool,rqHeaders::Headers,rqBody::IORefSomeEnumerator-- | Returns the @Content-Length@ of the HTTP request body.,rqContentLength::!(MaybeInt)-- | Returns the HTTP request method.,rqMethod::!Method-- | Returns the HTTP version used by the client.,rqVersion::!HttpVersion-- | Returns a list of the cookies that came in from the HTTP request-- headers.,rqCookies::[Cookie]-- | We'll be doing web components (or \"snaplets\") for version 0.2. The-- \"snaplet path\" refers to the place on the URL where your containing-- snaplet is hung. The value of 'rqSnapletPath' is either @\"\"@ (at the-- top-level context) or is a path beginning with a slash, but not ending-- with one.---- An identity is that:---- > rqURI r == 'S.concat' [ rqSnapletPath r-- > , rqContextPath r-- > , rqPathInfo r ]---- note that until we introduce snaplets in v0.2, 'rqSnapletPath' will be-- \"\",rqSnapletPath::!ByteString-- | Handlers can (/will be; --ed/) be hung on a @URI@ \"entry point\";-- this is called the \"context path\". If a handler is hung on the-- context path @\"\/foo\/\"@, and you request @\"\/foo\/bar\"@, the value-- of 'rqPathInfo' will be @\"bar\"@.,rqPathInfo::!ByteString-- | The \"context path\" of the request; catenating 'rqContextPath', and-- 'rqPathInfo' should get you back to the original 'rqURI'. The-- 'rqContextPath' always begins and ends with a slash (@\"\/\"@)-- character, and represents the path (relative to your-- component\/snaplet) you took to get to your handler.,rqContextPath::!ByteString-- | Returns the @URI@ requested by the client.,rqURI::!ByteString-- | Returns the HTTP query string for this 'Request'.,rqQueryString::!ByteString-- | Returns the 'Params' mapping for this 'Request'. \"Parameters\" are-- automatically decoded from the query string and @POST@ body and-- entered into this mapping.,rqParams::Params}------------------------------------------------------------------------------instanceShowRequestwhereshowr=concat["Request <\n",body,">"]wherebody=concat$map((" "++).(++"\n"))[sname,remote,local,beginheaders,hdrs,endheaders,contentlength,method,version,cookies,pathinfo,contextpath,snapletpath,uri,params]sname=concat["server-name: ",toStr$rqServerNamer]remote=concat["remote: ",toStr$rqRemoteAddrr,":",show(rqRemotePortr)]local=concat["local: ",toStr$rqLocalAddrr,":",show$rqServerPortr]beginheaders="Headers:\n ========================================"endheaders=" ========================================"hdrs=" "++show(rqHeadersr)contentlength=concat["content-length: ",show$rqContentLengthr]method=concat["method: ",show$rqMethodr]version=concat["version: ",show$rqVersionr]cookies=concat["cookies:\n"," ========================================\n"," "++(show$rqCookiesr),"\n ========================================"]pathinfo=concat["pathinfo: ",toStr$rqPathInfor]contextpath=concat["contextpath: ",toStr$rqContextPathr]snapletpath=concat["snapletpath: ",toStr$rqSnapletPathr]uri=concat["URI: ",toStr$rqURIr]params=concat["params:\n"," ========================================\n"," "++(show$rqParamsr),"\n ========================================"]------------------------------------------------------------------------------instanceHasHeadersRequestwhereheaders=rqHeadersupdateHeadersfr=r{rqHeaders=f(rqHeadersr)}------------------------------------------------------------------------------instanceHasHeadersHeaderswhereheaders=idupdateHeaders=id-------------------------------------------------------------------------------- response type------------------------------------------------------------------------------dataResponseBody=Enum(foralla.Enumeratora)-- ^ output body is enumerator|SendFileFilePath-- ^ output body is sendfile()------------------------------------------------------------------------------rspBodyMap::(foralla.Enumeratora->Enumeratora)->ResponseBody->ResponseBodyrspBodyMapfb=Enum$f$rspBodyToEnumb------------------------------------------------------------------------------rspBodyToEnum::ResponseBody->EnumeratorarspBodyToEnum(Enume)=erspBodyToEnum(SendFilefp)=I.enumFilefp-------------------------------------------------------------------------------- | Represents an HTTP response.dataResponse=Response{rspHeaders::Headers,rspHttpVersion::!HttpVersion-- | We will need to inspect the content length no matter what, and-- looking up \"content-length\" in the headers and parsing the number-- out of the text will be too expensive.,rspContentLength::!(MaybeInt),rspBody::ResponseBody-- | Returns the HTTP status code.,rspStatus::!Int-- | Returns the HTTP status explanation string.,rspStatusReason::!ByteString}------------------------------------------------------------------------------instanceShowResponsewhereshowr=concat["Response <\n",body,">"]wherebody=concat$map((" "++).(++"\n"))[hdrs,version,status,reason]hdrs=concat["headers:\n"," ==============================\n ",show$rspHeadersr,"\n =============================="]version=concat["version: ",show$rspHttpVersionr]status=concat["status: ",show$rspStatusr]reason=concat["reason: ",toStr$rspStatusReasonr]------------------------------------------------------------------------------instanceHasHeadersResponsewhereheaders=rspHeadersupdateHeadersfr=r{rspHeaders=f(rspHeadersr)}-------------------------------------------------------------------------------- | Looks up the value(s) for the given named parameter. Parameters initially-- come from the request's query string and any decoded POST body (if the-- request's @Content-Type@ is @application\/x-www-form-urlencoded@). Parameter-- values can be modified within handlers using "rqModifyParams".rqParam::ByteString-- ^ parameter name to look up->Request-- ^ HTTP request->Maybe[ByteString]rqParamkrq=Map.lookupk$rqParamsrq{-# INLINE rqParam #-}-------------------------------------------------------------------------------- | Modifies the parameters mapping (which is a @Map ByteString ByteString@) in-- a 'Request' using the given function.rqModifyParams::(Params->Params)->Request->RequestrqModifyParamsfr=r{rqParams=p}wherep=f$rqParamsr{-# INLINE rqModifyParams #-}-------------------------------------------------------------------------------- | Writes a key-value pair to the parameters mapping within the given request.rqSetParam::ByteString-- ^ parameter name->[ByteString]-- ^ parameter values->Request-- ^ request->RequestrqSetParamkv=rqModifyParams$Map.insertkv{-# INLINE rqSetParam #-}-------------------------------------------------------------------------------- responses-------------------------------------------------------------------------------- | An empty 'Response'.emptyResponse::ResponseemptyResponse=ResponseMap.empty(1,1)Nothing(Enumreturn)200"OK"-------------------------------------------------------------------------------- | Sets an HTTP response body to the given 'Enumerator' value.setResponseBody::(foralla.Enumeratora)-- ^ new response body-- enumerator->Response-- ^ response to modify->ResponsesetResponseBodyer=r{rspBody=Enume}{-# INLINE setResponseBody #-}-------------------------------------------------------------------------------- | Sets the HTTP response status.setResponseStatus::Int-- ^ HTTP response integer code->ByteString-- ^ HTTP response explanation->Response-- ^ Response to be modified->ResponsesetResponseStatussreasonr=r{rspStatus=s,rspStatusReason=reason}{-# INLINE setResponseStatus #-}-------------------------------------------------------------------------------- | Modifies a response body.modifyResponseBody::(foralla.Enumeratora->Enumeratora)->Response->ResponsemodifyResponseBodyfr=r{rspBody=rspBodyMapf(rspBodyr)}{-# INLINE modifyResponseBody #-}-------------------------------------------------------------------------------- | Sets the @Content-Type@ in the 'Response' headers.setContentType::ByteString->Response->ResponsesetContentType=setHeader"Content-Type"{-# INLINE setContentType #-}-------------------------------------------------------------------------------- | Adds an HTTP 'Cookie' to the 'Response' headers.addCookie::Cookie-- ^ cookie value->Response-- ^ response to modify->ResponseaddCookie(CookiekvmbExpTimembDomainmbPath)=updateHeadersfwheref=Map.insertWith'(++)"Set-Cookie"[cookie]cookie=S.concat[k,"=",v,path,exptime,domain]path=maybe""(S.append"; path=")mbPathdomain=maybe""(S.append"; domain=")mbDomainexptime=maybe""(S.append"; expires=".fmt)mbExpTimefmt=fromStr.formatTimedefaultTimeLocale"%a, %d-%b-%Y %H:%M:%S GMT"-------------------------------------------------------------------------------- | A note here: if you want to set the @Content-Length@ for the response,-- Snap forces you to do it with this function rather than by setting it in the-- headers; the @Content-Length@ in the headers will be ignored.---- The reason for this is that Snap needs to look up the value of-- @Content-Length@ for each request, and looking the string value up in the-- headers and parsing the number out of the text will be too expensive.---- If you don't set a content length in your response, HTTP keep-alive will be-- disabled for HTTP\/1.0 clients, forcing a @Connection: close@. For HTTP\/1.1-- clients, Snap will switch to the chunked transfer encoding if-- @Content-Length@ is not specified.setContentLength::Int->Response->ResponsesetContentLengthlr=r{rspContentLength=Justl}{-# INLINE setContentLength #-}-------------------------------------------------------------------------------- | Removes any @Content-Length@ set in the 'Response'.clearContentLength::Response->ResponseclearContentLengthr=r{rspContentLength=Nothing}{-# INLINE clearContentLength #-}-------------------------------------------------------------------------------- HTTP dates{-
-- | Converts a 'ClockTime' into an HTTP timestamp.
formatHttpTime :: UTCTime -> ByteString
formatHttpTime = fromStr . formatTime defaultTimeLocale "%a, %d %b %Y %X GMT"
-- | Converts an HTTP timestamp into a 'UTCTime'.
parseHttpTime :: ByteString -> Maybe UTCTime
parseHttpTime s' =
parseTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" s
where
s = toStr s'
-}-- | Converts a 'CTime' into an HTTP timestamp.formatHttpTime::CTime->IOByteStringformatHttpTimet=allocaBytes40$\ptr->doc_format_http_timetptrS.packCStringptr-------------------------------------------------------------------------------- | Converts an HTTP timestamp into a 'CTime'.parseHttpTime::ByteString->IOCTimeparseHttpTimes=S.useAsCStrings$\ptr->c_parse_http_timeptr-------------------------------------------------------------------------------- URL ENCODING------------------------------------------------------------------------------parseToCompletion::Parsera->ByteString->MaybeaparseToCompletionps=toResult$finishrwherer=parsepstoResult(Atto.Done_c)=JustctoResult_=Nothing------------------------------------------------------------------------------pUrlEscaped::ParserByteStringpUrlEscaped=dosq<-nextChunkDL.emptyreturn$S.concat$DL.toListsqwherenextChunk::DListByteString->Parser(DListByteString)nextChunks=(endOfInput*>pures)<|>doc<-anyWord8casew2ccof'+'->plusSpaces'%'->percentEncodeds_->unEncodedcspercentEncoded::DListByteString->Parser(DListByteString)percentEncodedl=dohx<-take2when(S.lengthhx/=2||(not$S.all(isHexDigit.w2c)hx))$fail"bad hex in url"letcode=(Cvt.hexhx)::Word8nextChunk$DL.snocl(S.singletoncode)unEncoded::Word8->DListByteString->Parser(DListByteString)unEncodedcl'=doletl=DL.snocl'(S.singletonc)bs<-takeTill(flipelem(mapc2w"%+"))ifS.nullbsthennextChunklelsenextChunk$DL.snoclbsplusSpace::DListByteString->Parser(DListByteString)plusSpacel=nextChunk(DL.snocl(S.singleton$c2w' '))-------------------------------------------------------------------------------- | Decodes an URL-escaped string (see-- <http://tools.ietf.org/html/rfc2396.html#section-2.4>)urlDecode::ByteString->MaybeByteStringurlDecode=parseToCompletionpUrlEscaped-------------------------------------------------------------------------------- "...Only alphanumerics [0-9a-zA-Z], the special characters "$-_.+!*'(),"-- [not including the quotes - ed], and reserved characters used for their-- reserved purposes may be used unencoded within a URL."-- | URL-escapes a string (see-- <http://tools.ietf.org/html/rfc2396.html#section-2.4>)urlEncode::ByteString->ByteStringurlEncode=toByteString.S.foldl'femptywherefbc=ifc==c2w' 'thenb`mappend`singleton(c2w'+')elseifisKoshercthenb`mappend`singletoncelseb`mappend`hexdcisKosherw=any($c)[isAlphaNum,flipelem['$','-','.','!','*','\'','(',')',',']]wherec=w2cw------------------------------------------------------------------------------hexd::Word8->Builderhexdc=singleton(c2w'%')`mappend`singletonhi`mappend`singletonlowwhered=c2w.intToDigitlow=d$fromEnum$c.&.0xfhi=d$fromEnum$(c.&.0xf0)`shift`(-4)------------------------------------------------------------------------------finish::Atto.Resulta->Atto.Resultafinish(Atto.Partialf)=flipfeed""$f""finishx=x-------------------------------------------------------------------------------- local definitionsfromStr::String->ByteStringfromStr=S.pack.mapc2w{-# INLINE fromStr #-}-------------------------------------------------------------------------------- private helper functionstoStr::ByteString->StringtoStr=mapw2c.S.unpack