{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE PatternGuards #-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE RecordWildCards #-}{-# LANGUAGE TemplateHaskell #-}{-# LANGUAGE FlexibleContexts #-}moduleYesod.Core.Internal.RunwhereimportYesod.Core.Internal.ResponseimportBlaze.ByteString.Builder(toByteString)importControl.Applicative((<$>))importControl.Exception(fromException)importControl.Exception.Lifted(catch)importControl.Monad.IO.Class(MonadIO)importControl.Monad.IO.Class(liftIO)importControl.Monad.Logger(LogLevel(LevelError),LogSource,liftLoc)importControl.Monad.Trans.Resource(runResourceT,withInternalState,runInternalState)importqualifiedData.ByteStringasSimportqualifiedData.ByteString.Char8asS8importqualifiedData.IORefasIimportqualifiedData.MapasMapimportData.Maybe(isJust)importData.Maybe(fromMaybe)importData.Monoid(appEndo,mempty)importData.Text(Text)importqualifiedData.TextasTimportData.Text.Encoding(encodeUtf8)importData.Text.Encoding(decodeUtf8With)importData.Text.Encoding.Error(lenientDecode)importLanguage.Haskell.TH.Syntax(Loc,qLocation)importqualifiedNetwork.HTTP.TypesasHimportNetwork.WaiimportPreludehiding(catch)importSystem.Log.FastLogger(Logger)importSystem.Log.FastLogger(LogStr,toLogStr)importSystem.Random(newStdGen)importYesod.Core.ContentimportYesod.Core.Class.YesodimportYesod.Core.TypesimportYesod.Core.Internal.Request(parseWaiRequest,tooLargeResponse)importYesod.Routes.Class(Route,renderRoute)-- | Function used internally by Yesod in the process of converting a-- 'HandlerT' into an 'Application'. Should not be needed by users.runHandler::ToTypedContentc=>RunHandlerEnvsite->HandlerTsiteIOc->YesodApprunHandlerrhe@RunHandlerEnv{..}handleryreq=withInternalState$\resState->dolettoErrorHandlere=casefromExceptioneofJust(HCErrorx)->x_->InternalError$T.pack$showeistate<-liftIO$I.newIORefGHState{ghsSession=reqSessionyreq,ghsRBC=Nothing,ghsIdent=1,ghsCache=mempty,ghsHeaders=mempty}lethd=HandlerData{handlerRequest=yreq,handlerEnv=rhe,handlerState=istate,handlerToParent=const(),handlerResource=resState}contents'<-catch(fmapRight$unHandlerThandlerhd)(\e->return$Left$maybe(HCError$toErrorHandlere)id$fromExceptione)state<-liftIO$I.readIORefistateletfinalSession=ghsSessionstateletheaders=ghsHeadersstateletcontents=eitherid(HCContentH.status200.toTypedContent)contents'lethandleErrore=fliprunInternalStateresState$doyar<-rheOnErroreyreq{reqSession=finalSession}caseyarofYRPlain_hsctcsess->leths'=appEndoheadershsinreturn$YRPlain(getStatuse)hs'ctcsessYRWai_->returnyarletsendFile'ctfpp=return$YRPlainH.status200(appEndoheaders[])ct(ContentFilefpp)finalSessioncasecontentsofHCContentstatus(TypedContentctc)->doec'<-liftIO$evaluateContentccaseec'ofLefte->handleErroreRightc'->return$YRPlainstatus(appEndoheaders[])ctc'finalSessionHCErrore->handleErroreHCRedirectstatusloc->doletdisable_cachingx=Header"Cache-Control""no-cache, must-revalidate":Header"Expires""Thu, 01 Jan 1970 05:05:05 GMT":xhs=(ifstatus/=H.movedPermanently301thendisable_cachingelseid)$Header"Location"(encodeUtf8loc):appEndoheaders[]return$YRPlainstatushstypePlainemptyContentfinalSessionHCSendFilectfpp->catch(sendFile'ctfpp)(handleError.toErrorHandler)HCCreatedloc->doleths=Header"Location"(encodeUtf8loc):appEndoheaders[]return$YRPlainH.status201hstypePlainemptyContentfinalSessionHCWair->return$YRWairsafeEh::(Loc->LogSource->LogLevel->LogStr->IO())->ErrorResponse->YesodAppsafeEhlog'erreq=doliftIO$log'$(qLocation>>=liftLoc)"yesod-core"LevelError$toLogStr$"Error handler errored out: "++showerreturn$YRPlainH.status500[]typePlain(toContent("Internal Server Error"::S.ByteString))(reqSessionreq)-- | Run a 'HandlerT' completely outside of Yesod. This-- function comes with many caveats and you shouldn't use it-- unless you fully understand what it's doing and how it works.---- As of now, there's only one reason to use this function at-- all: in order to run unit tests of functions inside 'HandlerT'-- but that aren't easily testable with a full HTTP request.-- Even so, it's better to use @wai-test@ or @yesod-test@ instead-- of using this function.---- This function will create a fake HTTP request (both @wai@'s-- 'Request' and @yesod@'s 'Request') and feed it to the-- @HandlerT@. The only useful information the @HandlerT@ may-- get from the request is the session map, which you must supply-- as argument to @runFakeHandler@. All other fields contain-- fake information, which means that they can be accessed but-- won't have any useful information. The response of the-- @HandlerT@ is completely ignored, including changes to the-- session, cookies or headers. We only return you the-- @HandlerT@'s return value.runFakeHandler::(Yesodsite,MonadIOm)=>SessionMap->(site->Logger)->site->HandlerTsiteIOa->m(EitherErrorResponsea)runFakeHandlerfakeSessionMaploggersitehandler=liftIO$doret<-I.newIORef(Left$InternalError"runFakeHandler: no result")lethandler'=doliftIO.I.writeIORefret.Right=<<handlerreturn()letyapp=runHandlerRunHandlerEnv{rheRender=yesodRendersite$resolveApprootsitefakeWaiRequest,rheRoute=Nothing,rheSite=site,rheUpload=fileUploadsite,rheLog=messageLoggerSourcesite$loggersite,rheOnError=errHandler}handler'errHandlererrreq=doliftIO$I.writeIORefret(Lefterr)return$YRPlainH.status500[]typePlain(toContent("runFakeHandler: errHandler"::S8.ByteString))(reqSessionreq)fakeWaiRequest=Request{requestMethod="POST",httpVersion=H.http11,rawPathInfo="/runFakeHandler/pathInfo",rawQueryString="",serverName="runFakeHandler-serverName",serverPort=80,requestHeaders=[],isSecure=False,remoteHost=error"runFakeHandler-remoteHost",pathInfo=["runFakeHandler","pathInfo"],queryString=[],requestBody=mempty,vault=mempty,requestBodyLength=KnownLength0}fakeRequest=YesodRequest{reqGetParams=[],reqCookies=[],reqWaiRequest=fakeWaiRequest,reqLangs=[],reqToken=Just"NaN"-- not a nonce =),reqAccept=[],reqSession=fakeSessionMap}_<-runResourceT$yappfakeRequestI.readIORefret{-# WARNING runFakeHandler "Usually you should *not* use runFakeHandler unless you really understand how it works and why you need it." #-}yesodRunner::(ToTypedContentres,Yesodsite)=>HandlerTsiteIOres->YesodRunnerEnvsite->Maybe(Routesite)->ApplicationyesodRunnerhandler'YesodRunnerEnv{..}routereq|JustmaxLen<-mmaxLen,KnownLengthlen<-requestBodyLengthreq,maxLen<len=returntooLargeResponse|otherwise=doletdontSaveSession_=return[](session,saveSession)<-liftIO$domaybe(return(Map.empty,dontSaveSession))(\sb->sbLoadSessionsbreq)yreSessionBackendletmkYesodReq=parseWaiRequestreqsession(isJustyreSessionBackend)mmaxLenyreq<-casemkYesodReqofLeftyreq->returnyreqRightneedGen->liftIO$needGen<$>newStdGenletra=resolveApprootyreSitereqletlog'=messageLoggerSourceyreSiteyreLogger-- We set up two environments: the first one has a "safe" error handler-- which will never throw an exception. The second one uses the-- user-provided errorHandler function. If that errorHandler function-- errors out, it will use the safeEh below to recover.rheSafe=RunHandlerEnv{rheRender=yesodRenderyreSitera,rheRoute=route,rheSite=yreSite,rheUpload=fileUploadyreSite,rheLog=log',rheOnError=safeEhlog'}rhe=rheSafe{rheOnError=runHandlerrheSafe.errorHandler}yar<-runHandlerrhehandleryreqliftIO$yarToResponseyarsaveSessionyreqwheremmaxLen=maximumContentLengthyreSiteroutehandler=yesodMiddlewarehandler'yesodRender::Yesody=>y->ResolvedApproot->Routey->[(Text,Text)]-- ^ url query string->TextyesodRenderyarurlparams=decodeUtf8WithlenientDecode$toByteString$fromMaybe(joinPathyarps$params++params')(urlRenderOverrideyurl)where(ps,params')=renderRouteurlresolveApproot::Yesodmaster=>master->Request->ResolvedApprootresolveApprootmasterreq=caseapprootofApprootRelative->""ApprootStatict->tApprootMasterf->fmasterApprootRequestf->fmasterreqstripHandlerT::HandlerTchild(HandlerTparentm)a->(parent->child)->(Routechild->Routeparent)->Maybe(Routechild)->HandlerTparentmastripHandlerT(HandlerTf)getSubtoMasternewRoute=HandlerT$\hd->doletenv=handlerEnvhd($hd)$unHandlerT$fhd{handlerEnv=env{rheSite=getSub$rheSiteenv,rheRoute=newRoute,rheRender=\urlparams->rheRenderenv(toMasterurl)params},handlerToParent=toMaster}