{-# LANGUAGE CPP #-}{-# LANGUAGE OverloadedStrings #-}{-|
This module exports the 'Config' datatype, which you can use to configure the
Snap HTTP server.
-}moduleSnap.Http.Server.Config(Config,ConfigBackend(..),emptyConfig,defaultConfig,commandLineConfig,completeConfig,getAccessLog,getBackend,getBind,getCompression,getDefaultTimeout,getErrorHandler,getErrorLog,getHostname,getLocale,getOther,getPort,getSSLBind,getSSLCert,getSSLKey,getSSLPort,getVerbose,setAccessLog,setBackend,setBind,setCompression,setDefaultTimeout,setErrorHandler,setErrorLog,setHostname,setLocale,setOther,setPort,setSSLBind,setSSLCert,setSSLKey,setSSLPort,setVerbose)whereimportBlaze.ByteString.BuilderimportControl.Exception(SomeException)importControl.MonadimportqualifiedData.ByteString.Char8asBimportData.ByteString(ByteString)importData.CharimportData.FunctionimportData.ListimportData.MaybeimportData.MonoidimportqualifiedData.TextasTimportqualifiedData.Text.EncodingasTimportPreludehiding(catch)importSnap.TypesimportSnap.Iteratee((>==>),enumBuilder)importSnap.Internal.Debug(debug)importSystem.Console.GetOptimportSystem.Environmenthiding(getEnv)#ifndef PORTABLEimportSystem.Posix.Env#endifimportSystem.ExitimportSystem.IO-------------------------------------------------------------------------------- | This datatype allows you to override which backend (either simple or-- libev) to use. Most users will not want to set this, preferring to rely on-- the compile-type default.---- Note that if you specify the libev backend and have not compiled in support-- for it, your server will fail at runtime.dataConfigBackend=ConfigSimpleBackend|ConfigLibEvBackendderiving(Show,Eq)-------------------------------------------------------------------------------- | A record type which represents partial configurations (for 'httpServe')-- by wrapping all of its fields in a 'Maybe'. Values of this type are usually-- constructed via its 'Monoid' instance by doing something like:---- > setPort 1234 mempty---- Any fields which are unspecified in the 'Config' passed to 'httpServe' (and-- this is the norm) are filled in with default values from 'defaultConfig'.dataConfigma=Config{hostname::MaybeByteString,accessLog::Maybe(MaybeFilePath),errorLog::Maybe(MaybeFilePath),locale::MaybeString,port::MaybeInt,bind::MaybeByteString,sslport::MaybeInt,sslbind::MaybeByteString,sslcert::MaybeFilePath,sslkey::MaybeFilePath,compression::MaybeBool,verbose::MaybeBool,errorHandler::Maybe(SomeException->m()),defaultTimeout::MaybeInt,other::Maybea,backend::MaybeConfigBackend}instanceShow(Configma)whereshowc=unlines["Config:","hostname: "++_hostname,"accessLog: "++_accessLog,"errorLog: "++_errorLog,"locale: "++_locale,"port: "++_port,"bind: "++_bind,"sslport: "++_sslport,"sslbind: "++_sslbind,"sslcert: "++_sslcert,"sslkey: "++_sslkey,"compression: "++_compression,"verbose: "++_verbose,"defaultTimeout: "++_defaultTimeout,"backend: "++_backend]where_hostname=show$hostnamec_accessLog=show$accessLogc_errorLog=show$errorLogc_locale=show$localec_port=show$portc_bind=show$bindc_sslport=show$sslportc_sslbind=show$sslbindc_sslcert=show$sslcertc_sslkey=show$sslkeyc_compression=show$compressionc_verbose=show$verbosec_defaultTimeout=show$defaultTimeoutc_backend=show$backendc-------------------------------------------------------------------------------- | Returns a completely empty 'Config'. Equivalent to 'mempty' from-- 'Config''s 'Monoid' instance.emptyConfig::ConfigmaemptyConfig=mempty------------------------------------------------------------------------------instanceMonoid(Configma)wheremempty=Config{hostname=Nothing,accessLog=Nothing,errorLog=Nothing,locale=Nothing,port=Nothing,bind=Nothing,sslport=Nothing,sslbind=Nothing,sslcert=Nothing,sslkey=Nothing,compression=Nothing,verbose=Nothing,errorHandler=Nothing,defaultTimeout=Nothing,other=Nothing,backend=Nothing}a`mappend`b=Config{hostname=ovhostnameab,accessLog=ovaccessLogab,errorLog=overrorLogab,locale=ovlocaleab,port=ovportab,bind=ovbindab,sslport=ovsslportab,sslbind=ovsslbindab,sslcert=ovsslcertab,sslkey=ovsslkeyab,compression=ovcompressionab,verbose=ovverboseab,errorHandler=overrorHandlerab,defaultTimeout=ovdefaultTimeoutab,other=ovotherab,backend=ovbackendab}whereovfxy=getLast$!(mappend`on`(Last.f))xy-------------------------------------------------------------------------------- | These are the default values for the optionsdefaultConfig::MonadSnapm=>ConfigmadefaultConfig=mempty{hostname=Just"localhost",accessLog=Just$Just"log/access.log",errorLog=Just$Just"log/error.log",locale=Just"en_US",compression=JustTrue,verbose=JustTrue,errorHandler=JustdefaultErrorHandler,bind=Just"0.0.0.0",sslbind=Just"0.0.0.0",sslcert=Just"cert.pem",sslkey=Just"key.pem",defaultTimeout=Just60}-------------------------------------------------------------------------------- | The hostname of the HTTP servergetHostname::Configma->MaybeByteStringgetHostname=hostname-- | Path to the access loggetAccessLog::Configma->Maybe(MaybeFilePath)getAccessLog=accessLog-- | Path to the error loggetErrorLog::Configma->Maybe(MaybeFilePath)getErrorLog=errorLog-- | The locale to usegetLocale::Configma->MaybeStringgetLocale=locale-- | Returns the port to listen on (for http)getPort::Configma->MaybeIntgetPort=port-- | Returns the address to bind to (for http)getBind::Configma->MaybeByteStringgetBind=bind-- | Returns the port to listen on (for https)getSSLPort::Configma->MaybeIntgetSSLPort=sslport-- | Returns the address to bind to (for https)getSSLBind::Configma->MaybeByteStringgetSSLBind=sslbind-- | Path to the SSL certificate filegetSSLCert::Configma->MaybeFilePathgetSSLCert=sslcert-- | Path to the SSL key filegetSSLKey::Configma->MaybeFilePathgetSSLKey=sslkey-- | If set and set to True, compression is turned on when applicablegetCompression::Configma->MaybeBoolgetCompression=compression-- | Whether to write server status updates to stderrgetVerbose::Configma->MaybeBoolgetVerbose=verbose-- | A MonadSnap action to handle 500 errorsgetErrorHandler::Configma->Maybe(SomeException->m())getErrorHandler=errorHandlergetDefaultTimeout::Configma->MaybeIntgetDefaultTimeout=defaultTimeoutgetOther::Configma->MaybeagetOther=othergetBackend::Configma->MaybeConfigBackendgetBackend=backend------------------------------------------------------------------------------setHostname::ByteString->Configma->ConfigmasetHostnamexc=c{hostname=Justx}setAccessLog::(MaybeFilePath)->Configma->ConfigmasetAccessLogxc=c{accessLog=Justx}setErrorLog::(MaybeFilePath)->Configma->ConfigmasetErrorLogxc=c{errorLog=Justx}setLocale::String->Configma->ConfigmasetLocalexc=c{locale=Justx}setPort::Int->Configma->ConfigmasetPortxc=c{port=Justx}setBind::ByteString->Configma->ConfigmasetBindxc=c{bind=Justx}setSSLPort::Int->Configma->ConfigmasetSSLPortxc=c{sslport=Justx}setSSLBind::ByteString->Configma->ConfigmasetSSLBindxc=c{sslbind=Justx}setSSLCert::FilePath->Configma->ConfigmasetSSLCertxc=c{sslcert=Justx}setSSLKey::FilePath->Configma->ConfigmasetSSLKeyxc=c{sslkey=Justx}setCompression::Bool->Configma->ConfigmasetCompressionxc=c{compression=Justx}setVerbose::Bool->Configma->ConfigmasetVerbosexc=c{verbose=Justx}setErrorHandler::(SomeException->m())->Configma->ConfigmasetErrorHandlerxc=c{errorHandler=Justx}setDefaultTimeout::Int->Configma->ConfigmasetDefaultTimeoutxc=c{defaultTimeout=Justx}setOther::a->Configma->ConfigmasetOtherxc=c{other=Justx}setBackend::ConfigBackend->Configma->ConfigmasetBackendxc=c{backend=Justx}------------------------------------------------------------------------------completeConfig::(MonadSnapm)=>Configma->IO(Configma)completeConfigconfig=dowhennoPort$hPutStrLnstderr"no port specified, defaulting to port 8000"return$cfg`mappend`cfg'wherecfg=defaultConfig`mappend`configsslVals=map($cfg)[isJust.getSSLPort,isJust.getSSLBind,isJust.getSSLKey,isJust.getSSLCert]sslValid=andsslValsnoPort=isNothing(getPortcfg)&&notsslValidcfg'=emptyConfig{port=ifnoPortthenJust8000elseNothing}------------------------------------------------------------------------------fromString::String->ByteStringfromString=T.encodeUtf8.T.pack------------------------------------------------------------------------------options::MonadSnapm=>Configma->[OptDescr(Maybe(Configma))]optionsdefaults=[Option[]["hostname"](ReqArg(Just.setConfigsetHostname.fromString)"NAME")$"local hostname"++defaultCgetHostname,Option['b']["address"](ReqArg(\s->Just$mempty{bind=Just$fromStrings})"ADDRESS")$"address to bind to"++defaultObind,Option['p']["port"](ReqArg(\s->Just$mempty{port=Just$reads})"PORT")$"port to listen on"++defaultOport,Option[]["ssl-address"](ReqArg(\s->Just$mempty{sslbind=Just$fromStrings})"ADDRESS")$"ssl address to bind to"++defaultOsslbind,Option[]["ssl-port"](ReqArg(\s->Just$mempty{sslport=Just$reads})"PORT")$"ssl port to listen on"++defaultOsslport,Option[]["ssl-cert"](ReqArg(\s->Just$mempty{sslcert=Justs})"PATH")$"path to ssl certificate in PEM format"++defaultOsslcert,Option[]["ssl-key"](ReqArg(\s->Just$mempty{sslkey=Justs})"PATH")$"path to ssl private key in PEM format"++defaultOsslkey,Option[]["access-log"](ReqArg(Just.setConfigsetAccessLog.Just)"PATH")$"access log"++(defaultC$join.getAccessLog),Option[]["error-log"](ReqArg(Just.setConfigsetErrorLog.Just)"PATH")$"error log"++(defaultC$join.getErrorLog),Option[]["no-access-log"](NoArg$Just$setConfigsetErrorLogNothing)$"don't have an access log",Option[]["no-error-log"](NoArg$Just$setConfigsetAccessLogNothing)$"don't have an error log",Option['c']["compression"](NoArg$Just$setConfigsetCompressionTrue)$"use gzip compression on responses",Option['t']["timeout"](ReqArg(\t->Just$mempty{defaultTimeout=Just$readt})"SECS")$"set default timeout in seconds",Option[]["no-compression"](NoArg$Just$setConfigsetCompressionFalse)$"serve responses uncompressed",Option['v']["verbose"](NoArg$Just$setConfigsetVerboseTrue)$"print server status updates to stderr",Option['q']["quiet"](NoArg$Just$setConfigsetVerboseFalse)$"do not print anything to stderr",Option['h']["help"](NoArgNothing)$"display this help and exit"]wheresetConfigfc=fcmemptyconf=defaultConfig`mappend`defaultsdefaultCf=maybe""((", default "++).show)$fconfdefaultOf=maybe", default off"((", default "++).show)$fconf------------------------------------------------------------------------------defaultErrorHandler::MonadSnapm=>SomeException->m()defaultErrorHandlere=dodebug"Snap.Http.Server.Config errorHandler: got exception:"debug$showelogErrormsgfinishWith$setContentType"text/plain; charset=utf-8".setContentLength(fromIntegral$B.lengthmsg).setResponseStatus500"Internal Server Error".modifyResponseBody(>==>enumBuilder(fromByteStringmsg))$emptyResponsewhereerr=fromString$showemsg=mappend"A web handler threw an exception. Details:\n"err-------------------------------------------------------------------------------- | Returns a 'Config' obtained from parsing the options specified on the-- command-line.---- On Unix systems, the locale is read from the @LANG@ environment variable.commandLineConfig::MonadSnapm=>Configma-- ^ default configuration. This is combined-- with 'defaultConfig' to obtain default-- values to use if the given parameter is not-- specified on the command line. Usually it is-- fine to use 'emptyConfig' here.->IO(Configma)commandLineConfigdefaults=doargs<-getArgsprog<-getProgNameletopts=optionsdefaultsresult<-either(usageprogopts)return(casegetOptPermuteoptsargsof(f,_,[])->maybe(Left[])Right$fmapmconcat$sequencef(_,_,errs)->Lefterrs)#ifndef PORTABLElang<-getEnv"LANG"completeConfig$mconcat[defaults,mempty{locale=fmapupToUtf8lang},result]#elsecompleteConfig$mconcat[defaults,result]#endifwhereusageprogoptserrs=dolethdr="Usage:\n "++prog++" [OPTION...]\n\nOptions:"letmsg=concaterrs++usageInfohdroptshPutStrLnstderrmsgexitFailure#ifndef PORTABLEupToUtf8=takeWhile$\c->isAlphac||'_'==c#endif