{-# LANGUAGE CPP #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE CPP #-}moduleNetwork.Wai.Handler.Warp.RunwhereimportControl.Concurrent(forkIO,threadDelay)importControl.ExceptionimportControl.Monad(forever,when,unless,void)importControl.Monad.IO.Class(MonadIO,liftIO)importData.ByteString(ByteString)importqualifiedData.ByteStringasSimportData.ConduitimportData.Conduit.Internal(ResumableSource(..))importqualifiedData.Conduit.ListasCLimportData.Conduit.Network(bindPort)importNetwork(sClose,Socket)importNetwork.SendfileimportNetwork.Socket(accept,SockAddr)importqualifiedNetwork.Socket.ByteStringasSockimportNetwork.WaiimportNetwork.Wai.Handler.Warp.RequestimportNetwork.Wai.Handler.Warp.ResponseimportNetwork.Wai.Handler.Warp.SettingsimportqualifiedNetwork.Wai.Handler.Warp.TimeoutasTimportNetwork.Wai.Handler.Warp.TypesimportPreludehiding(catch)-- Sock.recv first tries to call recvfrom() optimistically.-- If EAGAIN returns, it polls incoming data with epoll/kqueue.-- This code first polls incoming data with epoll/kqueue.#define PESSIMISTIC_RECV 1#ifdef PESSIMISTIC_RECVimportSystem.Posix.Types(Fd(..))importControl.Concurrent(threadWaitRead)importNetwork.Socket(Socket(..))#endif#if WINDOWSimportqualifiedControl.Concurrent.MVarasMVimportNetwork.Socket(withSocketsDo)#elseimportqualifiedNetwork.Wai.Handler.Warp.FdCacheasF#endif-- FIXME come up with good values herebytesPerRead::IntbytesPerRead=4096-- | Default action value for 'Connection'socketConnection::Socket->Connection#ifdef PESSIMISTIC_RECVsocketConnections@(MkSocketfd____)=Connection#elsesocketConnections=Connection#endif{connSendMany=Sock.sendManys,connSendAll=Sock.sendAlls,connSendFile=sendFiles,connClose=sCloses#ifdef PESSIMISTIC_RECV,connRecv=threadWaitRead(Fdfd)>>Sock.recvsbytesPerRead#else,connRecv=Sock.recvsbytesPerRead#endif}sendFile::Socket->FilePath->Integer->Integer->IO()->[ByteString]->Cleaner->IO()#if WINDOWSsendFilespathofflenacthdr_=sendfileWithHeaderspath(PartOfFileofflen)acthdr#elsesendFilespathofflenacthdrcleaner=do(fd,fresher)<-F.getFd(fdCachercleaner)pathsendfileFdWithHeadersfd(PartOfFileofflen)(act>>fresher)hdr#endif#if __GLASGOW_HASKELL__ < 702allowInterrupt::IO()allowInterrupt=unblock$return()#endif-- | Run an 'Application' on the given port. This calls 'runSettings' with-- 'defaultSettings'.run::Port->Application->IO()runp=runSettingsdefaultSettings{settingsPort=p}-- | Run a Warp server with the given settings.runSettings::Settings->Application->IO()#if WINDOWSrunSettingssetapp=withSocketsDo$dovar<-MV.newMVarNothingletclean=MV.modifyMVar_var$\s->maybe(return())sCloses>>returnNothingvoid.forkIO$bracket(bindPort(settingsPortset)(settingsHostset))(constclean)(\s->doMV.modifyMVar_var(\_->return$Justs)runSettingsSocketsetsapp)forever(threadDelaymaxBound)`finally`clean#elserunSettingsset=bracket(bindPort(settingsPortset)(settingsHostset))sClose.flip(runSettingsSocketset)#endif-- | Same as 'runSettings', but uses a user-supplied socket instead of opening-- one. This allows the user to provide, for example, Unix named socket, which-- can be used when reverse HTTP proxying into your application.---- Note that the 'settingsPort' will still be passed to 'Application's via the-- 'serverPort' record.runSettingsSocket::Settings->Socket->Application->IO()runSettingsSocketsetsocketapp=runSettingsConnectionsetgetterappwheregetter=do(conn,sa)<-acceptsocketreturn(socketConnectionconn,sa)runSettingsConnection::Settings->IO(Connection,SockAddr)->Application->IO()runSettingsConnectionsetgetConnapp=dotm<-maybe(T.initialize$settingsTimeoutset*1000000)return$settingsManagerset#if !WINDOWSfc<-F.initialize(settingsFdCacheDurationset*1000000)#endifmask$\restore->forever$doallowInterrupt(conn,addr)<-getConnLoopvoid.forkIO$doth<-T.registerKillThreadtm#if WINDOWSletcleaner=Cleanerth#elseletcleaner=Cleanerthfc#endifletserve=doonOpenrestore$serveConnectionsetcleanerportappconnaddrcleanupcleanup=connCloseconn>>T.cancelth>>onClosehandleonE$(serve`onException`cleanup)where-- FIXME: only IOEception is caught. What about other exceptions?getConnLoop=getConn`catch`\(e::IOException)->doonE(toExceptione)-- "resource exhausted (Too many open files)" may happen by accept().-- Wait a second hoping that resource will be available.threadDelay1000000getConnLooponE=settingsOnExceptionsetport=settingsPortsetonOpen=settingsOnOpensetonClose=settingsOnClosesetserveConnection::Settings->Cleaner->Port->Application->Connection->SockAddr->IO()serveConnectionsettingscleanerportappconnremoteHost'=runResourceTserveConnection'whereth=threadHandlecleanerserveConnection'::ResourceTIO()serveConnection'=serveConnection''$connSourceconnthserveConnection''fromClient=do(env,getSource)<-parseRequestconnportremoteHost'fromClientcasesettingsInterceptsettingsenvofNothing->do-- Let the application run for as long as it wantsliftIO$T.pausethres<-appenvliftIO$T.resumethkeepAlive<-sendResponsecleanerenvconnres-- flush the rest of the request bodyrequestBodyenv$$CL.sinkNullResumableSourcefromClient'_<-liftIOgetSourcewhenkeepAlive$serveConnection''fromClient'Justintercept->doliftIO$T.pausethResumableSourcefromClient'_<-liftIOgetSourceinterceptfromClient'connconnSource::Connection->T.Handle->Source(ResourceTIO)ByteStringconnSourceConnection{connRecv=recv}th=srcwheresrc=dobs<-liftIOrecvunless(S.nullbs)$dowhen(S.lengthbs>=2048)$liftIO$T.ticklethyieldbssrc