{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-}moduleHappstack.Server.HTTP.Types(Request(..),Response(..),RqBody(..),Input(..),HeaderPair(..),rqURL,mkHeaders,getHeader,getHeaderBS,getHeaderUnsafe,hasHeader,hasHeaderBS,hasHeaderUnsafe,setHeader,setHeaderBS,setHeaderUnsafe,addHeader,addHeaderBS,addHeaderUnsafe,setRsCode,-- setCookie, setCookies,Conf(..),nullConf,result,resultBS,redirect,-- redirect_, redirect', redirect'_,RsFlags(..),nullRsFlags,noContentLength,Version(..),Method(..),Headers,continueHTTP,Host,ContentType(..))whereimportqualifiedData.MapasMimportData.Typeable(Typeable)importData.MaybeimportqualifiedData.ByteString.Char8asPimportData.ByteString.Char8(ByteString,pack)importqualifiedData.ByteString.Lazy.Char8asLimportHappstack.Server.SURIimportData.Char(toLower)importHappstack.Server.HTTP.Multipart(ContentType(..))importHappstack.Server.CookieimportData.ListimportText.Show.Functions()-- | HTTP versiondataVersion=VersionIntIntderiving(Read,Eq)instanceShowVersionwhereshow(Versionxy)=(showx)++"."++(showy)isHTTP1_1::Request->BoolisHTTP1_1rq=caserqVersionrqofVersion11->True;_->FalseisHTTP1_0::Request->BoolisHTTP1_0rq=caserqVersionrqofVersion10->True;_->False-- | Should the connection be used for further messages after this.-- | isHTTP1_0 && hasKeepAlive || isHTTP1_1 && hasNotConnectionClosecontinueHTTP::Request->Response->Bool--continueHTTP rq res = isHTTP1_1 rq && getHeader' connectionC rq /= Just closeC && rsfContentLength (rsFlags res)continueHTTPrqres=(isHTTP1_0rq&&checkHeaderBSconnectionCkeepaliveCrq)||(isHTTP1_1rq&&not(checkHeaderBSconnectionCcloseCrq))&&rsfContentLength(rsFlagsres)-- | HTTP configurationdataConf=Conf{port::Int-- ^ Port for the server to listen on.,validator::Maybe(Response->IOResponse)}-- | Default configuration contains no validator and the port is set to 8000nullConf::ConfnullConf=Conf{port=8000,validator=Nothing}-- | HTTP request methoddataMethod=GET|HEAD|POST|PUT|DELETE|TRACE|OPTIONS|CONNECTderiving(Show,Read,Eq)dataHeaderPair=HeaderPair{hName::ByteString,hValue::[ByteString]}deriving(Read,Show)-- | Combined headers.typeHeaders=M.MapByteStringHeaderPair-- lowercased name -> (realname, value)-- | Result flagsdataRsFlags=RsFlags{rsfContentLength::Bool-- ^ whether a content-length header will be added to the result.}deriving(Show,Read,Typeable)-- | Default RsFlags that will include the content-length headernullRsFlags::RsFlagsnullRsFlags=RsFlags{rsfContentLength=True}-- | Don't display a Content-Lenght field for the 'Result'.noContentLength::Response->ResponsenoContentLengthres=res{rsFlags=upd}whereupd=(rsFlagsres){rsfContentLength=False}dataInput=Input{inputValue::L.ByteString,inputFilename::MaybeString,inputContentType::ContentType}deriving(Show,Read,Typeable)typeHost=(String,Int)dataResponse=Response{rsCode::Int,rsHeaders::Headers,rsFlags::RsFlags,rsBody::L.ByteString,rsValidator::Maybe(Response->IOResponse)}|SendFile{rsCode::Int,rsHeaders::Headers,rsFlags::RsFlags,rsValidator::Maybe(Response->IOResponse),sfFilePath::FilePath,-- file handle to send fromsfOffset::Integer,-- offset to start atsfCount::Integer-- number of bytes to send}deriving(Show,Typeable)dataRequest=Request{rqMethod::Method,rqPaths::[String],rqUri::String,rqQuery::String,rqInputs::[(String,Input)],rqCookies::[(String,Cookie)],rqVersion::Version,rqHeaders::Headers,rqBody::RqBody,rqPeer::Host}deriving(Show,Read,Typeable)-- | Converts a Request into a String representing the corresponding URLrqURL::Request->StringrqURLrq='/':intercalate"/"(rqPathsrq)++(rqQueryrq)classHasHeadersawhereupdateHeaders::(Headers->Headers)->a->aheaders::a->HeadersinstanceHasHeadersResponsewhereupdateHeadersfrs=rs{rsHeaders=f$rsHeadersrs}headers=rsHeadersinstanceHasHeadersRequestwhereupdateHeadersfrq=rq{rqHeaders=f$rqHeadersrq}headers=rqHeadersinstanceHasHeadersHeaderswhereupdateHeadersf=fheaders=idnewtypeRqBody=BodyL.ByteStringderiving(Read,Show,Typeable)-- | Sets the Response status code to the provided Int and lifts the computation-- into a Monad.setRsCode::(Monadm)=>Int->Response->mResponsesetRsCodecoders=returnrs{rsCode=code}-- | Takes a list of (key,val) pairs and converts it into Headers. The-- keys will be converted to lowercasemkHeaders::[(String,String)]->HeadersmkHeadershdrs=M.fromListWithjoin[(P.pack(maptoLowerkey),HeaderPair(P.packkey)[P.packvalue])|(key,value)<-hdrs]wherejoin(HeaderPairkeyvs1)(HeaderPair_vs2)=HeaderPairkey(vs1++vs2)---------------------------------------------------------------- Retrieving header information---------------------------------------------------------------- | Lookup header value. Key is case-insensitive.getHeader::HasHeadersr=>String->r->MaybeByteStringgetHeader=getHeaderBS.pack-- | Lookup header value. Key is a case-insensitive bytestring.getHeaderBS::HasHeadersr=>ByteString->r->MaybeByteStringgetHeaderBS=getHeaderUnsafe.P.maptoLower-- | Lookup header value with a case-sensitive key. The key must be lowercase.getHeaderUnsafe::HasHeadersr=>ByteString->r->MaybeByteStringgetHeaderUnsafekeyvar=listToMaybe=<<fmaphValue(getHeaderUnsafe'keyvar)-- | Lookup header with a case-sensitive key. The key must be lowercase.getHeaderUnsafe'::HasHeadersr=>ByteString->r->MaybeHeaderPairgetHeaderUnsafe'key=M.lookupkey.headers---------------------------------------------------------------- Querying header status---------------------------------------------------------------- | Returns True if the associated key is found in the Headers. The lookup-- is case insensitive.hasHeader::HasHeadersr=>String->r->BoolhasHeaderkeyr=isJust(getHeaderkeyr)-- | Acts as 'hasHeader' with ByteStringshasHeaderBS::HasHeadersr=>ByteString->r->BoolhasHeaderBSkeyr=isJust(getHeaderBSkeyr)-- | Acts as 'hasHeaderBS' but the key is case sensitive. It should be-- in lowercase.hasHeaderUnsafe::HasHeadersr=>ByteString->r->BoolhasHeaderUnsafekeyr=isJust(getHeaderUnsafe'keyr)checkHeaderBS::HasHeadersr=>ByteString->ByteString->r->BoolcheckHeaderBSkeyval=checkHeaderUnsafe(P.maptoLowerkey)(P.maptoLowerval)checkHeaderUnsafe::HasHeadersr=>ByteString->ByteString->r->BoolcheckHeaderUnsafekeyvalr=casegetHeaderUnsafekeyrofJustval'|P.maptoLowerval'==val->True_->False---------------------------------------------------------------- Setting header status---------------------------------------------------------------- | Associates the key/value pair in the headers. Forces the key to be-- lowercase.setHeader::HasHeadersr=>String->String->r->rsetHeaderkeyval=setHeaderBS(packkey)(packval)-- | Acts as 'setHeader' but with ByteStrings.setHeaderBS::HasHeadersr=>ByteString->ByteString->r->rsetHeaderBSkeyval=setHeaderUnsafe(P.maptoLowerkey)(HeaderPairkey[val])-- | Sets the key to the HeaderPair. This is the only way to associate a key-- with multiple values via the setHeader* functions. Does not force the key-- to be in lowercase or guarantee that the given key and the key in the HeaderPair will match. setHeaderUnsafe::HasHeadersr=>ByteString->HeaderPair->r->rsetHeaderUnsafekeyval=updateHeaders(M.insertkeyval)---------------------------------------------------------------- Adding headers---------------------------------------------------------------- | Add a key/value pair to the header. If the key already has a value-- associated with it, then the value will be appended. -- Forces the key to be lowercase.addHeader::HasHeadersr=>String->String->r->raddHeaderkeyval=addHeaderBS(packkey)(packval)-- | Acts as addHeader except for ByteStringsaddHeaderBS::HasHeadersr=>ByteString->ByteString->r->raddHeaderBSkeyval=addHeaderUnsafe(P.maptoLowerkey)(HeaderPairkey[val])-- | Add a key/value pair to the header using the underlying HeaderPair data-- type. Does not force the key to be in lowercase or guarantee that the given key and the key in the HeaderPair will match. addHeaderUnsafe::HasHeadersr=>ByteString->HeaderPair->r->raddHeaderUnsafekeyval=updateHeaders(M.insertWithjoinkeyval)wherejoin(HeaderPairkvs1)(HeaderPair_vs2)=HeaderPairk(vs1++vs2)-- | Creates a Response with the given Int as the status code and the provided-- String as the body of the Response result::Int->String->Responseresultcode=resultBScode.L.pack-- | Acts as 'result' but works with ByteStrings directly.resultBS::Int->L.ByteString->ResponseresultBScodes=ResponsecodeM.emptynullRsFlagssNothing-- | Sets the Response's status code to the given Int and redirects to the given URIredirect::(ToSURIs)=>Int->s->Response->Responseredirectcsresp=setHeaderBSlocationC(pack(render(toSURIs)))resp{rsCode=c}-- constants herelocationC::ByteStringlocationC=P.pack"Location"closeC::ByteStringcloseC=P.pack"close"connectionC::ByteStringconnectionC=P.pack"Connection"keepaliveC::ByteStringkeepaliveC=P.pack"Keep-Alive"