{- |
Running Happstack applications using FastCGI
You need to keep a couple things in mind when configuring a FastCGI Happstack application, especially when using Happstack-state.
There are several ways to let Apache + FastCGI handle your application.
[Dynamic] This is the easy way. You don't have to configure your server, but can just execute the scripts. FastCGI will spawn instances of your application if needed and kill them if they're not needed anymore. /This might break working with Happstack-state!/
[Static] You explicitly need to configure your script in your host config. By default it will only start one process, on server startup. If you want to work with Happstack-state, this is the preferable way, although we have not exhaustively tested that it won't break.
| -}moduleHappstack.Server.FastCGI(moduleNetwork.FastCGI,serverPartToCGI)whereimportControl.ApplicativeimportData.Char(toLower)importData.List(isPrefixOf)importHappstack.ServerimportHappstack.Server.HTTP.Types(Request(..),Version(Version))importNetwork.CGI.Monad(CGIRequest,cgiVars,cgiRequestBody,cgiGet)importNetwork.CGI.Protocol(maybeRead)importNetwork.FastCGIimportqualifiedData.ByteString.LazyasBSimportqualifiedData.ByteString.UTF8asUBSimportqualifiedData.MapasMimportqualifiedHappstack.ServerasHimportqualifiedNetwork.CGIasCGI-- | Converts a Happstack ServerPartT to a CGI handling function.serverPartToCGI::(ToMessageb)=>ServerPartTIOb->CGICGIResultserverPartToCGI=convert.processRequestconvert::(Request->IOResponse)->CGICGIResultconvertf=cgiGetid>>=toHappstackRequest>>=liftIO.f>>=toCGIResponse-- Converts the Happstack response into a CGIResult, setting the statuscode, headers and body.toCGIResponse::Response->CGICGIResulttoCGIResponser=dor'<-liftIO(runValidatorreturnr)letc=rsCoder'CGI.setStatusc(responseMessagec)mapM_setHappstackHeader(M.elems$rsHeadersr')outputFPS(rsBodyr')-- | Sets all the headers coming from HappstacksetHappstackHeader::HeaderPair->CGI()setHappstackHeader(HeaderPairkv)=mapM_(CGI.setHeader(UBS.toStringk).UBS.toString)v-- | Converts one request into anothertoHappstackRequest::CGIRequest->CGIRequesttoHappstackRequestrq=doi<-cgiInputsreturn$Request{rqMethod=cgiMethodrq,rqPaths=cgiPathsrq,rqUri=cgiUrirq,rqQuery=cgiQueryrq,rqInputs=i,rqCookies=cgiCookiesrq,rqVersion=cgiVersionrq,rqHeaders=cgiHeadersrq,rqBody=cgiBodyrq,rqPeer=cgiPeerrq}-- | Lookup a variable in the cgiVars(?)::CGIRequest->String->MaybeStringr?k=M.lookupk$cgiVarsr-- | Like fromJust, but with a default value in case of Nothing.withDefx=maybexid-- | Look up a String in the cgiVars, returning the empty string if the key is not presentstrkv=withDef""(v?k)cgiUri::CGIRequest->StringcgiUri=str"REQUEST_URI"cgiMethod::CGIRequest->MethodcgiMethodx=withDefGET$(x?"HTTP_METHOD")>>=maybeReadcgiPaths::CGIRequest->[String]cgiPaths=split'/'.str"SCRIPT_NAME"cgiQuery::CGIRequest->StringcgiQueryx='?':(str"QUERY_STRING"x)cgiInputs::CGI[(String,Input)]cgiInputs=getInputNames>>=mapMtoHappstackInputcgiCookies::CGIRequest->[(String,H.Cookie)]cgiCookies=mapcookieWithName.either(const[])id.parseCookies.str"HTTP_COOKIE"cgiVersion::CGIRequest->VersioncgiVersion=parseProtocol.str"SERVER_PROTOCOL"cgiHeaders::CGIRequest->HeaderscgiHeaders=mkHeaders.mapKeys(replace'_''-'.drop(lengthhttpPrefix)).filterKey(isPrefixOfhttpPrefix).M.toList.cgiVarscgiBody::CGIRequest->RqBodycgiBody=Body.cgiRequestBodycgiPeer::CGIRequest->(String,Int)cgiPeerr=(str"REMOTE_ADDR"r,withDef0(r?"REMOTE_PORT">>=maybeRead))-- TODO-- | Replace x by y in a mapreplace::(Eqa)=>a->a->[a]->[a]replacexy=map(\v->ifv==xthenyelsev)httpPrefix="HTTP_"toHeaderPair::String->String->HeaderPairtoHeaderPairkv=HeaderPair(UBS.fromStringk)[UBS.fromStringv]cookieWithName::H.Cookie->(String,H.Cookie)cookieWithNamex=(H.cookieNamex,x)mapKeysf=map(\(k,v)->(fk,v))filterKeyf=filter(f.fst)-- | Parse the HTTP protocolparseProtocol::String->VersionparseProtocol"HTTP/0.9"=Version09parseProtocol"HTTP/1.0"=Version10parseProtocol"HTTP/1.1"=Version11parseProtocol_=error"Invalid HTTP Version"-- | Gives an input key/value given an input keytoHappstackInput::String->CGI(String,Input)toHappstackInputk=dofilename<-getInputFilenamekvalue<-withDef(BS.empty)<$>getInputFPSkcontentType<-withDef""<$>getInputContentTypekreturn(k,Input{inputValue=value,inputFilename=filename,inputContentType=convertContentType$parseContentTypecontentType})-- | Converts one Content type into the otherconvertContentType::MaybeCGI.ContentType->H.ContentTypeconvertContentType(Just(CGI.ContentTypexyz))=H.ContentTypexyzconvertContentTypeNothing=error"No correct content-type"-- | Transforms a ServerPartT into a function. This is a copy of simpleHTTP'processRequest::(ToMessageb,Monadm,Functorm)=>ServerPartTmb->Request->mResponseprocessRequesthsreq=(runWebT$runServerPartThsreq)>>=(return.(maybestandardNotFoundid))wherestandardNotFound=H.setHeader"Content-Type""text/html"$toResponse"Not found"---------------------------------------------------- Copied straight from Lemmih's old happs-fastcgi--------------------------------------------------responseMessage::Int->[Char]responseMessage100="100 Continue"responseMessage101="101 Switching Protocols"responseMessage200="200 OK"responseMessage201="201 Created"responseMessage202="202 Accepted"responseMessage203="203 Non-Authoritative Information"responseMessage204="204 No Content"responseMessage205="205 Reset Content"responseMessage206="206 Partial Content"responseMessage300="300 Multiple Choices"responseMessage301="301 Moved Permanently"responseMessage302="302 Found"responseMessage303="303 See Other"responseMessage304="304 Not Modified"responseMessage305="305 Use Proxy"responseMessage307="307 Temporary Redirect"responseMessage400="400 Bad Request"responseMessage401="401 Unauthorized"responseMessage402="402 Payment Required"responseMessage403="403 Forbidden"responseMessage404="404 Not Found"responseMessage405="405 Method Not Allowed"responseMessage406="406 Not Acceptable"responseMessage407="407 Proxy Authentication Required"responseMessage408="408 Request Time-out"responseMessage409="409 Conflict"responseMessage410="410 Gone"responseMessage411="411 Length Required"responseMessage412="412 Precondition Failed"responseMessage413="413 Request Entity Too Large"responseMessage414="414 Request-URI Too Large"responseMessage415="415 Unsupported Media Type"responseMessage416="416 Requested range not satisfiable"responseMessage417="417 Expectation Failed"responseMessage500="500 Internal Server Error"responseMessage501="501 Not Implemented"responseMessage502="502 Bad Gateway"responseMessage503="503 Service Unavailable"responseMessage504="504 Gateway Time-out"responseMessage505="505 HTTP Version not supported"responseMessagex=(showx++"\r\n")-- | Splits a list by character, the resulting lists don't have the character in them.split::Char->String->[String]splitccs=filter(not.null)$worker[]cswhereworkeracc[]=[reverseacc]workeracc(c':cs)|c==c'=reverseacc:worker[]csworkeracc(c':cs)=worker(c':acc)cs