moduleHack.Frontend.HappstackwhereimportHappstack.ServerimportHappstack.Server.HTTP.Types(Request(..),Version(Version))importqualifiedData.ByteString.UTF8asUBSimportqualifiedHappstack.ServerasHimportHappstack.Server.SURI(parse)importqualifiedHackasHackimportqualifiedHackimportHack(http,pathInfo,scriptName,queryString,hackInput,serverName,serverPort,Application)importData.MaybeimportData.Foldable(toList)-- | Converts a Happstack ServerPartT to a CGI handling function.serverPartToApp::(ToMessageb)=>ServerPartTIOb->ApplicationserverPartToApp=convert.processRequestconvert::(Request->IOResponse)->Applicationconvertf=\env->doletrq=toHappstackRequestenvrs<-frqletr=toHackResponsersreturnrtoHackResponse::Response->Hack.ResponsetoHackResponser=Hack.Response{Hack.body=rsBodyr,Hack.status=rsCoder,Hack.headers=mapconvertHeader$toList(rsHeadersr)}-- | Sets all the headers coming from HappstackconvertHeader::HeaderPair->(String,String)convertHeader(HeaderPairkv)=(UBS.toStringk,UBS.toString(lastv))-- | Converts one request into anothertoHappstackRequest::Hack.Env->RequesttoHappstackRequestenv=tmpRequest{rqInputs=queryInputuri++bodyInputtmpRequest}whereuri=fromJust$parse$concat$map(\f->fenv)[serverName,show.serverPort,scriptName,pathInfo,add_q.queryString]tmpRequest=Request{rqMethod=convertRequestMethod$Hack.requestMethodenv,rqPaths=split'/'$pathInfoenv,rqUri=scriptNameenv++pathInfoenv,rqQuery=add_q$queryStringenv,rqInputs=[],rqCookies=readCookies$httpenv,rqVersion=Version11,rqHeaders=mkHeaders$httpenv,rqBody=Body$hackInputenv,rqPeer=(serverNameenv,serverPortenv)}convertRequestMethodHack.OPTIONS=OPTIONSconvertRequestMethodHack.GET=GETconvertRequestMethodHack.HEAD=HEADconvertRequestMethodHack.POST=POSTconvertRequestMethodHack.PUT=PUTconvertRequestMethodHack.DELETE=DELETEconvertRequestMethodHack.TRACE=TRACEconvertRequestMethodHack.CONNECT=CONNECTreadCookies=mapcookieWithName.either(const[])id.parseCookies.fromMaybe"".lookup"Cookie"add_q[]=[]add_qx='?':xcookieWithName::H.Cookie->(String,H.Cookie)cookieWithNamex=(H.cookieNamex,x)-- | 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"-- | 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[]cs'workeracc(c':cs')=worker(c':acc)cs'